Extended MAPI example

Share your advanced PureBasic knowledge/code with the community.
Fred
Administrator
Administrator
Posts: 18210
Joined: Fri May 17, 2002 4:39 pm
Location: France
Contact:

Extended MAPI example

Post by Fred »

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:

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
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..)

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
Dare2
Moderator
Moderator
Posts: 3321
Joined: Sat Dec 27, 2003 3:55 am
Location: Great Southern Land

Post by Dare2 »

Thank you. :D

(If you're ever at a loose end and feel the urge to get another PB goodie going ..
:arrow: .swf movies and FSCommands running in PB sans web/ie interface :) ;) )
Blade
Enthusiast
Enthusiast
Posts: 362
Joined: Wed Aug 06, 2003 2:49 pm
Location: Venice - Italy, Japan when possible.
Contact:

Post by Blade »

yes yes yes! 8)

I've seen great thing made with Vbasic and Fscommand/Flash
kinglestat
Enthusiast
Enthusiast
Posts: 746
Joined: Fri Jul 14, 2006 8:53 pm
Location: Malta
Contact:

Post by kinglestat »

I tried this example...seems exactly what I need
but I get error "invalid memory access" on line 93
any ideas?

If *TableRows\aRow[Index]\lpProps\Array[PropertyIndex]\ulPropTag = Property
I may not help with your coding
Just ask about mental issues!

http://www.lulu.com/spotlight/kingwolf
http://www.sen3.net
kinglestat
Enthusiast
Enthusiast
Posts: 746
Joined: Fri Jul 14, 2006 8:53 pm
Location: Malta
Contact:

Post by kinglestat »

Fred?
Pretty please?
I may not help with your coding
Just ask about mental issues!

http://www.lulu.com/spotlight/kingwolf
http://www.sen3.net
IdeasVacuum
Always Here
Always Here
Posts: 6426
Joined: Fri Oct 23, 2009 2:33 am
Location: Wales, UK
Contact:

Re: Extended MAPI example

Post by IdeasVacuum »

Tried to update this code for 4.51:

Replaced IsFunction with GetFunction.

Do not know to replace this line however:

Code: Select all

If CallFunctionFast(MAPILogonEx, 0, DefaultProfileName$, 0, #MAPI_NEW_SESSION|#MAPI_EXTENDED|#MAPI_NO_MAIL, @Session.IMAPISession) = #S_OK
Has anyone else tackled this?
IdeasVacuum
If it sounds simple, you have not grasped the complexity.
User avatar
netmaestro
PureBasic Bullfrog
PureBasic Bullfrog
Posts: 8451
Joined: Wed Jul 06, 2005 5:42 am
Location: Fort Nelson, BC, Canada

Re: Extended MAPI example

Post by netmaestro »

If you replace the string parameter with a pointer to the string all should be well:

Code: Select all

If CallFunctionFast(MAPILogonEx, 0, @DefaultProfileName$, 0, #MAPI_NEW_SESSION|#MAPI_EXTENDED|#MAPI_NO_MAIL, @Session.IMAPISession) = #S_OK
(@DefaultProfileName$ instead of DefaultProfileName$ in case you didn't notice)

Alternatively, you can make a prototype and use that instead of CallfunctionFast. This is preferred anyway but didn't exist when Fred wrote this.
BERESHEIT
IdeasVacuum
Always Here
Always Here
Posts: 6426
Joined: Fri Oct 23, 2009 2:33 am
Location: Wales, UK
Contact:

Re: Extended MAPI example

Post by IdeasVacuum »

Thank you very much netmaestro

The code now compiles and runs. :D Currently, there is no output sent to Debug :cry:
IdeasVacuum
If it sounds simple, you have not grasped the complexity.
Post Reply