simailmapi.dpr

siMail, siMail, siMail, siMail

(*
# (C) Copyright 2004
# Miha Vrhovnik, [e-mail]
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as
# published by the Free Software Foundation; either version 2 of
# the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.	See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA
#
# The Initial Developer of the Original Code is Miha Vrhovnik (Slovenia).
# Portions created by Miha Vrhovnik are Copyright (c)2004.
# All Rights Reserved.
#==============================================================================
# Contributor(s):
#==============================================================================
# History: see whats new.txt from distribution package
#==============================================================================
*)
library siMailMapi;
uses
  SysUtils, Windows, Mapi, SynaCode, Registry, ShellApi, Messages, Classes;

{$R *.res}

type PMapiMessage = ^MapiMessage;

var msgHandle: THandle;
var letsRock: Boolean;

procedure MessageHandler(var Msg: TMessage);
begin
  if Msg.Msg = WM_USER + 1 then begin
    Msg.Result := 0;
    letsRock := True;
  end;
end;

function GetsiMailHWND(): Integer;
var reg: TRegistry;
var name: String;
var mainWindowHWND: PInteger;
var mapHandle: THandle;
begin
  Result := 0;
  msgHandle := 0;
  letsRock := False;
  reg := TRegistry.Create;
  reg.RootKey := HKEY_LOCAL_MACHINE;
  reg.Access := KEY_READ;
  reg.OpenKey('SOFTWARE\Clients\Mail\si.Mail', False);
  name := reg.ReadString('ExeName');

  name := StringReplace(name, ':', '', [rfReplaceAll]);
  name := StringReplace(name, '\', '', [rfReplaceAll]);
  name := StringReplace(name, '"', '', [rfReplaceAll]);

  mapHandle := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, sizeOf(Integer), PChar(name));
  if (GetLastError <> ERROR_ALREADY_EXISTS) and (mapHandle <> 0) then begin
    CloseHandle(mapHandle);
    msgHandle := AllocateHWnd(MessageHandler);
    ShellExecute(0, 'open', PChar(reg.ReadString('ExeName') + '/handle ' + IntToStr(msgHandle)), nil, nil, SW_SHOWNORMAL);
    //let's sleep until app isn't started
    while not letsRock do
      Sleep(100);
    DeallocateHWnd(msgHandle);

    mapHandle := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, sizeOf(Integer), PChar(name));
  end;

  mainWindowHWND := MapViewOfFile(mapHandle, FILE_MAP_ALL_ACCESS, 0, 0, SizeOf(mainWindowHWND));

  Result := mainWindowHWND^;

  UnMapViewOfFile(mainWindowHWND);
  CloseHandle(mapHandle);
  reg.CloseKey;
  FreeAndNil(reg);

end;

function SendMail(data: String): Boolean;
var name:String;
var cs: PCopyDataStruct;
var i: Integer;
var mainWindowHWND: Integer;
begin
  Result := False;
  mainWindowHWND := GetsiMailHWND;
  if mainWindowHWND = 0 then Exit;

  //send commandline
  GetMem(cs, sizeOf(TCopyDataStruct));
  name := '/MAILURL' + #13#10 + data;

  with cs^ do begin
    dwData := 0;
    cbData := Length(name);
    lpData := PChar(name);
  end;

  SendMessage(mainWindowHWND, WM_COPYDATA, 0, Integer(cs));
  FreeMem(cs);
  Result := True;;
end;

function MAPILogon(ulUIParam: Cardinal; lpszProfileName: LPSTR;
  lpszPassword: LPSTR; flFlags: FLAGS; ulReserved: Cardinal;
  lplhSession: PLHANDLE): Cardinal stdcall;
var a: Cardinal;
begin
  a := 1;
  lplhSession := @a;
  Result := SUCCESS_SUCCESS;
end;

function MAPILogoff(lhSession: LHANDLE; ulUIParam: Cardinal; flFlags: FLAGS;
  ulReserved: Cardinal): Cardinal stdcall;
begin
  Result := SUCCESS_SUCCESS;
end;

function MAPISendMail(lhSession: LHANDLE; ulUIParam: Cardinal;
  lpMessage: PMapiMessage; flFlags: FLAGS;
  ulReserved: Cardinal): Cardinal stdcall;
var final: String;
var strTo, strCC, strBCC, strAttach: String;
var tmpStr: String;
var i: Integer;
begin
  if lpMessage^.nRecipCount <> 0 then begin
    for i := 0 to lpMessage^.nRecipCount - 1 do begin
      case lpMessage^.lpRecips^.ulRecipClass of
      MAPI_TO: begin
        if strTo <> '' then
          strTo := strTo + ',';
        tmpStr := String(lpMessage^.lpRecips^.lpszName);
        if tmpStr <> '' then
          strTo := strTo + '"' + tmpStr+ '" <' + String(lpMessage^.lpRecips^.lpszAddress) + '>'
        else
          strTo := strTo + String(lpMessage^.lpRecips^.lpszAddress);
      end;
      MAPI_CC: begin
        if strCC <> '' then
          strCC := strCC + ',';
        tmpStr := String(lpMessage^.lpRecips^.lpszName);
        if tmpStr <> '' then
          strCC := strCC + '"' + tmpStr+ '" <' + String(lpMessage^.lpRecips^.lpszAddress) + '>'
        else
          strCC := strCC + String(lpMessage^.lpRecips^.lpszAddress);
      end;
      MAPI_BCC: begin
        if strBCC <> '' then
          strBCC := strBCC + ',';
        tmpStr := String(lpMessage^.lpRecips^.lpszName);
        if tmpStr <> '' then
          strBCC := strBCC + '"' + tmpStr+ '" <' + String(lpMessage^.lpRecips^.lpszAddress) + '>'
        else
          strBCC := strBCC + String(lpMessage^.lpRecips^.lpszAddress);
      end;
      end;
      Inc(lpMessage^.lpRecips);
    end;
  end;

  if lpMessage^.nFileCount <> 0 then begin
    for i := 0 to lpMessage^.nFileCount - 1 do begin
      if strAttach <> '' then
        strAttach := strAttach + ',';
      if lpMessage^.lpFiles^.lpszFileName = nil then
        strAttach := strAttach + String(lpMessage^.lpFiles^.lpszPathName)
      else
        strAttach := strAttach + String(lpMessage^.lpFiles^.lpszFileName);
      Inc(lpMessage^.lpFiles);
    end;
  end;

  final := 'mailto:' + EncodeUrl(strTo) + '?' + '&subject=' +
    EncodeUrl(String(lpMessage^.lpszSubject)) + '&cc=' +
    EncodeUrl(strCC) + '&bcc=' + EncodeUrl(strBCC) + '&body=' +
    EncodeUrl(String(lpMessage^.lpszNoteText)) + '&attach=' +
    EncodeUrl(strAttach);

  if SendMail(final) then
    Result := SUCCESS_SUCCESS
  else
    Result := MAPI_E_FAILURE;
end;

function MAPISendDocuments(ulUIParam: Cardinal; lpszDelimChar: LPSTR;
  lpszFilePaths: LPSTR; lpszFileNames: LPSTR;
  ulReserved: Cardinal): Cardinal stdcall;
var final: String;
var strAttach: String;
var i: Integer;
begin
  strAttach := StringReplace(String(lpszFilePaths), String(lpszDelimChar), ',', [rfReplaceAll]);

  final := 'mailto:' + '?' + '&attach=' + EncodeUrl(strAttach);

  if SendMail(final) then
    Result := SUCCESS_SUCCESS
  else
    Result := MAPI_E_FAILURE;
end;

function MAPIFindNext(lhSession: LHANDLE; ulUIParam: Cardinal;
  lpszMessageType: LPSTR; lpszSeedMessageID: LPSTR; flFlags: FLAGS;
  ulReserved: Cardinal; lpszMessageID: LPSTR): Cardinal stdcall;
begin
  Result := MAPI_E_FAILURE;
end;

function MAPIReadMail(lhSession: LHANDLE; ulUIParam: Cardinal;
  lpszMessageID: LPSTR; flFlags: FLAGS; ulReserved: Cardinal;
  var lppMessage: PMapiMessage): Cardinal stdcall;
begin
  Result := MAPI_E_FAILURE;
end;

function MAPISaveMail(lhSession: LHANDLE; ulUIParam: Cardinal;
  var lpMessage: TMapiMessage; flFlags: FLAGS; ulReserved: Cardinal;
  lpszMessageID: LPSTR): Cardinal stdcall;
begin
  Result := MAPI_E_FAILURE;
end;

function MAPIDeleteMail(lhSession: LHANDLE; ulUIParam: Cardinal;
  lpszMessageID: LPSTR; flFlags: FLAGS;
  ulReserved: Cardinal): Cardinal stdcall;
begin
  Result := MAPI_E_FAILURE;
end;

function MAPIFreeBuffer(pv: Pointer): Cardinal stdcall;
begin
  Result := MAPI_E_FAILURE;
end;

function MAPIAddress(lhSession: LHANDLE; ulUIParam: Cardinal;
  lpszCaption: LPSTR; nEditFields: Cardinal; lpszLabels: LPSTR;
  nRecips: Cardinal; var lpRecips: TMapiRecipDesc; flFlags: FLAGS;
  ulReserved: Cardinal; lpnNewRecips: PULONG;
  var lppNewRecips: PMapiRecipDesc): Cardinal stdcall;
begin
  Result := MAPI_E_FAILURE;
end;

function MAPIDetails(lhSession: LHANDLE; ulUIParam: Cardinal;
  var lpRecip: TMapiRecipDesc; flFlags: FLAGS;
  ulReserved: Cardinal): Cardinal stdcall;
begin
  Result := MAPI_E_FAILURE;
end;

function MAPIResolveName(lhSession: LHANDLE; ulUIParam: Cardinal;
  lpszName: LPSTR; flFlags: FLAGS; ulReserved: Cardinal;
  var lppRecip: PMapiRecipDesc): Cardinal stdcall;
begin
  Result := MAPI_E_FAILURE;
end;

exports
  MAPIAddress,
  MAPIDeleteMail,
  MAPIDetails,
  MAPIFindNext,
  MAPIFreeBuffer,
  MAPILogoff,
  MAPILogon,
  MAPIReadMail,
  MAPIResolveName,
  MAPISaveMail,
  MAPISendDocuments,
  MAPISendMail;
begin

end.