Extended MAPI example
Posted: Wed Apr 28, 2004 9:34 am
This example shows the basis of extended MAPI 'logic' and behaviour (all is handled with tables, using a COM interface). It's not difficult to extend this code to read each message content, attachment etc..
The include file:
And the main source (you need to put the path to mapi dll). Extended MAPI doesn't work with Outlook Express, you will need Outlook to test it (or Lotus, etc..)
The include file:
Code: Select all
;
; MAPI include file for PureBasic (very incomplete)
;
#MAPI_DIM = 1
#MAPI_E_AMBIGUOUS_RECIP = $80040700
#MAPI_E_BAD_CHARWIDTH = $80040103
#MAPI_E_BAD_COLUMN = $80040118
#MAPI_E_BAD_VALUE = $80040301
#MAPI_E_BUSY = $8004010B
#MAPI_E_CALL_FAILED = $80004005
#MAPI_E_CANCEL = $80040501
#MAPI_E_COLLISION = $80040604
#MAPI_E_COMPUTED = $8004011A
#MAPI_E_CORRUPT_DATA = $8004011B
#MAPI_E_CORRUPT_STORE = $80040600
#MAPI_E_DECLINE_COPY = $80040306
#MAPI_E_DISK_ERROR = $80040116
#MAPI_E_END_OF_SESSION = $80040200
#MAPI_E_EXTENDED_ERROR = $80040119
#MAPI_E_FAILONEPROVIDER = $8004011D
#MAPI_E_FOLDER_CYCLE = $8004060B
#MAPI_E_HAS_FOLDERS = $80040609
#MAPI_E_HAS_MESSAGES = $8004060A
#MAPI_E_INTERFACE_NOT_SUPPORTED = $80004002
#MAPI_E_INVALID_BOOKMARK = $80040405
#MAPI_E_INVALID_ENTRYID = $80040107
#MAPI_E_INVALID_OBJECT = $80040108
#MAPI_E_INVALID_PARAMETER = $80070057
#MAPI_E_INVALID_TYPE = $80040302
#MAPI_E_LOGON_FAILED = $80040111
#MAPI_E_MISSING_REQUIRED_COLUMN = $80040202
#MAPI_E_NETWORK_ERROR = $80040115
#MAPI_E_NO_ACCESS = $80070005
#MAPI_E_NO_RECIPIENTS = $80040607
#MAPI_E_NO_SUPPORT = $80040102
#MAPI_E_NO_SUPPRESS = $80040602
#MAPI_E_NON_STANDARD = $80040606
#MAPI_E_NOT_ENOUGH_DISK = $8004010D
#MAPI_E_NOT_ENOUGH_MEMORY = $8007000E
#MAPI_E_NOT_ENOUGH_RESOURCES = $8004010E
#MAPI_E_NOT_FOUND = $8004010F
#MAPI_E_NOT_IN_QUEUE = $80040601
#MAPI_E_NOT_INITIALIZED = $80040605
#MAPI_E_NOT_ME = $80040502
#MAPI_E_OBJECT_CHANGED = $80040109
#MAPI_E_OBJECT_DELETED = $8004010A
#MAPI_E_SESSION_LIMIT = $80040112
#MAPI_E_STRING_TOO_LONG = $80040105
#MAPI_E_SUBMITTED = $80040608
#MAPI_E_TABLE_EMPTY = $80040402
#MAPI_E_TABLE_TOO_BIG = $80040403
#MAPI_E_TIMEOUT = $80040401
#MAPI_E_TOO_BIG = $80040305
#MAPI_E_TOO_COMPLEX = $80040117
#MAPI_E_TYPE_NO_SUPPORT = $80040303
#MAPI_E_UNABLE_TO_ABORT = $80040114
#MAPI_E_UNABLE_TO_COMPLETE = $80040400
#MAPI_E_UNCONFIGURED = $8004011C
#MAPI_E_UNEXPECTED_ID = $80040307
#MAPI_E_UNEXPECTED_TYPE = $80040304
#MAPI_E_UNKNOWN_ENTRYID = $80040201
#MAPI_E_UNKNOWN_FLAGS = $80040106
#MAPI_E_USER_CANCEL = $80040113
#MAPI_E_VERSION = $80040110
#MAPI_E_WAIT = $80040500
#MAPI_W_APPROX_COUNT = $40482
#MAPI_W_CANCEL_MESSAGE = $40580
#MAPI_W_ERRORS_RETURNED = $40380
#MAPI_W_NO_SERVICE = $40203
#MAPI_W_PARTIAL_COMPLETION = $40680
#MAPI_W_POSITION_CHANGED = $40481
#TBL_NOADVANCE = $00000001
#PR_DEFAULT_PROFILE = $3d04000b
#PR_DISPLAY_NAME = $3001001e
#PR_RESOURCE_FLAGS = $30090003
#PR_ENTRYID = $0fff0102
#PR_IPM_SUBTREE_ENTRYID = $35e00102
#PR_CONTAINER_HIERARCHY = $360e000d
#PR_SUBFOLDERS = $306a000b
#MAPI_LOGON_UI = $00000001 ; Display logon UI
#MAPI_NEW_SESSION = $00000002 ; Don't use shared session
#MAPI_ALLOW_OTHERS = $00000008 ; Make this a Shared session
#MAPI_EXPLICIT_PROFILE = $00000010 ; Don't use default profile
#MAPI_EXTENDED = $00000020 ; Extended MAPI Logon
#MAPI_FORCE_DOWNLOAD = $00001000 ; Get new mail before Return
#MAPI_SERVICE_UI_ALWAYS = $00002000 ; Do logon UI in all providers
#MAPI_NO_MAIL = $00008000 ; Do not activate transports
#STATUS_VALIDATE_STATE = $00000001
#STATUS_SETTINGS_DIALOG = $00000002
#STATUS_CHANGE_PASSWORD = $00000004
#STATUS_FLUSH_QUEUES = $00000008
#STATUS_DEFAULT_OUTBOUND = $00000001
#STATUS_DEFAULT_STORE = $00000002
#STATUS_PRIMARY_IDENTITY = $00000004
#STATUS_SIMPLE_STORE = $00000008
#STATUS_XP_PREFER_LAST = $00000010
#STATUS_NO_PRIMARY_IDENTITY = $00000020
#STATUS_NO_DEFAULT_STORE = $00000040
#STATUS_TEMP_SECTION = $00000080
#STATUS_OWN_STORE = $00000100
#STATUS_NEED_IPM_TREE = $00000800
#STATUS_PRIMARY_STORE = $00001000
#STATUS_SECONDARY_STORE = $00002000
#MDB_NO_DIALOG = $00000001
#MDB_WRITE = $00000004
#MDB_TEMPORARY = $00000020
#MDB_NO_MAIL = $00000080
; Object type
#MAPI_STORE = $00000001 ; Message Store
#MAPI_ADDRBOOK = $00000002 ; Address Book
#MAPI_FOLDER = $00000003 ; Folder
#MAPI_ABCONT = $00000004 ; Address Book Container
#MAPI_MESSAGE = $00000005 ; Message
#MAPI_MAILUSER = $00000006 ; Individual Recipient
#MAPI_ATTACH = $00000007 ; Attachment
#MAPI_DISTLIST = $00000008 ; Distribution List Recipient
#MAPI_PROFSECT = $00000009 ; Profile Section
#MAPI_STATUS = $0000000A ; Status Object
#MAPI_SESSION = $0000000B ; Session
#MAPI_FORMINFO = $0000000C ; Form Information
Structure SPropTagArray
NbTags.l
Tags.l[0]
EndStructure
Structure SBinary
cb.l
lpb.l
EndStructure
Structure PV
StructureUnion
i.w ; case PT_I2
l.l ; case PT_LONG
ul.l ; alias for PT_LONG
flt.f ; case PT_R4
dbl.f ; case PT_DOUBLE
b.b ; case PT_BOOLEAN
cur.l ; case PT_CURRENCY
at.l ; case PT_APPTIME
ft.FILETIME ; case PT_SYSTIME
lpszA.l ; case PT_STRING8
bin.SBinary ; case PT_BINARY
lpszW.l ; case PT_UNICODE
*lpguid.GUID ; case PT_CLSID
li.LARGE_INTEGER ; case PT_I8
;SShortArray MVi; /* case PT_MV_I2 */
;SLongArray MVl; /* case PT_MV_LONG */
;SRealArray MVflt; /* case PT_MV_R4 */
;SDoubleArray MVdbl; /* case PT_MV_DOUBLE */
;SCurrencyArray MVcur; /* case PT_MV_CURRENCY */
;SAppTimeArray MVat; /* case PT_MV_APPTIME */
;SDateTimeArray MVft; /* case PT_MV_SYSTIME */
;SBinaryArray MVbin; /* case PT_MV_BINARY */
;SLPSTRArray MVszA; /* case PT_MV_STRING8 */
;SWStringArray MVszW; /* case PT_MV_UNICODE */
;SGuidArray MVguid; /* case PT_MV_CLSID */
;SLargeIntegerArray MVli; /* case PT_MV_I8 */
;SCODE err; /* case PT_ERROR */
x.l; /* case PT_NULL, PT_OBJECT (no usable value) */
EndStructureUnion
EndStructure
Structure SPropValueItem
ulPropTag.l
dwAlignPad.l
Value.PV
EndStructure
Structure SPropValue
Array.SPropValueItem[0] ; We added an extra array, as PB can't do array indexing of structure as C does
EndStructure
Structure SRow
ulAdrEntryPad.l ; Pad so SRow's can map to ADRENTRY's
cValues.l ; Count of property values
*lpProps.SPropValue[0] ; Property value array
EndStructure
Structure SRowSet
cRows.l ; Count of rows
aRow.SRow[0] ; Array of rows
EndStructure
Structure SRestriction
; Todo
EndStructure
Structure SSortOrderSet
; Todo
EndStructure
Code: Select all
;
; Extended MAPI example in PureBasic
;
; It enumerates the profils, try to log in the default profil and list the
; root folder and its sub-folders. It made wide use the PB COM Interface.
;
; This code is based on Lucian Wischik one the which can be found here:
; http://www.wischik.com/lu/programmer/mapi_utils.html
;
; Fred - AlphaSND
;
IncludeFile "Mapi.pbi"
Global MAPIInitialize, MAPIAdminProfiles, MAPILogonEx, MAPIUninitialize, MAPIFreeBuffer
Global *RootStore.IMAPIFolder
; Opens the MAPI dll, and lookup for the needed functions, dynamically
;
Procedure InitializeMAPI(DllName$)
If OpenLibrary(0, DllName$)
MAPIInitialize = IsFunction(0, "MAPIInitialize")
MAPIAdminProfiles = IsFunction(0, "MAPIAdminProfiles")
MAPILogonEx = IsFunction(0, "MAPILogonEx")
MAPIUninitialize = IsFunction(0, "MAPIUninitialize")
MAPIFreeBuffer = IsFunction(0, "MAPIFreeBuffer")
If MAPIInitialize And MAPIAdminProfiles And MAPILogonEx And MAPIUninitialize And MAPIFreeBuffer
If CallFunctionFast(MAPIInitialize, 0) = #S_OK
ProcedureReturn 1
EndIf
EndIf
CloseLibrary(0)
EndIf
EndProcedure
; Each DLL implements its own free function, so it needs to be virtual
;
Procedure MAPIFreeBuffer (*Buffer)
CallFunctionFast(MAPIFreeBuffer, *Buffer)
EndProcedure
; Helper function: does a query on a table and returns all the rows
;
Procedure MAPIQueryTableRows(*Table.IMAPITable, *Tags.SPropTagArray, *res.SRestriction, *sort.SSortOrderSet, NbRowsMax, *rows.SRowSet)
If *Tags
*Table\SetColumns(*Tags,0)
EndIf
If *res
*Table\Restrict(*res,0)
EndIf
If *sort
*Table\SortTable(*sort,0);
EndIf
If NbRowsMax = 0
NbRowsMax =$0FFFFFFF
EndIf
hr = #MAPI_E_BUSY
While hr = #MAPI_E_BUSY
hr = *Table\QueryRows(NbRowsMax, #TBL_NOADVANCE, *rows)
If hr = #MAPI_E_BUSY
hr = *Table\WaitForCompletion(0, 1000, 0)
If hr <> #MAPI_E_NO_SUPPORT
hr = #MAPI_E_BUSY
EndIf
EndIf
Wend
ProcedureReturn hr
EndProcedure
; Helper function: returns the specified property in string form
;
Procedure$ MAPIGetStringProperty(*TableRows.SRowSet, Index, PropertyIndex, Property)
If *TableRows\aRow[Index]\lpProps\Array[PropertyIndex]\ulPropTag = Property
Result$ = PeekS(*TableRows\aRow[Index]\lpProps\Array[PropertyIndex]\Value\lpszA)
EndIf
ProcedureReturn Result$
EndProcedure
; Helper function: returns the specified property in numeric form
;
Procedure MAPIGetNumericProperty(*TableRows.SRowSet, Index, PropertyIndex, Property)
If *TableRows\aRow[Index]\lpProps\Array[PropertyIndex]\ulPropTag = Property
Result = *TableRows\aRow[Index]\lpProps\Array[PropertyIndex]\Value\l
EndIf
ProcedureReturn Result
EndProcedure
; Free all the memory which was allocated when the MAPIQueryTableRows() function was called
;
Procedure FreeTableRows(*TableRows.SRowSet)
If *TableRows
For k=0 To *TableRows\cRows-1
MAPIFreeBuffer(*TableRows\aRow[k]\lpProps)
Next
MAPIFreeBuffer(*TableRows)
EndIf
EndProcedure
; This functions exists in some MAPI dll, but not all, so it's implemented again
;
Procedure MAPIGetOneProp(*Object.IMAPIProp, Tag, *Property.SPropValue)
If *Property = 0
ProcedureReturn #E_POINTER
EndIf
Dim TagArray.l(1)
TagArray(0) = 1 ; NbTags
TagArray(1) = Tag
hr = *Object\GetProps(@TagArray(), 0, @Count, *Property)
If hr = #S_OK
ProcedureReturn #S_OK
EndIf
If hr = #MAPI_W_ERRORS_RETURNED
MAPIFreeBuffer(PeekL(*Property))
ProcedureReturn #MAPI_E_NOT_FOUND;
EndIf
ProcedureReturn hr
EndProcedure
Procedure MAPIEnumerateSubFolders(*Store.IMAPIFolder)
; The famous GUID, converted in PB format
;
DataSection
PB_IID_IMAPITable:
Data.l $00020301
Data.w 0, 0
Data.b $C0,0,0,0,0,0,0,$46
EndDataSection
If *Store\OpenProperty(#PR_CONTAINER_HIERARCHY, ?PB_IID_IMAPITable, 0, 0, @hierarchy.IMAPITable) = #S_OK
; The columns the query should return
;
#NbSValues = 3
Dim TagArray.l(#NbSValues)
TagArray(0) = #NbSValues
TagArray(1) = #PR_ENTRYID
TagArray(2) = #PR_DISPLAY_NAME
TagArray(3) = #PR_SUBFOLDERS
If MAPIQueryTableRows(hierarchy, @TagArray(), 0, 0, 0, @*TableRows.SRowSet) = #S_OK
NbRows = *TableRows\cRows
If NbRows
Debug "Listing "+Str(NbRows)+" SubFolders(s) -----------"
For k=0 To NbRows-1
ProfileName$ = MAPIGetStringProperty (*TableRows, k, 1, #PR_DISPLAY_NAME)
Debug " -> "+ProfileName$
If *Store\OpenEntry(*TableRows\aRow[k]\lpProps\Array[0]\Value\bin\cb, *TableRows\aRow[k]\lpProps\Array[0]\Value\bin\lpb, 0, 0, @SubFolderType, @SubFolder.IMAPIFolder) = #S_OK
MAPIEnumerateSubFolders(SubFolder)
SubFolder\Release()
EndIf
Next
EndIf
FreeTableRows(*TableRows)
EndIf
EndIf
ProcedureReturn iNbSubFolders;
EndProcedure
Procedure MAPIExamineStore(*MessageStore.IMsgStore)
hr = MAPIGetOneProp(*MessageStore, #PR_IPM_SUBTREE_ENTRYID, @*ipm_eid.SPropValue)
If hr = #S_OK
If *MessageStore\OpenEntry(*ipm_eid\Array[0]\Value\bin\cb, *ipm_eid\Array[0]\Value\bin\lpb, 0, 0, @ipmroottype.l, @ipmroot.IMAPIFolder) = #S_OK
MAPIEnumerateSubFolders(ipmroot)
ipmroot\Release();
EndIf
MAPIFreeBuffer(*ipm_eid);
EndIf
EndProcedure
; The mapi dll path, has to be set manually (can be retrieved from the registry too)
;
DllName$ = ; "C:\Program Files\Fichiers communs\System\MSMAPI\1036\MAPI32.dll"
If InitializeMAPI(DllName$)
; List all the profiles
;
If CallFunctionFast(MAPIAdminProfiles, 0, @ProfileAdministration.IProfAdmin) = #S_OK
If ProfileAdministration\GetProfileTable(0, @ProfileTable.IMAPITable) = #S_OK
#NbValues = 2
Dim TagArray.l(#NbValues)
TagArray(0) = #NbValues
TagArray(1) = #PR_DISPLAY_NAME
TagArray(2) = #PR_DEFAULT_PROFILE
If MAPIQueryTableRows(ProfileTable, @TagArray(), 0, 0, 0, @*TableRows.SRowSet) = #S_OK
NbRows = *TableRows\cRows
Debug "Listing "+Str(NbRows)+" Profile(s) -----------"
For k=0 To NbRows-1
ProfileName$ = MAPIGetStringProperty (*TableRows, k, 0, #PR_DISPLAY_NAME)
If MAPIGetNumericProperty(*TableRows, k, 1, #PR_DEFAULT_PROFILE)
DefaultProfileName$ = ProfileName$
EndIf
Debug " -> "+ProfileName$
Next
Debug "----------------------------------------"
FreeTableRows(*TableRows)
EndIf
ProfileTable\Release()
EndIf
If DefaultProfileName$
Debug "We got a default profile, so try to login..."
If CallFunctionFast(MAPILogonEx, 0, DefaultProfileName$, 0, #MAPI_NEW_SESSION|#MAPI_EXTENDED|#MAPI_NO_MAIL, @Session.IMAPISession) = #S_OK
If Session\GetMsgStoresTable(0, @StoresTable.IMAPITable) = #S_OK
#NbStoreTableColumns = 3
Dim TagArray.l(#NbStoreTableColumns)
TagArray(0) = #NbStoreTableColumns
TagArray(1) = #PR_DISPLAY_NAME
TagArray(2) = #PR_RESOURCE_FLAGS
TagArray(3) = #PR_ENTRYID
If MAPIQueryTableRows(StoresTable, TagArray(), 0, 0, 0, @*TableRows.SRowSet) = #S_OK
NbRows = *TableRows\cRows
Debug "Listing "+Str(NbRows)+" Store(s) -----------"
For k=0 To NbRows-2
StoreName$ = MAPIGetStringProperty (*TableRows, k, 0, #PR_DISPLAY_NAME)
If MAPIGetNumericProperty(*TableRows, k, 1, #PR_RESOURCE_FLAGS) & #STATUS_DEFAULT_STORE
DefaultStoreName$ = StoreName$
Debug " -> "+StoreName$+ " (Default)"
Else
Debug " -> "+StoreName$
EndIf
If Session\OpenMsgStore(GetActiveWindow_(), *TableRows\aRow[k]\lpProps\Array[2]\Value\bin\cb, *TableRows\aRow[k]\lpProps\Array[2]\Value\bin\lpb, 0, #MDB_NO_MAIL, @*MessageStore.IMsgStore) = #S_OK
*RootStore = *MessageStore
MAPIExamineStore(*MessageStore)
*MessageStore\Release()
EndIf
Next
Debug "----------------------------------------"
FreeTableRows(*TableRows)
EndIf
StoresTable\Release()
EndIf
Session\Logoff(0, 0, 0)
Session\Release()
EndIf
EndIf
ProfileAdministration\Release()
EndIf
EndIf
.swf movies and FSCommands running in PB sans web/ie interface 
)
