mapix.pas

Drag files and Drop to delphi forms 0402

      function OpenEntry (cbEntryID : ULONG; lpEntryID : PENTRYID;
        const lpInterface : TIID; ulFlags : ULONG; var lpulObjType : ULONG;
        out lppUnk : IUnknown) : HResult; stdcall;
      function CompareEntryIDs (cbEntryID1 : ULONG; lpEntryID1 : PENTRYID;
        cbEntryID2 : ULONG; lpEntryID2 : PENTRYID; ulFlags : ULONG;
        var lpulResult : ULONG) : HResult; stdcall;
      function Advise (cbEntryID : ULONG; lpEntryID : PENTRYID;
        ulEventMask : ULONG; lpAdviseSink : IMAPIAdviseSink;
        var lpulConnection : ULONG) : HResult; stdcall;
      function Unadvise (ulConnection : ULONG) : HResult; stdcall;
      function MessageOptions (ulUIParam : ULONG; ulFlags : ULONG;
        lpszAdrType : PChar; lpMessage : IMessage) : HResult; stdcall;
      function QueryDefaultMessageOpt (lpszAdrType : PChar; ulFlags : ULONG;
        var lpcValues : ULONG; var lppOptions : PSPropValue) : HResult; stdcall;
      function EnumAdrTypes (ulFlags : ULONG; var lpcAdrTypes : ULONG;
        var lpppszAdrTypes : PChar) : HResult; stdcall;
      function QueryIdentity (var lpcbEntryID : ULONG;
        var lppEntryID : PENTRYID) : HResult; stdcall;
      function Logoff (ulUIParam : ULONG; ulFlags : ULONG;
        ulReserved : ULONG) : HResult; stdcall;
      function SetDefaultStore (ulFlags : ULONG; cbEntryID : ULONG;
        lpEntryID : PENTRYID) : HResult; stdcall;
      function AdminServices (ulFlags : ULONG;
        out lppServiceAdmin : IMsgServiceAdmin) : HResult; stdcall;
      function ShowForm (ulUIParam : ULONG; lpMsgStore : IMsgStore;
        lpParentFolder : IMAPIFolder; const lpInterface : TIID;
        ulMessageToken : ULONG; lpMessageSent : IMessage; ulFlags : ULONG;
        ulMessageStatus : ULONG; ulMessageFlags : ULONG; ulAccess : ULONG;
        lpszMessageClass : LPSTR) : HResult; stdcall;
      function PrepareForm (const lpInterface : TIID; lpMessage : IMessage;
        var lpulMessageToken : ULONG) : HResult; stdcall;
    end;

  IAddrBook =
    interface(IMAPIProp)
    [strIID_IAddrBook]  
      function OpenEntry (cbEntryID : ULONG; lpEntryID : PENTRYID; const lpInterface : TIID;
        ulFlags : ULONG; var lpulObjType : ULONG; out lppUnk : IUnknown) : HResult; stdcall;
      function CompareEntryIDs (cbEntryID1 : ULONG; lpEntryID1 : PENTRYID; 
        cbEntryID2 : ULONG; lpEntryID2 : PENTRYID; ulFlags : ULONG; 
        var lpulResult : ULONG) : HResult; stdcall;
      function Advise (cbEntryID : ULONG; lpEntryID : PENTRYID; ulEventMask : ULONG; 
        lpAdviseSink : IMAPIAdviseSink; var lpulConnection : ULONG) : HResult; stdcall;
      function Unadvise (ulConnection : ULONG) : HResult; stdcall;
      function CreateOneOff (lpszName : PChar; lpszAdrType : PChar;
        lpszAddress : PChar; ulFlags : ULONG; var lpcbEntryID : ULONG;
        var lppEntryID : PENTRYID) : HResult; stdcall;
      function NewEntry (ulUIParam : ULONG; ulFlags : ULONG; cbEIDContainer : ULONG; 
        lpEIDContainer : PENTRYID; cbEIDNewEntryTpl : ULONG; 
        lpEIDNewEntryTpl : PENTRYID; var lpcbEIDNewEntry : ULONG; 
        var lppEIDNewEntry : PENTRYID) : HResult; stdcall;
      function ResolveName (ulUIParam : ULONG; ulFlags : ULONG;
        lpszNewEntryTitle : PChar; lpAdrList : PADRLIST) : HResult; stdcall;
      function Address (var lpulUIParam : ULONG; lpAdrParms : PADRPARM; 
        var lppAdrList : PADRLIST) : HResult; stdcall;
      function Details (var lpulUIParam : ULONG; lpfnDismiss : PFNDISMISS; 
        lpvDismissContext : Pointer; cbEntryID : ULONG; lpEntryID : PENTRYID; 
        lpfButtonCallback : PFNBUTTON; lpvButtonContext : Pointer; 
        lpszButtonText : PChar; ulFlags : ULONG) : HResult; stdcall;
      function RecipOptions (ulUIParam : ULONG; ulFlags : ULONG;
        lpRecip : PADRENTRY) : HResult; stdcall;
      function QueryDefaultRecipOpt (lpszAdrType : PChar; ulFlags : ULONG;
        var lpcValues : ULONG; var lppOptions : PSPropValue) : HResult; stdcall;
      function GetPAB (var lpcbEntryID : ULONG;
        var lppEntryID : PENTRYID) : HResult; stdcall;
      function SetPAB (cbEntryID : ULONG;
        lpEntryID : PENTRYID) : HResult; stdcall;
      function GetDefaultDir (var lpcbEntryID : ULONG;
        var lppEntryID : PENTRYID) : HResult; stdcall;
      function SetDefaultDir (cbEntryID : ULONG;
        lpEntryID : PENTRYID) : HResult; stdcall;
      function GetSearchPath (ulFlags : ULONG;
        var lppSearchPath : PSRowSet) : HResult; stdcall;
      function SetSearchPath (ulFlags : ULONG;
        lpSearchPath : PSRowSet) : HResult; stdcall;
      function PrepareRecips (ulFlags : ULONG; lpPropTagArray : PSPropTagArray;
        lpRecipList : PADRLIST) : HResult; stdcall;
    end;

  IProfAdmin =
    interface(IUnknown)
    [strIID_IProfAdmin]
      function GetLastError (hResult : HResult; ulFlags : ULONG;
        var lppMAPIError : PMAPIERROR) : HResult; stdcall;
      function GetProfileTable (ulFlags : ULONG; out lppTable : IMAPITable) : HResult; stdcall;
      function CreateProfile (lpszProfileName : PChar; lpszPassword : PChar; 
        ulUIParam : ULONG; ulFlags : ULONG) : HResult; stdcall;
      function DeleteProfile (lpszProfileName : PChar; ulFlags : ULONG) : HResult; stdcall;
      function ChangeProfilePassword (lpszProfileName : PChar; 
        lpszOldPassword : PChar; lpszNewPassword : PChar; ulFlags : ULONG) : HResult; stdcall;
      function CopyProfile (lpszOldProfileName : PChar; lpszOldPassword : PChar; 
        lpszNewProfileName : PChar; ulUIParam : ULONG; ulFlags : ULONG) : HResult; stdcall;
      function RenameProfile (lpszOldProfileName : PChar; lpszOldPassword : PChar; 
        lpszNewProfileName : PChar; ulUIParam : ULONG; ulFlags : ULONG) : HResult; stdcall;
      function SetDefaultProfile (lpszProfileName : PChar; ulFlags : ULONG) : HResult; stdcall;
      function AdminServices (lpszProfileName : PChar; lpszPassword : PChar; 
        ulUIParam : ULONG; ulFlags : ULONG; out lppServiceAdmin : IMsgServiceAdmin) : HResult; stdcall;
    end;

  IMsgServiceAdmin =
    interface(IUnknown)
    [strIID_IMsgServiceAdmin]
      function GetLastError (hResult : HResult; ulFlags : ULONG;
        var lppMAPIError : PMAPIERROR) : HResult; stdcall;
      function GetMsgServiceTable (ulFlags : ULONG; out lppTable : IMAPITable) : HResult; stdcall;
      function CreateMsgService (lpszService : PChar; lpszDisplayName : PChar; 
        ulUIParam : ULONG; ulFlags : ULONG) : HResult; stdcall;
      function DeleteMsgService (lpUID : PMAPIUID) : HResult; stdcall;
      function CopyMsgService (lpUID : PMAPIUID; lpszDisplayName : PChar; 
        const lpInterfaceToCopy : TIID; const lpInterfaceDst : TIID;
        lpObjectDst : Pointer; ulUIParam : ULONG;
        ulFlags : ULONG) : HResult; stdcall;
      function RenameMsgService (lpUID : PMAPIUID; ulFlags : ULONG; 
        lpszDisplayName : PChar) : HResult; stdcall;
      function ConfigureMsgService (lpUID : PMAPIUID; ulUIParam : ULONG; 
        ulFlags : ULONG; cValues : ULONG; lpProps : PSPropValue) : HResult; stdcall;
      function OpenProfileSection (lpUID : PMAPIUID; const lpInterface : TIID;
        ulFlags : ULONG; out lppProfSect : IProfSect) : HResult; stdcall;
      function MsgServiceTransportOrder (cUID : ULONG; lpUIDList : PMAPIUID; 
        ulFlags : ULONG) : HResult; stdcall;
      function AdminProviders (lpUID : PMAPIUID; ulFlags : ULONG;
        out lppProviderAdmin : IProviderAdmin) : HResult; stdcall;
      function SetPrimaryIdentity (lpUID : PMAPIUID; ulFlags : ULONG) : HResult; stdcall;
      function GetProviderTable (ulFlags : ULONG; out lppTable : IMAPITable) : HResult; stdcall;
    end;

{ MAPI base functions }

var
  MAPIInitialize: function(lpMapiInit: Pointer): HResult; stdcall;
  MAPIUninitialize: procedure; stdcall;
  MAPILogonEx: function(ulUIParam: ULONG; lpszProfileName: PChar;
    lpszPassword: PChar; ulFlags: ULONG; out lppSession: IMAPISession): HResult; stdcall;
  MAPIAllocateBuffer: function(cbSize: ULONG; var lppBuffer: Pointer): SCODE; stdcall;
  MAPIAllocateMore: function(cbSize: ULONG; lpObject: Pointer; var lppBuffer : Pointer): SCODE; stdcall;
  MAPIFreeBuffer: function(lpBuffer: Pointer): ULONG; stdcall;
  MAPIAdminProfiles: function(ulFlags: ULONG; out lppProfAdmin: IProfAdmin): HResult; stdcall;

implementation

var
  Mapi32Dll: string = 'mapi32.dll';
  Mapi32DllHandle: THandle = 0;

procedure UnloadMAPI;
begin
  if (Mapi32DllHandle <> 0) then
  begin
    FreeLibrary(Mapi32DllHandle);
    Mapi32DllHandle := 0;
  end;
end;

function LoadMAPI: boolean;

  procedure GetEntryPoint(var EntryPoint: pointer; const Name: string);
  begin
    EntryPoint := GetProcAddress(Mapi32DllHandle, PChar(Name));
    if (EntryPoint = nil) then
      Result := False;
  end;

const
  MAPIRegKey = 'SOFTWARE\Clients\Mail\Microsoft Outlook';
  MAPIRegValue = 'DLLPathEx';
var
  Key: HKey;
  Size: DWORD;
  ValueType: DWORD;
  Value: string;
begin
  // Get path/name of Outlook's Extended MAPI DLL from registry.
  // If the DLL can't be found, we fall back to the default mapi32.dll.
  // Search MSDN for "DllPathEx" for an explanation.
  if (RegOpenKeyEx(HKEY_LOCAL_MACHINE, MAPIRegKey, 0, KEY_QUERY_VALUE, Key) = ERROR_SUCCESS) then
    try
      Size := 0;
      // Get size of string value.
      if (RegQueryValueEx(Key, MAPIRegValue, nil, nil, nil, @Size) = ERROR_SUCCESS) and (Size > 0) then
      begin
        SetLength(Value, Size-1); // -1 since space for terminating zero is implicitly allocated
        ValueType := 0;
        // // Get string value.
        if (RegQueryValueEx(Key, MAPIRegValue, nil, @ValueType, Windows.PByte(PChar(Value)), @Size) = ERROR_SUCCESS) and
          (ValueType = REG_SZ) and (Size > 0) and (Value[1] <> #0) then
          Mapi32Dll := Value;
      end;
    finally
      RegCloseKey(Key);
    end;

  Mapi32DllHandle := LoadLibrary(PChar(Mapi32Dll));
  if (Mapi32DllHandle <> 0) then
  begin
    Result := True;
    GetEntryPoint(@MAPIInitialize, 'MAPIInitialize');
    GetEntryPoint(@MAPIUninitialize, 'MAPIUninitialize');
    GetEntryPoint(@MAPILogonEx, 'MAPILogonEx');
    GetEntryPoint(@MAPIAllocateBuffer, 'MAPIAllocateBuffer');
    GetEntryPoint(@MAPIAllocateMore, 'MAPIAllocateMore');
    GetEntryPoint(@MAPIFreeBuffer, 'MAPIFreeBuffer');
    GetEntryPoint(@MAPIAdminProfiles, 'MAPIAdminProfiles');
    if (not Result) then
      UnloadMAPI;
  end else
    Result := False;
end;

initialization
  LoadMAPI;
finalization
  UnloadMAPI;
end.