Rabu, 23 Januari 2013

Listing code Mengirim Email dengan Delphi

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.

Menghapus File ke Recycle Bin

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

uses ShellApi;

procedure TForm1.Button1Click(Sender: TObject);
var
FileOpStruc: TSHFileOpStruct;
s: PChar;
begin
s := 'C:\coba.txt';
with FileOpStruc do
begin
Wnd := 0;
wFunc := FO_DELETE;
pFrom := s;
fFlags := FOF_ALLOWUNDO
end;
SHFileOperation(FileOpStruc);
end;

end.