unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
type
  TForm1 = class(TForm)
    Button1: TButton;
    edtSubject: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    edtNamaPengirim: TEdit;
    edtEmailPengirim: TEdit;
    Label4: TLabel;
    edtNamaPenerima: TEdit;
    edtEmailPenerima: TEdit;
    Label5: TLabel;
    MemoMessage: TMemo;
    Label6: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  Form1: TForm1;
implementation
uses MAPI;
{$R *.dfm}
function SendMail(const Subject, Body, FileName,
                  SenderName, SenderEMail,
                  RecipientName, RecipientEMail: string): Integer;
var
  Message: TMapiMessage;
  lpSender, lpRecipient: TMapiRecipDesc;
  FileAttach: TMapiFileDesc;
  SM: TFNMapiSendMail;
  MAPIModule: HModule;
begin
  FillChar(Message, SizeOf(Message), 0);
  with Message do
  begin
    if (Subject <> '') then
      lpszSubject := PChar(Subject);
    if (Body <> '') then
      lpszNoteText := PChar(Body);
    if (SenderEmail <> '') then
    begin
      lpSender.ulRecipClass := MAPI_ORIG;
      if (SenderName = '') then
        lpSender.lpszName := PChar(SenderEMail)
      else
        lpSender.lpszName := PChar(SenderName);
      lpSender.lpszAddress := PChar(SenderEmail);
      lpSender.ulReserved := 0;
      lpSender.ulEIDSize := 0;
      lpSender.lpEntryID := nil;
      lpOriginator := @lpSender;
    end;
    if (RecipientEmail <> '') then
    begin
      lpRecipient.ulRecipClass := MAPI_TO;
      if (RecipientName = '') then
        lpRecipient.lpszName := PChar(RecipientEMail)
      else
        lpRecipient.lpszName := PChar(RecipientName);
      lpRecipient.lpszAddress := PChar(RecipientEmail);
      lpRecipient.ulReserved := 0;
      lpRecipient.ulEIDSize := 0;
      lpRecipient.lpEntryID := nil;
      nRecipCount := 1;
      lpRecips := @lpRecipient;
    end
    else lpRecips := nil;
    if (FileName = '') then
    begin
      nFileCount := 0;
      lpFiles := nil;
    end
    else
    begin
      FillChar(FileAttach, SizeOf(FileAttach), 0);
      FileAttach.nPosition := Cardinal($FFFFFFFF);
      FileAttach.lpszPathName := PChar(FileName);
      nFileCount := 1;
      lpFiles := @FileAttach;
    end;
  end;
  MAPIModule := LoadLibrary(PChar(MAPIDLL));
  if MAPIModule = 0 then
    Result := -1
  else
    try
      @SM := GetProcAddress(MAPIModule, 'MAPISendMail');
      if @SM <> nil then
      begin
        Result := SM(0, Application.Handle, Message, MAPI_DIALOG or MAPI_LOGON_UI, 0);
      end
      else
        Result := 1;
    finally
      FreeLibrary(MAPIModule);
    end;
  if Result <> 0 then
    MessageDlg('Gagal mengirim email (' + IntToStr(Result) + ').', mtError, [mbOK], 0);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
  SendMail(edtSubject.Text,
           MemoMessage.Text,
           '',
           edtNamaPengirim.Text, edtEmailPengirim.Text,
           edtNamaPenerima.Text, edtEmailPenerima.Text);
end;
end.
Subscribe to:
Post Comments (Atom)

3 comments:
Salam kenal,..
Cuma saran.
Disamping listing source code-nya, file *.DFM nya juga dimuat dunk mas,. ataw source lengkapnya diupload dan dibuatkan link uploadnya dibawah postingan ini. Kan jadi lebih mudah untuk dapat mempelajarinya :D..
Oiya,. saya mau tukar link boleh ga?!
Blog saya : http://delphifirebird.blogspot.com
Salam,
Reshi Mahendra
mas ko error yaa?
ada incompatible char ama ansichar?
nice blog..
ane share, klik sini gan kalo mau coba aplikasi tutorialnya http://www.mediafire.com/?lsd53k08cv38r0v
Post a Comment