cara membuat anti virus dengan delphi 7

Antivirus merupakan sebuah aplikasi yang mana berguna untuk memblokir, mengkarantina, atau menghapus program jahat berupa virus ataupun worm. Prinsip kerja dari antivirus ada mendeteksi dengan cara membaca isi tubuh dari program (scan) dan mendaftarkan isinya disesuaikan dengan database yang telah di daftarkan, sehingga jika ada program atau aplikasi yang telah sesuai dengan database yang ada di antivirus itu maka program tersebut bisa dikatakan virus atau worm, jika tidak maka ia bukan virus atau worm .


Pertama-tama Anda buat New Project dahulu di Delphi 7 Anda, kemudian ganti nama (rename) Form1, menjadi FormUtama dan save dengan nama form_utama.pas.

001

interface

002

003

uses

004	Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

005	Dialogs, StdCtrls,Utility_AV, ComCtrls, Menus;

006

007

type

008	TFormUtama = class(TForm)

009	GroupBox1: TGroupBox;

010	rb_scan1: TRadioButton;

011	rb_scan2: TRadioButton;

012	edt_folder: TEdit;

013	edt_cari: TButton;

014	GroupBox2: TGroupBox;

015	lbl_jumlahfile: TLabel;

016	lbl_virus: TLabel;

017	mm_status: TMemo;

018	btn_scan: TButton;

019	btn_tentang: TButton;

020	btn_keluar: TButton;

021	ck_scansubdir: TCheckBox;

022	GroupBox3: TGroupBox;

023	lv_virlist: TListView;

024	btn_delvir: TButton;

025	btn_cls: TButton;

026	lbl_waktu: TLabel;

027	Label1: TLabel;

028

029	procedure btn_tentangClick(Sender: TObject);

030	procedure FormCreate(Sender: TObject);

031	procedure btn_keluarClick(Sender: TObject);

032	procedure btn_scanClick(Sender: TObject);

033	procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);

034	procedure edt_cariClick(Sender: TObject);

035	procedure rb_scan2Click(Sender: TObject);

036	procedure btn_clsClick(Sender: TObject);

037	procedure btn_delvirClick(Sender: TObject);

038

private

039	{ Private declarations }

040	Procedure ScanVirus(Semua:Boolean);

041	Procedure SaatScanFile (Path:String);

042	Procedure TambahList (NamaVirus,Path:String);

043

public

044	{ Public declarations }

045

end;

046

047

048

049

var

050	FormUtama: TFormUtama;

051	SedangDiScan:Boolean;

052	rStartTime : Integer;

053	C          : Integer;

054

055

Const

056	DBaseCRC32Virus : Array [0..2] of String = ('DD7A0BA8','7A014FFF','BDB819EB');

057	DBaseNamaVirus  : Array [0..2] of String = ('CodeRed','Moondlight.D','FluBurung');

058	MAX_SCAN        : Int64  = 10 * 1024 * 1024; // Maksimal Scan 10 MB,

059	//  Karena biasanya virus tidak lebih dari 10 MB

060	implementation

061

062	{$R *.dfm}

063	{$R WindowsXP.res} //Aktifkan Theme WinXP

064

065

066

067	function CekUkuranFile(const FileName: string): Int64;

068

var

069	SearchRec: TSearchRec;

070

begin

071	Result := -1; //-- assume worst cas

072	if FindFirst(FileName, faAnyFile, SearchRec) = 0 then

073

begin

074	Int64Rec(Result).Lo := SearchRec.FindData.nFileSizeLow;

075	Int64Rec(Result).Hi := SearchRec.FindData.nFileSizeHigh;

076	FindClose(SearchRec);

077

end;

078

end;

079

080	Procedure TFormUtama.TambahList (NamaVirus,Path:String);

081

Var

082	lvi       : TListItem;

083

Begin

084

085	//Cek Apakah ada list yang sama ... ?

086	lvi := lv_virList.FindCaption(0,Path, false, true, false);

087	while Assigned(lvi) do

088

begin

089	if Lowercase(lvi.SubItems[1]) = Lowercase(Path) then exit; //Sudah ada di list, keluar

090	lvi := lv_virList.FindCaption(lvi.Index, Path, false, false, false);

091

end;

092

093	//List tidak ada yang sama, tambahkan list...

094	lvi := lv_virList.Items.Add;

095	lvi.Caption := NamaVirus;

096	lvi.SubItems.Add(Path);

097	lbl_virus.Caption := 'Jumlah virus ditemukan : ' + IntToStr(Lv_VirList.Items.Count);

098

End;

099

100

101

102	Procedure TFormUtama.SaatScanFile (Path:String);

103

Var

104	CRC32       : Cardinal;

105	TB          : Int64;

106	Err         : Word;

107	CRC32Str    : String; //CRC32 hasil string

108	i           : Integer;

109	ElapsedTime : String;

110

Begin

111

112	ElapsedTime := Format('%.1f', [0.001*(GetTickCount-rStartTime)]);

113

114	Application.ProcessMessages; // Terima semua masukan dari program

115	IF (CekUkuranFile(Path) <= MAX_SCAN) Then Begin // Maksimal Scan.. Tidak Lebih dari 10 MB

116	HitungFileCRC32 ( Path, CRC32, TB, Err );

117	CRC32Str := IntToHex(Crc32,8);  // Hasil CRC32 desimal di konverisi menjadi Heksadesimal

118	For i:=Low(DBaseCRC32Virus) to High(DBaseCRC32Virus) do

119	// Jika Hasil CRC32 sama dengan Database Virus, Tidak diragukan lagi maka itu virus

120	if (CRC32Str = DBaseCRC32Virus[i]) then TambahList(DBaseNamaVirus[i],Path);

121

End;

122

123

Inc(C);

124	lbl_jumlahfile.Caption := 'Jumlah file : ' + IntToStr(C);

125	lbl_waktu.Caption      := 'Waktu tempuh : ' + ElapsedTime;

126	mm_status.Lines.Text := Path; // Status scannya;

127

End;

128

129	procedure TFormUtama.btn_tentangClick(Sender: TObject);

130

begin

131	MsgBox(Handle,'Tentang Program',

132	'Gue Antivirus (GAV) ' + #13#10 +

133	'Diprogramkan oleh Ali' + #13#10#13#10 +

134	'Web-Site : http://www.geocities.com/alisoftprg' + #13#10 +

135	'E-Mail : ali.programmer@telkom.net' + #13#10#13#10 +

136	'Copyright © Ali Software - Delphi Source Code. All Rights Reserved.',

137	Information);

138

end;

139

140	procedure TFormUtama.FormCreate(Sender: TObject);

141

begin

142	SedangDiScan := False;

143

end;

144

145	procedure TFormUtama.btn_keluarClick(Sender: TObject);

146

begin

147

148	If SedangDiScan Then

149	If MsgBox(Handle,'Keluar Program',

150	'Apakah Anda ingin keluar saat program sedang mencari virus ?',

151	Question + YesNo) = No Then Exit;

152

153	Halt(0);     // Keluar Program (dengan paksaan, jika terjadi error)

154

end;

155

156	Procedure TFormUtama.ScanVirus(Semua:Boolean);

157

Var

158	CallBack :TOnCariFile;

159	Drives:Array of String;

160	i,L:Integer;

161

Begin

162

163	CallBack := SaatScanFile;    //  Hasil scan di kembalikan ke procedure lain

164

165	If Not Semua Then

166

Begin

167	If (edt_folder.Text = '') then Begin

168	Msgbox(Handle,'Error','Tentukan dulu Folder atau Drive-nya',Critical);

169

exit;

170

End;

171	CariFile(edt_folder.Text,ck_scansubdir.Checked,'*.*',CallBack);

172

End

173	Else Begin

174	For i:=Ord('A') to Ord('Z') do

175	Case GetDriveType(Pchar(Chr(i) + ':\')) of

176	DRIVE_UNKNOWN:;

177	DRIVE_NO_ROOT_DIR:;

178

Else

179

Begin

180	L:=Length(Drives)+1;

181	SetLength(Drives,L);

182	Drives[L-1]:=Chr(i) + ':\';

183

End;

184

End;

185

186	For i:=Low(Drives) to High(Drives) do

187

Begin

188	If DriveSiap(Drives[i]) Then

189	CariFile(Drives[i],ck_scansubdir.Checked,'*.*',CallBack);

190

End;

191

192

End;

193

194

End;

195

196	procedure TFormUtama.btn_scanClick(Sender: TObject);

197	Label Scan,Berhenti;

198

begin

199

200	If Not SedangDiScan Then

201

Goto Scan

202

Else

203	Goto BerHenti;

204

205

Exit;

206

207	Scan: Begin

208	BerhentiMencari := False;     // Agar bisa di scan

209	{Mulai men-scan file...}

210	rStartTime := GetTickCount;

211	C          := 0;

212

try

213	SedangDiScan := True;

214	btn_scan.Caption := '&Berhenti..';

215	ScanVirus ( rb_scan1.Checked )   ; //......

216

Finally

217	btn_scan.Caption := '&Scan';

218	SedangDiScan := False;

219

End;

220

End;

221

222

Exit;

223	Berhenti:Begin

224	If MsgBox(Handle,'Scan Virus',

225	'Apakah Anda ingin menghentikan proses scan virus ?',

226	Question + YesNo) = Yes Then

227	BerhentiMencari := True;

228

End;

229

230

end;

231

232	procedure TFormUtama.FormCloseQuery(Sender: TObject;

233	var CanClose: Boolean);

234

begin

235	btn_keluarClick(Sender);

236

end;

237

238	procedure TFormUtama.edt_cariClick(Sender: TObject);

239	Var Dir:String;

240

begin

241

Try

242	Dir := BrowseDialog(Handle,'Cari Folder / Drive');

243

Finally

244	If (Dir <> '') then

245	edt_folder.Text := Dir;

246

End;

247

end;

248

249

250	procedure TFormUtama.rb_scan2Click(Sender: TObject);

251

begin

252	edt_folder.Enabled := rb_scan2.Checked ;

253	edt_cari.Enabled   := rb_scan2.Checked;

254

end;

255

256	procedure TFormUtama.btn_clsClick(Sender: TObject);

257

begin

258	If (Lv_VirList.Items.Count < 1) then Exit;

259	If MsgBox(Handle,'Bersihkan List',

260	'Apakah Anda ingin membersihkan list (tanpa menghapus virus) ?',

261	Question + YesNo) = Yes Then

262	lv_virlist.Items.Clear;

263

end;

264

265	procedure TFormUtama.btn_delvirClick(Sender: TObject);

266	Var i:Integer;

267	Ada, Bisa:Boolean;

268

begin

269	Ada := False;

270	For i:=0 to Lv_VirList.Items.Count -1 do

271	If Lv_VirList.Items[i].Checked then begin

272	Ada := True;

273

Break;

274

End;

275	If Not Ada Then

276	If Msgbox(Handle,'Perhatian','Pilih salah satu item',Exclamation) = OK Then

277

Exit;

278

279	For i:=0 to Lv_VirList.Items.Count -1 do

280	If Lv_VirList.Items[i].Checked then begin

281	Bisa := DeleteFile(Lv_VirList.Items[i].SubItems[0]);

282	If Not Bisa Then

283	If Msgbox(Handle,'Error','File tidak dapat di hapus,' +

284	'kemungkinan windows sedang menjalankannya',

285	CRITICAL) = OK Then Exit

286	Else Lv_VirList.Items[i].Delete;

287

End;

288

end;

289

290

end.

Download Source Code