smapi.pas

收发MAPI E-Mail(非SMTP E-mail), 传真的构件

                   ulReserved  : ULONG;
                   lplhSession : LPLHANDLE) : ULONG
{$IFNDEF WIN32} ; {$ELSE} stdcall; {$ENDIF WIN32}

TFnMapiSendMail = function(lhSession  : LHANDLE;
                      ulUIParam  : ULONG;
                      lpMessage  : lpMapiMessage;
                      flFlags    : ULONG;
                      ulReserved : ULONG) : ULONG
{$IFNDEF WIN32} ; {$ELSE} stdcall; {$ENDIF WIN32}

TFnMapiReadMail = function(lhSession     : LHANDLE;
                      ulUIParam     : ULONG;
                      lpszMessageID : PChar;
                      flFlags       : ULONG;
                      ulReserved    : ULONG;
                      lpMessage     : lpMapiMessage) : ULONG
{$IFNDEF WIN32} ; {$ELSE} stdcall; {$ENDIF WIN32}

TFnMapiDeleteMail = function(lhSession     : LHANDLE;
                        ulUIParam     : ULONG;
                        lpszMessageID : PChar;
                        flFlags       : ULONG;
                        ulReserved    : ULONG) : ULONG
{$IFNDEF WIN32} ; {$ELSE} stdcall; {$ENDIF WIN32}


TFnMapiResolveName = function(lhSession : LHANDLE;
                         ulUIParam : ULONG;
                         lpszName  : PChar;
                         flFlags   : ULONG;
                         ulReserved: ULONG;
                         lppRecips : lppMapiRecipDesc) : ULONG
{$IFNDEF WIN32} ; {$ELSE} stdcall; {$ENDIF WIN32}

TFnMapiFreeBuffer = function(pv : LPVOID) : ULONG
{$IFNDEF WIN32} ;{$ELSE} stdcall; {$ENDIF WIN32}

TFnMapiAddress = function(lhSession   : LHANDLE;
                      ulUIParam       : ULONG;
                      lpszCaption     : PChar;
                      nEditFields     : ULONG;
                      lpszLabels      : PChar;
                      nRecips         : ULONG;
                      var lpRecips    : TMapiRecipDesc;
                      flFlags         : ULONG;
                      ulReserved      : ULONG;
                      lpnNewRecips    : lpULONG;
                      var lppNewRecips: lpMapiRecipDesc): ULONG
{$IFNDEF WIN32} ;{$ELSE} stdcall; {$ENDIF WIN32}

TFnMapiSaveMail = function(lhSession     : LHANDLE;
                           ulUIParam     : ULONG;
                           lpMessage     : lpMapiMessage;
                           flFlags       : ULONG;
                           ulReserved    : ULONG;
                           lpszMessageID : PChar) : ULONG
{$IFNDEF WIN32} ; {$ELSE} stdcall; {$ENDIF WIN32}

{ declare the functions themselves }
var
  FnMapiFindNext:    TFnMapiFindNext;
  FnMapiLogoff:      TFnMapiLogoff;
  FnMapiLogon:       TFnMapiLogon;
  FnMapiSendMail:    TFnMapiSendMail;
  FnMapiReadMail:    TFnMapiReadMail;
  FnMapiDeleteMail:  TFnMapiDeleteMail;
  FnMapiResolveName: TFnMapiResolveName;
  FnMapiFreeBuffer:  TFnMapiFreeBuffer;
  FnMapiAddress:     TFnMapiAddress;
  FnMapiSaveMail:    TFnMapiSaveMail;


function MapiFindNext(lhSession        : LHANDLE;
                      ulUIParam        : ULONG;
                      lpszMessageType  : PChar;
                      lpszSeedMessageID: PChar;
                      flFlags          : ULONG;
                      ulReserved       : ULONG;
                      lpszMessageID    : PChar) :  ULONG;
begin
  Result := FnMapiFindNext( lhSession, ulUIParam, lpszMessageType, lpszSeedMessageID, 
                            flFlags, ulReserved, lpszMessageID);
end;

function MapiLogoff(lhSession  : LHANDLE;
                    ulUIParam  : ULONG;
                    flFlags    : ULONG;
                    ulReserved : ULONG) : ULONG;
begin
  Result := FnMapiLogoff( lhSession, ulUIParam, flFlags, ulReserved);
end;

function MapiLogon(ulUIParam   : ULONG;
                   lpszName    : PChar;
                   lpszPassword: PChar;
                   flFlags     : ULONG;
                   ulReserved  : ULONG;
                   lplhSession : LPLHANDLE) : ULONG;
begin
  Result := FnMapiLogon( ulUIParam, lpszName, lpszPassword, flFlags, ulReserved,
                         lplhSession);
end;

function MapiSendMail(lhSession  : LHANDLE;
                      ulUIParam  : ULONG;
                      lpMessage  : lpMapiMessage;
                      flFlags    : ULONG;
                      ulReserved : ULONG) : ULONG;
begin
  Result := FnMapiSendMail( lhSession, ulUIParam, lpMessage, flFlags,
                            ulReserved);
end;

function MapiReadMail(lhSession     : LHANDLE;
                      ulUIParam     : ULONG;
                      lpszMessageID : PChar;
                      flFlags       : ULONG;
                      ulReserved    : ULONG;
                      lpMessage     : lpMapiMessage) : ULONG;
begin
  Result := FnMapiReadMail( lhSession, ulUIParam, lpszMessageID, flFlags, 
                            ulReserved, lpMessage);
end;

function MapiDeleteMail(lhSession     : LHANDLE;
                        ulUIParam     : ULONG;
                        lpszMessageID : PChar;
                        flFlags       : ULONG;
                        ulReserved    : ULONG) : ULONG;
begin
  Result := FnMapiDeleteMail( lhSession, ulUIParam, lpszMessageID, flFlags,
                              ulReserved);
end;


function MapiResolveName(lhSession : LHANDLE;
                         ulUIParam : ULONG;
                         lpszName  : Pchar;
                         flFlags   : ULONG;
                         ulReserved: ULONG;
                         lppRecips : lppMapiRecipDesc) : ULONG;
begin
  Result := FnMapiResolveName( lhSession, ulUIParam, lpszName, flFlags, 
                               ulReserved, lppRecips);
end;


function MapiFreeBuffer(pv : LPVOID) : ULONG;
begin
  Result := FnMapiFreeBuffer(pv);
end;


function MapiAddress(lhSession        : LHANDLE;
                     ulUIParam        : ULONG;
                     lpszCaption      : PChar;
                     nEditFields      : ULONG;
                     lpszLabels       : PChar;
                     nRecips          : ULONG;
                     var lpRecips     : TMapiRecipDesc;
                     flFlags          : ULONG;
                     ulReserved       : ULONG;
                     lpnNewRecips     : lpULONG;
                     var lppNewRecips : lpMapiRecipDesc): ULONG;
begin
  Result := FnMapiAddress( lhSession, ulUIParam, lpszCaption, nEditFields,
                           lpszLabels, nRecips, lpRecips, flFlags,
                           ulReserved, lpnNewRecips, lppNewRecips);
end;


function MapiSaveMail(lhSession     : LHANDLE;
                      ulUIParam     : ULONG;
                      lpMessage     : lpMapiMessage;
                      flFlags       : ULONG;
                      ulReserved    : ULONG;
                      lpszMessageID : PChar) : ULONG;
begin
  Result := FnMapiSaveMail( lhSession, ulUIParam, lpMessage, flFlags,
                            ulReserved, lpszMessageID);
end;


function MapiAvailable: boolean;
begin
  MapiAvailable := DllInitialized;
end;


{ define various combinations of MAPI dlls
  if they are not used the linker will not include them }
const
  DLLName32DLL = 'mapi32.dll';
  DLLName32 = 'mapi32';

  DLLName16DLL = 'mapi.dll';
  DLLName16 = 'mapi'; { we will NOT use this }


procedure InitializeSMAPI;
var
  OldErrorMode: Word;

{$IFDEF WIN32}
  OSVersionInfo: TOSVersionInfo;
  RegHandle: HKEY;

  MapiDetectBuf: array[0..8] of Char;
  MapiDetectBufSize: Windows.DWORD;

  RegValueType: Windows.DWORD;
{$ENDIF WIN32}
begin
  { first check wether MAPI is available on the system; this is done
    as described in the MS MAPI docs }

{$IFDEF WIN32}
  OSVersionInfo.dwOSVersionInfoSize := SizeOf(OSVersionInfo);
  GetVersionEx(OSVersionInfo);
  if (OSVersionInfo.dwMajorVersion > 3) or { NT 4.0 and later }
     { earlier than NT 3.51 }
     ((OSVersionInfo.dwMajorVersion = 3) and (OSVersionInfo.dwMinorVersion > 51)) then
  begin
    if RegOpenKeyEx( HKEY_LOCAL_MACHINE,
                     'SOFTWARE\Microsoft\Windows Messaging Subsystem',
                     0, KEY_READ, RegHandle) <> ERROR_SUCCESS then
    begin
      exit;
    end;

    MAPIDetectBufSize := SizeOf(MAPIDetectBuf);
    if RegQueryValueEx( RegHandle, 'MAPI', nil, @RegValueType,
                        PByte(@MAPIDetectBuf), @MAPIDetectBufSize) <> ERROR_SUCCESS then
    begin
      exit;
    end;

    RegCloseKey(RegHandle);

    { "boolean" integer --> is == "1"? }
    if not ((MAPIDetectBuf[0] = '1') and (MAPIDetectBuf[1] = #0)) then
      exit;
  end
  else
{$ENDIF WIN32}
    if GetProfileInt('Mail', 'MAPI', 0) = 0 then { 16 bit and NT 3.51 detection logic }
      Exit;

{$IFDEF WIN32}
  OldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS + SEM_NOOPENFILEERRORBOX);
    DLLHandle := LoadLibrary(DLLName32); { start without .DLL attached }
  { OldErrorMode := } SetErrorMode(OldErrorMode);

  if DLLHandle = 0 then { got an error }
  begin
    OldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS + SEM_NOOPENFILEERRORBOX);
    try
      DLLHandle := LoadLibrary(DLLName32DLL);

      if DLLHandle = 0 then
      begin
        exit; { second attempt did not work out either }
      end;

    finally
      { OldErrorMode := } SetErrorMode(OldErrorMode);
    end;
  end;
{$ELSE}
  OldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS + SEM_NOOPENFILEERRORBOX);
  DLLHandle := LoadLibrary(DLLName16DLL);
  { OldErrorMode := } SetErrorMode(OldErrorMode);

  if DLLHandle <= HINSTANCE_ERROR then
  begin
    FreeLibrary(DLLHandle);
  end
  else
{$ENDIF WIN32}
  begin
    DllInitialized := true;

    @FnMapiFindNext :=    GetProcAddress(DLLHandle, 'MAPIFindNext');
    @FnMapiLogoff :=      GetProcAddress(DLLHandle, 'MAPILogoff');
    @FnMapiLogon :=       GetProcAddress(DLLHandle, 'MAPILogon');
    @FnMapiSendMail :=    GetProcAddress(DLLHandle, 'MAPISendMail');
    @FnMapiReadMail :=    GetProcAddress(DLLHandle, 'MAPIReadMail');
    @FnMapiDeleteMail :=  GetProcAddress(DLLHandle, 'MAPIDeleteMail');
    @FnMapiResolveName := GetProcAddress(DLLHandle, 'MAPIResolveName');
    @FnMapiFreeBuffer :=  GetProcAddress(DLLHandle, 'MAPIFreeBuffer');
    @FnMapiAddress :=     GetProcAddress(DLLHandle, 'MAPIAddress');
    @FnMapiSaveMail :=    GetProcAddress(DLLHandle, 'MAPISaveMail');

    if    (@FnMapiAddress     = nil)
       or (@FnMapiFreeBuffer  = nil)
       or (@FnMapiResolveName = nil)
       or (@FnMapiDeleteMail  = nil)
       or (@FnMapiReadMail    = nil)
       or (@FnMapiSendMail    = nil)
       or (@FnMapiLogon       = nil)
       or (@FnMapiLogoff      = nil)
       or (@FnMapiFindNext    = nil)
       or (@FnMapiSaveMail    = nil) then
    begin
      raise EMAPIdllerror.Create(SMapiGetProcAdressFailed);
    end;
  end;
end;

{ this should not be necessary... }
procedure ClearProcedureAdresses;
begin
  @FnMapiFindNext :=    nil;
  @FnMapiLogoff :=      nil;
  @FnMapiLogon :=       nil;
  @FnMapiSendMail :=    nil;
  @FnMapiReadMail :=    nil;
  @FnMapiDeleteMail :=  nil;
  @FnMapiResolveName := nil;
  @FnMapiFreeBuffer :=  nil;
  @FnMapiAddress :=     nil;
  @FnMapiSaveMail :=    nil;
end;


procedure FinalizeSMAPI; far; { explicitly make it far }
begin
  if DllInitialized then
    FreeLibrary(DLLHandle);

  ClearProcedureAdresses;
end;


initialization
  ClearProcedureAdresses; { just for safety }

  DllInitialized := false;
  DllHandle := 0;

{$IFNDEF WIN32}
  AddExitProc(FinalizeSMAPI);
{$ENDIF WIN32}

  InitializeSMAPI;

{$IFDEF WIN32}
finalization
  FinalizeSMAPI;
{$ENDIF WIN32}
end.