From: <mie...@us...> - 2011-11-27 03:47:12
|
Revision: 7307 http://oorexx.svn.sourceforge.net/oorexx/?rev=7307&view=rev Author: miesfeld Date: 2011-11-27 03:47:05 +0000 (Sun, 27 Nov 2011) Log Message: ----------- re-org ole samples in incubator 3 Added Paths: ----------- incubator/samples/ole/OleUtils.rex incubator/samples/ole/outlook/outlook.frm Removed Paths: ------------- incubator/samples/ole/outlook/contacts/outlook.frm incubator/samples/ole/short.cuts/OleUtils.rex Copied: incubator/samples/ole/OleUtils.rex (from rev 7305, incubator/samples/ole/short.cuts/OleUtils.rex) =================================================================== --- incubator/samples/ole/OleUtils.rex (rev 0) +++ incubator/samples/ole/OleUtils.rex 2011-11-27 03:47:05 UTC (rev 7307) @@ -0,0 +1,445 @@ +/*----------------------------------------------------------------------------*/ +/* */ +/* Copyright (c) 2010-2010 Rexx Language Association. All rights reserved. */ +/* */ +/* This program and the accompanying materials are made available under */ +/* the terms of the Common Public License v1.0 which accompanies this */ +/* distribution. A copy is also available at the following address: */ +/* http://www.oorexx.org/license.html */ +/* */ +/* Redistribution and use in source and binary forms, with or */ +/* without modification, are permitted provided that the following */ +/* conditions are met: */ +/* */ +/* Redistributions of source code must retain the above copyright */ +/* notice, this list of conditions and the following disclaimer. */ +/* Redistributions in binary form must reproduce the above copyright */ +/* notice, this list of conditions and the following disclaimer in */ +/* the documentation and/or other materials provided with the distribution. */ +/* */ +/* Neither the name of Rexx Language Association nor the names */ +/* of its contributors may be used to endorse or promote products */ +/* derived from this software without specific prior written permission. */ +/* */ +/* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS */ +/* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT */ +/* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS */ +/* FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT */ +/* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, */ +/* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED */ +/* TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, */ +/* OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY */ +/* OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING */ +/* NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS */ +/* SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ +/* */ +/*----------------------------------------------------------------------------*/ + +/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*\ + File: OleUtils.rex Author: Mark Miesfeld + Creation date: 11/27/2006 + Company: DFX Systems + Project: OLEObject Utilities Last Update: 07/01/2007 + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + Category: + Framework + + Syntax: + N/A + + Purpose: + Provides some useful utilities for working with the .OLEObject class. + + Assumes: + ooRexx version 3.1.2 as a minimum. + + Notes: + + Changes: +\* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/ + +-- End of entry point. + +/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*\ + Directives, Classes, or Routines. +\* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/ + +/* createOleObject( id ) - - - - - - - - - - - - - - - - - - - - - - - - - - -*\ + + Creates an .OLEObject instance, a proxy for the specified COM object. This + routine is used to trap the REXX error that happens when the proxied COM + object can not be created. + + Input: + id REQUIRED + The string used to create the COM object. I.e., the ProgID or CLSID. + + verbose OPTIONAL + If true and the OleObject is not created, the error message is displayed. + If false, the default, the message is not displayed. + + Returns: + An instance of .OLEObject on success, .nil on failure. +\* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/ +::routine createOleObject public + use arg id, verbose + + if isRexxTrue( arg( 2 ) ) then + verbose = .true + else + verbose = .false + + signal on syntax name returnNil + + oleObject = .OLEObject~new( id,"NOEVENTS" ) + signal on syntax + return oleObject + +returnNil: + signal on syntax + if verbose then + say "Error" rc":" errortext(rc)||'0d0a'x||condition('o')~message + + return .nil +-- End createOleObject( id, verbose ) + +/* displayKnownMethods( oleObj, verbose )- - - - - - - - - - - - - - - - - - -*\ + + Formats and displays the known methods of an .OLEObject instance. Known + methods can only be displayed for OLE / COM objects that provide TypeInfo. If + the there is no known information, a simple string stating as much is + displayed. + + Input: + oleObj REQUIRED + An instance of the .OLEObject whose known methods are to be displayed. + + verbose OPTIONAL + If true all information concerning the methods is displayed. Parameters, + parameter types, return type, etc.. If false, the default, only the + method names are displayed. + + Returns: + 0 if the specified object is not an instance of the .OLEObject classs, + otherwise 1. +\* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/ +::routine displayKnownMethods public + use arg oleObj, verbose + + if \ oleObj~isInstanceOf( .OLEObject ) then do + say "Known methods can only be displayed for instances of the .OLEObject." + say " Arg 1 class:" oleObj~class + return 0 + end + + if isRexxTrue( arg( 2 ) ) then + verbose = .true + else + verbose = .false + + say + j = printInstanceInfo( oleObj ) + + known. = oleObj~getKnownMethods + + if known. == .nil then do + say "There is no known method information for this object" + return 1 + end + + say "Containing Type Library:" known.!LIBNAME + if known.!LIBDOC~left( 2 ) <> "!L" then + say "Library Description: " known.!LIBDOC + say + + say "COM Class: " known.!COCLASSNAME + if known.!COCLASSDOC~left( 2 ) <> "!C" then + say "Class Description:" known.!COCLASSDOC + say "Known methods: " known.0 + say + + if \ verbose then do + say " Methods:" + do i = 1 to known.0 + say " " known.i.!NAME + end + return 1 + end + + do i = 1 to known.0 + ret = known.i.!RETTYPE + name = known.i.!NAME + doc = known.i.!DOC + invk = known.i.!INVKIND + + say " " name + + if doc~pos( "!DOC" ) == 0 then + say " Decscription:" doc + + say " " invkindToString( invk ) "returns" ret + say + + if ret == "VT_VOID" then + line = " obj~"name + else + line = " " || changeVariant( ret ) || "= obj~"name + + select + when invk == 2 then + say line + + when known.i.!PARAMS.0 == 0 then + say line"()" + + otherwise do + line = line"( " + indent = " "~copies( line~length ) + + do j = 1 to known.i.!PARAMS.0 + param = known.i.!PARAMS.j.!TYPE known.i.!PARAMS.j.!FLAGS - + known.i.!PARAMS.j.!NAME + + select + when j == 1 & known.i.!PARAMS.0 == 1 then do + say line || param" )" + end + when j == 1 then do + say line || param"," + end + when j == known.i.!PARAMS.0 then do + say indent || param" )" + end + otherwise do + say indent || param"," + end + end + -- End select + end + -- End do j = 1 to known.i.!PARAMS.0 + end + -- End otherwise do + end + -- End select + + say + end + -- End do i = 1 to known.0 + +return 1 +-- End displayKnownMethods( oleObj ) + +/* displayKnownConstants( oleObj ) - - - - - - - - - - - - - - - - - - - - - -*\ + + Prints out all the known constants for the specified object, if any are + available. + + Input: + oleObj REQUIRED + An instance of the .OLEObject whose known methods are to be displayed. + + Returns: + 0 if the oleObj argument was not an instance of .OLEObject, otherwise 1. +\* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/ +::routine displayKnownConstants public + use arg oleObj + + if \ oleObj~isInstanceOf( .OLEObject ) then do + say "Known constants can only be displayed for instances of the .OLEObject." + say " Arg 1 class:" oleObj~class + return 0 + end + + say + j = printInstanceInfo( oleObj ) + + constants = oleObj~getConstant + if constants == .nil | constants~items == 0 then do + say "There are no known constants for this object" + return 1 + end + + say "Known constants:" constants~items + say + + -- Some of Microsoft's constant names are very long. + line = " "~copies( 42 ) || "= " + do name over constants + say line~overlay( name~substr( 2 ), 3 ) || constants[name] + end + +return 1 +-- End displayKnownConstants( oleObj ) + +/* changeVariant( vt ) - - - - - - - - - - - - - - - - - - - - - - - - - - - -*\ + + Helper function to turn a VARTYPE symbol into a "prettified" object name. + + E.g., VT_DISPATCH becomes dispatchObj, VT_I4 becomes i4Obj. + + Input: + vt REQUIRED + + OPTIONAL + + Returns: + The prettified version of the specified VARTYPE. +\* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/ +::routine changeVariant + use arg vt + + -- DFX TODO: it would be nice to turn VT_I4 to something like int4ByteObj, + -- VT_R4 to float4ByteObj + +return toLower( vt~substr( 4 ) ) || "Obj" +-- End changeVariant( vt ) + +/* invkindToString( kind ) - - - - - - - - - - - - - - - - - - - - - - - - - -*\ + + Helper function to return a string value for the specified invocation type. + + Input: + kind REQUIRED + A number representing a COM INVOKEKIND enumeration. + + Returns: + Returns the enumeration symbol, (string symbol) for the specified kind. +\* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/ +::routine invkindToString + use arg kind + + select + when kind == 1 then + kindString = "<Function>" + when kind == 2 then + kindString = "<Property get>" + when kind == 4 then + kindString = "<Property put>" + when kind == 8 then + kindString = "<Property put by reference>" + otherwise + kindString = "<Error Invalid! ("kind")>" + end + -- End select + +return kindString +-- End invkindToString( kind ) + +/* toLower( str )- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*\ + + Changes the specified string to lower case. + + Input: + str REQUIRED + The string to work with. + + Returns: + The string with all upper case letters changed to lower case. +\* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/ +::routine toLower public + use arg str + + if str~class <> .string then + return str + + lower = str~translate( "abcdefghijklmnopqrstuvwxyz", - + "ABCDEFGHIJKLMNOPQRSTUVWXYZ" ) + +return lower +-- End toLower( str ) + +/* isRexxTrue( obj ) - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*\ + + Tests if obj is strictly .true. (To some degree, actually just tests that obj + is exactly '1'.) + + Input: + obj REQUIRED + The object to test. + + Returns: + True if obj is strictly true, otherwise false. +\* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/ +::routine isRexxTrue public + use arg obj + + if obj~class == .string then + if obj~datatype( 'W' ) then + if obj == 1 then + return .true + +return .false +-- End isRexxTrue( obj ) + +/* isOORexx4OrLater( ) - - - - - - - - - - - - - - - - - - - - - - - - - - - -*\ + + Returns true if the running interpreter is ooRexx 4.0.0 or later. + + Input: + None. + + Returns: + True if this is ooRexx 4.0.0 or later, otherwise false. +\* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/ +::routine isOORexx4OrLater public + + parse version interpreterName languageLevel interpreterDate + parse var interpreterName junk "_" ver "." moreJunk + if ver >= 4 then return .true + +return .false +-- End isOORexx4OrLater( ) + +/* printInstanceInfo( oleObj ) - - - - - - - - - - - - - - - - - - - - - - - -*\ + + Helper function to print out instance information for an .OLEObject object. + + Input: + oleObj REQUIRED + The object whose instance information is to be printed. + + Returns: + 0, always. +\* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/ +::routine printInstanceInfo + use arg oleObj + + progID = oleObj~!getVar( "!PROGID" ) + clsID = oleObj~!getVar( "!CLSID" ) + disp = oleObj~!getVar( "!IDISPATCH" ) + typeInfo = oleObj~!getVar( "!ITYPEINFO" ) + + if isOORexx4OrLater() then do + if progID == .nil then + progID = "null" + if clsID == .nil then + clsID = "null" + if disp == .nil then + disp = "null" + if typeInfo == .nil then + typeInfo = "null" + end + else do + if progID~left( 2 ) == "!P" then + progID = "null" + if clsID~left( 2 ) == "!C" then + clsID = "null" + if disp~left( 3 ) == "!ID" then + disp = "null" + if typeInfo~left( 3 ) == "!IT" then + typeInfo = "null" + end + + say "ProgID: " progID + say "ClsID: " clsID + say "Dispatch Pointer:" disp + say "TypeInfo Pointer:" typeInfo + say + +return 0 +-- End printInstanceInfo( oleObj ) + + + +/* - - - - - - - - - - End of file: OleUtils.rex- - - - - - - - - - - - - - - */ Deleted: incubator/samples/ole/outlook/contacts/outlook.frm =================================================================== --- incubator/samples/ole/outlook/contacts/outlook.frm 2011-11-27 03:33:59 UTC (rev 7306) +++ incubator/samples/ole/outlook/contacts/outlook.frm 2011-11-27 03:47:05 UTC (rev 7307) @@ -1,364 +0,0 @@ -/*----------------------------------------------------------------------------*/ -/* */ -/* Copyright (c) 2011-2011 Rexx Language Association. All rights reserved. */ -/* */ -/* This program and the accompanying materials are made available under */ -/* the terms of the Common Public License v1.0 which accompanies this */ -/* distribution. A copy is also available at the following address: */ -/* http://www.oorexx.org/license.html */ -/* */ -/* Redistribution and use in source and binary forms, with or */ -/* without modification, are permitted provided that the following */ -/* conditions are met: */ -/* */ -/* Redistributions of source code must retain the above copyright */ -/* notice, this list of conditions and the following disclaimer. */ -/* Redistributions in binary form must reproduce the above copyright */ -/* notice, this list of conditions and the following disclaimer in */ -/* the documentation and/or other materials provided with the distribution. */ -/* */ -/* Neither the name of Rexx Language Association nor the names */ -/* of its contributors may be used to endorse or promote products */ -/* derived from this software without specific prior written permission. */ -/* */ -/* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS */ -/* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT */ -/* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS */ -/* FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT */ -/* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, */ -/* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED */ -/* TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, */ -/* OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY */ -/* OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING */ -/* NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS */ -/* SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ -/* */ -/*----------------------------------------------------------------------------*/ - -/** outlook.frm - * - * A collection of useful routines for working with Outlook through ooRexx's - * oleObject class. Meant to be used as a 'required' file. - * - * The documentation for each routine is in the comments preceding each routine. - */ - - -/** getDefaultContacts() - * - * Returns the default Contacts folder. - * - * @param outLook An OutLook application object. - * - * @return The Outlook folder object that contains all the contact items in the - * default address book. - */ -::routine getDefaultContacts public - use strict arg outLook - - nameSpace = outLook~getNamespace("MAPI") - - olFCID = outLook~getConstant(olFolderContacts) - contactsFolder = nameSpace~getDefaultFolder(olFCID) - return contactsFolder - - -/** printFolders() - * - * Prints to the console information about all the 'Stores' in the current - * OutLook session, including all the Folders contained in each Store. - * - * @param outLook An OutLook application object. - * - * @return 0, always. - */ -::routine printFolders public - use strict arg outLook - stores = outLook~session~stores - - do store over stores - say "Dispaly name:" store~displayName - say "File path: " store~filePath - say "ID: " store~storeID - - root = store~getRootFolder - say " Root folder path:" root~folderPath - j = enumerateFolders(root, " ") - say - end - return 0 - - -/** enumerateFolders() - * - * Prints to the console information about all the folders contained with in - * the specified folder, recursively. - * - * @param rFolder An OutLook folder object. All folders contained within this - * folder are recursively enumerated. - * - * @return 0, always. - * - * @note enumerateFolders() is not public by design. - */ - -::routine enumerateFolders - use strict arg rFolder, pad - - folders = rFolder~folders - count = folders~count - pad ||= " " - if count > 0 then do folder over folders - say pad || folder~name - say pad || folder~folderPath - j = enumerateFolders(folder, pad) - end - else do - say pad || 'End of folder branch' - end - return 0 - - -/** createNewStore() - * - * Adds a new Store to OutLook. - * - * @param outLook An OutLook application object. - * - * @param fileName The full path and file name of the backing file for the - * Store. If the path contains spaces, be sure to enclose the - * entire path name in quotes. - * - * @return 0 for success, 99 if OutLook already contains a Store for the named - * backing file. - */ -::routine createNewStore public - use strict arg outLook, fileName - - -- Check if the store already exists - stores = outLook~session~stores - do store over stores - if fileName~caselessCompare(store~filePath) == 0 then do - say 'An Outlook store for:' - say ' ' fileName - say 'already exists.' - return 99 - end - end - - nameSpace = outLook~getNamespace("MAPI") - nameSpace~addStore(fileName) - - return 0 - - -/** getStore() - * - * Finds and returns a Store in the current session of OutLook. The Store is - * located through the path name of its backing file. - * - * @param outLook An OutLook application object. - * - * @param storePath The full path and file name of the backing file for the - * desired Store. - * - * @return The Store object if found, .nil if not found. - */ -::routine getStore public - use strict arg outLook, storePath - - stores = outLook~session~stores - do store over stores - if storePath~caselessCompare(store~filePath) == 0 then do - return store - end - end - - return .nil - -/** getStoreIndex() - * - * Given the file path name of a Store, returns its - * index in the Stores collection. - * - * @param outLook An OutLook application object. - * @param storePath The path name of the Store. - * - * @returns The index of the Store on success, - * otherwise 0. - */ -::routine getStoreIndex public - use strict arg outLook, storePath - - stores = outLook~session~stores - count = stores~count - do i = 1 to count - store = stores[i] - if storePath~caselessCompare(store~filePath) == 0 then return i - end - - return 0 - - -/** deleteStoreByPath() - * - * Deltes a Store from the Stores collection by searching for the Store using - * the file name of the store. - * - * @param outLook An OutLook application object - * @param storePath The path / file name of the Store - * - * @return True on success, false on error. - * - * @note It is not possible to delete the physical file of the Store through - * the OutLook object. In addition, the MAPI spooler keeps a file lock - * on the file which will not be released until the process (this process - * ends.) Therefore it is simply not possible to programmaticaly delete - * the physical file in this method. - */ -::routine deleteStoreByPath public - use strict arg outLook, storePath - - index = getStoreIndex(outLook, storePath) - if index == 0 then do - say "Could not find store file:" storePath - return .false - end - - store = outLook~session~stores[index] - - nameSpace = outLook~getNamespace("MAPI") - nameSpace~removeStore(store~getRootFolder) - z = SysSleep(1) - - if getStoreIndex(outLook, storePath) <> 0 then do - say "Failed to delete Outlook store:" storePath - return .false - end - else do - say "Deleted Outlook store:" storePath - end - - return .true - - -/** getFolderFromStore() - * - * Finds and returns a folder within a store. - * - * @param store The Store object to search for the folder. - * @param name The name of the folder to search for. - * - * @return The folder if found, otherwise .nil. - */ -::routine getFolderFromStore public - use strict arg store, name - - root = store~getRootFolder - folders = root~folders - - do folder over folders - if folder~name == name then return folder - end - - return .nil - - -/** addFolderToStore() - * - * Adds a new folder to a Store. - * - * @param store The Store object within which to add the folder. - * @param name The name for the folder being added. - * @param type The Outlook type constant for the folder. - * - * @return The newly added folder object. - * - * @remarks The 'type' argument must be one of the OutLook folder type - * constants, such olFolderDrafts, olFolderInbox, or olFolderContacts. - */ -::routine addFolderToStore public - use strict arg store, name, type - - folders = store~getRootFolder~folders - folder = folders~add(name, type) - - return folder - - -/** removeFolderFromStore() - * - * Removes a folder from the specified Store. - * - * @param store The Store object within which to remove the folder. - * @param name The name for the folder being removed. - * - * @return True on success, false on failure. - */ -::routine removeFolderFromStore public - use strict arg store, name - - root = store~getRootFolder - folders = root~folders - - do folder over folders - if folder~name == name then do - say 'Removing folder:' name - folder~delete - return .true - end - end - - return .false - - -/** emptyFolder() - * - * Removes all items from a Contacts folder. - * - * @param store The Store object containing the folder being emptied. - * @param folderName The name for the folder being emptied. - * - * @return True on success, false on error. - * - * @remarks This function was implemented for working with OutLook contacts and - * as such has some assumptions that the folder being emptied is a - * Contacts folder. I.e., the items in non-contacts folders probably - * do not have a 'fullName' property. - * - * So, the function does a check that the folder is most likely a - * Contacts folder and aborts if it is not. - */ -::routine emptyFolder public - use strict arg store, folderName - - folder = getFolderFromStore(store, folderName) - if folder \== .nil then do - olCIid = folder~getConstant(olContactItem) - - if folder~defaultItemType \== olCIid then do - say 'Folder ('folder~name') does not appear to be a Contacts folder' - say 'Aborting.' - return .false - end - - items = folder~items - do while items~count > 0 - say 'Removing contact item:' items[1]~fullName - items~remove(1) - end - end - - return .true - -/** Class:: CN - * - * This is a simple class of constants. It is used to produce what should be - * unique names for a Store and a Folder within a Store. The example programs - * that use this framework use these constant names so that the example programs - * will not interfer with a user's regular Stores and Folders. - */ -::class 'CN' public - -::constant STORE_PATH 'C:\outlook1_demo_mm.pst' -::constant CONTACTS_FOLDER 'Demo Contacts Folder MM' Copied: incubator/samples/ole/outlook/outlook.frm (from rev 7306, incubator/samples/ole/outlook/contacts/outlook.frm) =================================================================== --- incubator/samples/ole/outlook/outlook.frm (rev 0) +++ incubator/samples/ole/outlook/outlook.frm 2011-11-27 03:47:05 UTC (rev 7307) @@ -0,0 +1,364 @@ +/*----------------------------------------------------------------------------*/ +/* */ +/* Copyright (c) 2011-2011 Rexx Language Association. All rights reserved. */ +/* */ +/* This program and the accompanying materials are made available under */ +/* the terms of the Common Public License v1.0 which accompanies this */ +/* distribution. A copy is also available at the following address: */ +/* http://www.oorexx.org/license.html */ +/* */ +/* Redistribution and use in source and binary forms, with or */ +/* without modification, are permitted provided that the following */ +/* conditions are met: */ +/* */ +/* Redistributions of source code must retain the above copyright */ +/* notice, this list of conditions and the following disclaimer. */ +/* Redistributions in binary form must reproduce the above copyright */ +/* notice, this list of conditions and the following disclaimer in */ +/* the documentation and/or other materials provided with the distribution. */ +/* */ +/* Neither the name of Rexx Language Association nor the names */ +/* of its contributors may be used to endorse or promote products */ +/* derived from this software without specific prior written permission. */ +/* */ +/* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS */ +/* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT */ +/* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS */ +/* FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT */ +/* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, */ +/* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED */ +/* TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, */ +/* OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY */ +/* OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING */ +/* NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS */ +/* SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ +/* */ +/*----------------------------------------------------------------------------*/ + +/** outlook.frm + * + * A collection of useful routines for working with Outlook through ooRexx's + * oleObject class. Meant to be used as a 'required' file. + * + * The documentation for each routine is in the comments preceding each routine. + */ + + +/** getDefaultContacts() + * + * Returns the default Contacts folder. + * + * @param outLook An OutLook application object. + * + * @return The Outlook folder object that contains all the contact items in the + * default address book. + */ +::routine getDefaultContacts public + use strict arg outLook + + nameSpace = outLook~getNamespace("MAPI") + + olFCID = outLook~getConstant(olFolderContacts) + contactsFolder = nameSpace~getDefaultFolder(olFCID) + return contactsFolder + + +/** printFolders() + * + * Prints to the console information about all the 'Stores' in the current + * OutLook session, including all the Folders contained in each Store. + * + * @param outLook An OutLook application object. + * + * @return 0, always. + */ +::routine printFolders public + use strict arg outLook + stores = outLook~session~stores + + do store over stores + say "Dispaly name:" store~displayName + say "File path: " store~filePath + say "ID: " store~storeID + + root = store~getRootFolder + say " Root folder path:" root~folderPath + j = enumerateFolders(root, " ") + say + end + return 0 + + +/** enumerateFolders() + * + * Prints to the console information about all the folders contained with in + * the specified folder, recursively. + * + * @param rFolder An OutLook folder object. All folders contained within this + * folder are recursively enumerated. + * + * @return 0, always. + * + * @note enumerateFolders() is not public by design. + */ + +::routine enumerateFolders + use strict arg rFolder, pad + + folders = rFolder~folders + count = folders~count + pad ||= " " + if count > 0 then do folder over folders + say pad || folder~name + say pad || folder~folderPath + j = enumerateFolders(folder, pad) + end + else do + say pad || 'End of folder branch' + end + return 0 + + +/** createNewStore() + * + * Adds a new Store to OutLook. + * + * @param outLook An OutLook application object. + * + * @param fileName The full path and file name of the backing file for the + * Store. If the path contains spaces, be sure to enclose the + * entire path name in quotes. + * + * @return 0 for success, 99 if OutLook already contains a Store for the named + * backing file. + */ +::routine createNewStore public + use strict arg outLook, fileName + + -- Check if the store already exists + stores = outLook~session~stores + do store over stores + if fileName~caselessCompare(store~filePath) == 0 then do + say 'An Outlook store for:' + say ' ' fileName + say 'already exists.' + return 99 + end + end + + nameSpace = outLook~getNamespace("MAPI") + nameSpace~addStore(fileName) + + return 0 + + +/** getStore() + * + * Finds and returns a Store in the current session of OutLook. The Store is + * located through the path name of its backing file. + * + * @param outLook An OutLook application object. + * + * @param storePath The full path and file name of the backing file for the + * desired Store. + * + * @return The Store object if found, .nil if not found. + */ +::routine getStore public + use strict arg outLook, storePath + + stores = outLook~session~stores + do store over stores + if storePath~caselessCompare(store~filePath) == 0 then do + return store + end + end + + return .nil + +/** getStoreIndex() + * + * Given the file path name of a Store, returns its + * index in the Stores collection. + * + * @param outLook An OutLook application object. + * @param storePath The path name of the Store. + * + * @returns The index of the Store on success, + * otherwise 0. + */ +::routine getStoreIndex public + use strict arg outLook, storePath + + stores = outLook~session~stores + count = stores~count + do i = 1 to count + store = stores[i] + if storePath~caselessCompare(store~filePath) == 0 then return i + end + + return 0 + + +/** deleteStoreByPath() + * + * Deltes a Store from the Stores collection by searching for the Store using + * the file name of the store. + * + * @param outLook An OutLook application object + * @param storePath The path / file name of the Store + * + * @return True on success, false on error. + * + * @note It is not possible to delete the physical file of the Store through + * the OutLook object. In addition, the MAPI spooler keeps a file lock + * on the file which will not be released until the process (this process + * ends.) Therefore it is simply not possible to programmaticaly delete + * the physical file in this method. + */ +::routine deleteStoreByPath public + use strict arg outLook, storePath + + index = getStoreIndex(outLook, storePath) + if index == 0 then do + say "Could not find store file:" storePath + return .false + end + + store = outLook~session~stores[index] + + nameSpace = outLook~getNamespace("MAPI") + nameSpace~removeStore(store~getRootFolder) + z = SysSleep(1) + + if getStoreIndex(outLook, storePath) <> 0 then do + say "Failed to delete Outlook store:" storePath + return .false + end + else do + say "Deleted Outlook store:" storePath + end + + return .true + + +/** getFolderFromStore() + * + * Finds and returns a folder within a store. + * + * @param store The Store object to search for the folder. + * @param name The name of the folder to search for. + * + * @return The folder if found, otherwise .nil. + */ +::routine getFolderFromStore public + use strict arg store, name + + root = store~getRootFolder + folders = root~folders + + do folder over folders + if folder~name == name then return folder + end + + return .nil + + +/** addFolderToStore() + * + * Adds a new folder to a Store. + * + * @param store The Store object within which to add the folder. + * @param name The name for the folder being added. + * @param type The Outlook type constant for the folder. + * + * @return The newly added folder object. + * + * @remarks The 'type' argument must be one of the OutLook folder type + * constants, such olFolderDrafts, olFolderInbox, or olFolderContacts. + */ +::routine addFolderToStore public + use strict arg store, name, type + + folders = store~getRootFolder~folders + folder = folders~add(name, type) + + return folder + + +/** removeFolderFromStore() + * + * Removes a folder from the specified Store. + * + * @param store The Store object within which to remove the folder. + * @param name The name for the folder being removed. + * + * @return True on success, false on failure. + */ +::routine removeFolderFromStore public + use strict arg store, name + + root = store~getRootFolder + folders = root~folders + + do folder over folders + if folder~name == name then do + say 'Removing folder:' name + folder~delete + return .true + end + end + + return .false + + +/** emptyFolder() + * + * Removes all items from a Contacts folder. + * + * @param store The Store object containing the folder being emptied. + * @param folderName The name for the folder being emptied. + * + * @return True on success, false on error. + * + * @remarks This function was implemented for working with OutLook contacts and + * as such has some assumptions that the folder being emptied is a + * Contacts folder. I.e., the items in non-contacts folders probably + * do not have a 'fullName' property. + * + * So, the function does a check that the folder is most likely a + * Contacts folder and aborts if it is not. + */ +::routine emptyFolder public + use strict arg store, folderName + + folder = getFolderFromStore(store, folderName) + if folder \== .nil then do + olCIid = folder~getConstant(olContactItem) + + if folder~defaultItemType \== olCIid then do + say 'Folder ('folder~name') does not appear to be a Contacts folder' + say 'Aborting.' + return .false + end + + items = folder~items + do while items~count > 0 + say 'Removing contact item:' items[1]~fullName + items~remove(1) + end + end + + return .true + +/** Class:: CN + * + * This is a simple class of constants. It is used to produce what should be + * unique names for a Store and a Folder within a Store. The example programs + * that use this framework use these constant names so that the example programs + * will not interfer with a user's regular Stores and Folders. + */ +::class 'CN' public + +::constant STORE_PATH 'C:\outlook1_demo_mm.pst' +::constant CONTACTS_FOLDER 'Demo Contacts Folder MM' Deleted: incubator/samples/ole/short.cuts/OleUtils.rex =================================================================== --- incubator/samples/ole/short.cuts/OleUtils.rex 2011-11-27 03:33:59 UTC (rev 7306) +++ incubator/samples/ole/short.cuts/OleUtils.rex 2011-11-27 03:47:05 UTC (rev 7307) @@ -1,445 +0,0 @@ -/*----------------------------------------------------------------------------*/ -/* */ -/* Copyright (c) 2010-2010 Rexx Language Association. All rights reserved. */ -/* */ -/* This program and the accompanying materials are made available under */ -/* the terms of the Common Public License v1.0 which accompanies this */ -/* distribution. A copy is also available at the following address: */ -/* http://www.oorexx.org/license.html */ -/* */ -/* Redistribution and use in source and binary forms, with or */ -/* without modification, are permitted provided that the following */ -/* conditions are met: */ -/* */ -/* Redistributions of source code must retain the above copyright */ -/* notice, this list of conditions and the following disclaimer. */ -/* Redistributions in binary form must reproduce the above copyright */ -/* notice, this list of conditions and the following disclaimer in */ -/* the documentation and/or other materials provided with the distribution. */ -/* */ -/* Neither the name of Rexx Language Association nor the names */ -/* of its contributors may be used to endorse or promote products */ -/* derived from this software without specific prior written permission. */ -/* */ -/* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS */ -/* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT */ -/* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS */ -/* FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT */ -/* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, */ -/* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED */ -/* TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, */ -/* OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY */ -/* OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING */ -/* NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS */ -/* SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ -/* */ -/*----------------------------------------------------------------------------*/ - -/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*\ - File: OleUtils.rex Author: Mark Miesfeld - Creation date: 11/27/2006 - Company: DFX Systems - Project: OLEObject Utilities Last Update: 07/01/2007 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Category: - Framework - - Syntax: - N/A - - Purpose: - Provides some useful utilities for working with the .OLEObject class. - - Assumes: - ooRexx version 3.1.2 as a minimum. - - Notes: - - Changes: -\* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/ - --- End of entry point. - -/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*\ - Directives, Classes, or Routines. -\* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/ - -/* createOleObject( id ) - - - - - - - - - - - - - - - - - - - - - - - - - - -*\ - - Creates an .OLEObject instance, a proxy for the specified COM object. This - routine is used to trap the REXX error that happens when the proxied COM - object can not be created. - - Input: - id REQUIRED - The string used to create the COM object. I.e., the ProgID or CLSID. - - verbose OPTIONAL - If true and the OleObject is not created, the error message is displayed. - If false, the default, the message is not displayed. - - Returns: - An instance of .OLEObject on success, .nil on failure. -\* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/ -::routine createOleObject public - use arg id, verbose - - if isRexxTrue( arg( 2 ) ) then - verbose = .true - else - verbose = .false - - signal on syntax name returnNil - - oleObject = .OLEObject~new( id,"NOEVENTS" ) - signal on syntax - return oleObject - -returnNil: - signal on syntax - if verbose then - say "Error" rc":" errortext(rc)||'0d0a'x||condition('o')~message - - return .nil --- End createOleObject( id, verbose ) - -/* displayKnownMethods( oleObj, verbose )- - - - - - - - - - - - - - - - - - -*\ - - Formats and displays the known methods of an .OLEObject instance. Known - methods can only be displayed for OLE / COM objects that provide TypeInfo. If - the there is no known information, a simple string stating as much is - displayed. - - Input: - oleObj REQUIRED - An instance of the .OLEObject whose known methods are to be displayed. - - verbose OPTIONAL - If true all information concerning the methods is displayed. Parameters, - parameter types, return type, etc.. If false, the default, only the - method names are displayed. - - Returns: - 0 if the specified object is not an instance of the .OLEObject classs, - otherwise 1. -\* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/ -::routine displayKnownMethods public - use arg oleObj, verbose - - if \ oleObj~isInstanceOf( .OLEObject ) then do - say "Known methods can only be displayed for instances of the .OLEObject." - say " Arg 1 class:" oleObj~class - return 0 - end - - if isRexxTrue( arg( 2 ) ) then - verbose = .true - else - verbose = .false - - say - j = printInstanceInfo( oleObj ) - - known. = oleObj~getKnownMethods - - if known. == .nil then do - say "There is no known method information for this object" - return 1 - end - - say "Containing Type Library:" known.!LIBNAME - if known.!LIBDOC~left( 2 ) <> "!L" then - say "Library Description: " known.!LIBDOC - say - - say "COM Class: " known.!COCLASSNAME - if known.!COCLASSDOC~left( 2 ) <> "!C" then - say "Class Description:" known.!COCLASSDOC - say "Known methods: " known.0 - say - - if \ verbose then do - say " Methods:" - do i = 1 to known.0 - say " " known.i.!NAME - end - return 1 - end - - do i = 1 to known.0 - ret = known.i.!RETTYPE - name = known.i.!NAME - doc = known.i.!DOC - invk = known.i.!INVKIND - - say " " name - - if doc~pos( "!DOC" ) == 0 then - say " Decscription:" doc - - say " " invkindToString( invk ) "returns" ret - say - - if ret == "VT_VOID" then - line = " obj~"name - else - line = " " || changeVariant( ret ) || "= obj~"name - - select - when invk == 2 then - say line - - when known.i.!PARAMS.0 == 0 then - say line"()" - - otherwise do - line = line"( " - indent = " "~copies( line~length ) - - do j = 1 to known.i.!PARAMS.0 - param = known.i.!PARAMS.j.!TYPE known.i.!PARAMS.j.!FLAGS - - known.i.!PARAMS.j.!NAME - - select - when j == 1 & known.i.!PARAMS.0 == 1 then do - say line || param" )" - end - when j == 1 then do - say line || param"," - end - when j == known.i.!PARAMS.0 then do - say indent || param" )" - end - otherwise do - say indent || param"," - end - end - -- End select - end - -- End do j = 1 to known.i.!PARAMS.0 - end - -- End otherwise do - end - -- End select - - say - end - -- End do i = 1 to known.0 - -return 1 --- End displayKnownMethods( oleObj ) - -/* displayKnownConstants( oleObj ) - - - - - - - - - - - - - - - - - - - - - -*\ - - Prints out all the known constants for the specified object, if any are - available. - - Input: - oleObj REQUIRED - An instance of the .OLEObject whose known methods are to be displayed. - - Returns: - 0 if the oleObj argument was not an instance of .OLEObject, otherwise 1. -\* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/ -::routine displayKnownConstants public - use arg oleObj - - if \ oleObj~isInstanceOf( .OLEObject ) then do - say "Known constants can only be displayed for instances of the .OLEObject." - say " Arg 1 class:" oleObj~class - return 0 - end - - say - j = printInstanceInfo( oleObj ) - - constants = oleObj~getConstant - if constants == .nil | constants~items == 0 then do - say "There are no known constants for this object" - return 1 - end - - say "Known constants:" constants~items - say - - -- Some of Microsoft's constant names are very long. - line = " "~copies( 42 ) || "= " - do name over constants - say line~overlay( name~substr( 2 ), 3 ) || constants[name] - end - -return 1 --- End displayKnownConstants( oleObj ) - -/* changeVariant( vt ) - - - - - - - - - - - - - - - - - - - - - - - - - - - -*\ - - Helper function to turn a VARTYPE symbol into a "prettified" object name. - - E.g., VT_DISPATCH becomes dispatchObj, VT_I4 becomes i4Obj. - - Input: - vt REQUIRED - - OPTIONAL - - Returns: - The prettified version of the specified VARTYPE. -\* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/ -::routine changeVariant - use arg vt - - -- DFX TODO: it would be nice to turn VT_I4 to something like int4ByteObj, - -- VT_R4 to float4ByteObj - -return toLower( vt~substr( 4 ) ) || "Obj" --- End changeVariant( vt ) - -/* invkindToString( kind ) - - - - - - - - - - - - - - - - - - - - - - - - - -*\ - - Helper function to return a string value for the specified invocation type. - - Input: - kind REQUIRED - A number representing a COM INVOKEKIND enumeration. - - Returns: - Returns the enumeration symbol, (string symbol) for the specified kind. -\* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/ -::routine invkindToString - use arg kind - - select - when kind == 1 then - kindString = "<Function>" - when kind == 2 then - kindString = "<Property get>" - when kind == 4 then - kindString = "<Property put>" - when kind == 8 then - kindString = "<Property put by reference>" - otherwise - kindString = "<Error Invalid! ("kind")>" - end - -- End select - -return kindString --- End invkindToString( kind ) - -/* toLower( str )- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*\ - - Changes the specified string to lower case. - - Input: - str REQUIRED - The string to work with. - - Returns: - The string with all upper case letters changed to lower case. -\* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/ -::routine toLower public - use arg str - - if str~class <> .string then - return str - - lower = str~translate( "abcdefghijklmnopqrstuvwxyz", - - "ABCDEFGHIJKLMNOPQRSTUVWXYZ" ) - -return lower --- End toLower( str ) - -/* isRexxTrue( obj ) - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*\ - - Tests if obj is strictly .true. (To some degree, actually just tests that obj - is exactly '1'.) - - Input: - obj REQUIRED - The object to test. - - Returns: - True if obj is strictly true, otherwise false. -\* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/ -::routine isRexxTrue public - use arg obj - - if obj~class == .string then - if obj~datatype( 'W' ) then - if obj == 1 then - return .true - -return .false --- End isRexxTrue( obj ) - -/* isOORexx4OrLater( ) - - - - - - - - - - - - - - - - - - - - - - - - - - - -*\ - - Returns true if the running interpreter is ooRexx 4.0.0 or later. - - Input: - None. - - Returns: - True if this is ooRexx 4.0.0 or later, otherwise false. -\* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/ -::routine isOORexx4OrLater public - - parse version interpreterName languageLevel interpreterDate - parse var interpreterName junk "_" ver "." moreJunk - if ver >= 4 then return .true - -return .false --- End isOORexx4OrLater( ) - -/* printInstanceInfo( oleObj ) - - - - - - - - - - - - - - - - - - - - - - - -*\ - - Helper function to print out instance information for an .OLEObject object. - - Input: - oleObj REQUIRED - The object whose instance information is to be printed. - - Returns: - 0, always. -\* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/ -::routine printInstanceInfo - use arg oleObj - - progID = oleObj~!getVar( "!PROGID" ) - clsID = oleObj~!getVar( "!CLSID" ) - disp = oleObj~!getVar( "!IDISPATCH" ) - typeInfo = oleObj~!getVar( "!ITYPEINFO" ) - - if isOORexx4OrLater() then do - if progID == .nil then - progID = "null" - if clsID == .nil then - clsID = "null" - if disp == .nil then - disp = "null" - if typeInfo == .nil then - typeInfo = "null" - end - else do - if progID~left( 2 ) == "!P" then - progID = "null" - if clsID~left( 2 ) == "!C" then - clsID = "null" - if disp~left( 3 ) == "!ID" then - disp = "null" - if typeInfo~left( 3 ) == "!IT" then - typeInfo = "null" - end - - say "ProgID: " progID - say "ClsID: " clsID - say "Dispatch Pointer:" disp - say "TypeInfo Pointer:" typeInfo - say - -return 0 --- End printInstanceInfo( oleObj ) - - - -/* - - - - - - - - - - End of file: OleUtils.rex- - - - - - - - - - - - - - - */ This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |