Rabu, 23 November 2011

Pembuatan Antivirus Sederhana

Langkah-langkahnya adalah sebagai berikut:
1. Install Microsoft Visual Basic 6.0
2. Pada New Project, klik standard Exe
3. Klik Add form , lalu pada tab new, klik form
4. Pada gambar timer, klik dan isi datanya. Pada bagian interval, ketik 3000
5. Buat 2 buah timer
6. Masukkan label dan ketikkan
7.Buat Form baru dan beri nama "MamaDC Antivirus"
8.Pada form StartUp, masukkan kode berikut


Option Explicit

Dim cnt As Byte
Dim teks As String

Private Sub Form_Load()
teks = "Kelompok kami sedang mematikan proses WScript" + Space(1)
Label1.Caption = teks
cnt = 0
Me.Left = (Screen.Width - Me.Width) / 2
Me.Top = (Screen.Height - Me.Height) / 2
Shell "taskkill /f /im wscript.exe", vbHide
End Sub

Private Sub Timer1_Timer()
Label1.Caption = Label1.Caption + "."
cnt = cnt + 1
If cnt > 3 Then
cnt = 0
Label1.Caption = teks
End If
End Sub

Private Sub Timer2_Timer()
Timer1.Enabled = False
Me.Hide
Main.Show
Timer2.Enabled = False
End Sub


9. Masukkan Frame pada form "MamaDC Antivirus"
10. Tambahkan Listview pada form “MamaDC Antivirus”
12.Tambahkan Textbook, dan ketikkan “Pilih File Yang Dibersihkan”
13.Tambahkan command Button dengan nama “Cari”, “Keluar” dan “Hapus”
14.Ubah Background sesuai keinginan
15. Klik kanan pada Form "MamaDC Antivirus", kodenya adalah sebagai berikut
Option Explicit

Dim FSO As Object
Dim ArrMark(100) As String
Dim cnt As Integer

Private Sub Form_Load()
Dim FSO, ActDrv, FName As Object
Dim Codes, MarkPath, StrTemp, Tmp1, Tmp2 As String
Dim x As Integer
Set FSO = CreateObject("Scripting.FileSystemObject")
For Each ActDrv In FSO.Drives
Combo1.AddItem ActDrv
Next

On Error GoTo Hell
If Right(App.Path, 1) <> "\" Then
MarkPath = App.Path + "\vmark.txt"
Else
MarkPath = App.Path + "vmark.txt"
End If
Set FName = FSO.OpentextFile(MarkPath, 1, False)
Codes = FName.ReadAll
cnt = 0: x = 0
For x = 1 To Len(Codes)
Tmp1 = Mid(Codes, x, 1)
StrTemp = StrTemp + Tmp1
If StrTemp = Chr(13) Then
ArrMark(cnt) = StrTemp
StrTemp = ""
cnt = cnt + 1
End If
Tmp1 = ""
Next x
Exit Sub
Hell:
MsgBox "File" + Space(1) + Chr(39) + MarkPath + Chr(39) + Space(1) + "Tidak Ditemukan!"
End
End Sub

Function Dosearch(Path)
Set FSO = CreateObject("Scripting.FileSystemObject")
Dim Folder, Files, File, SubFolders, SubFolder As Object
Dim FName, Codes, Tmp1, Tmp2 As String
Dim x As Integer
On Error Resume Next
Set Folder = FSO.getfolder(Path)
Set Files = Folder.Files
For Each File In Files
If FSO.GetExtensionName(File.Path) = "vbs" Or FSO.GetExtensionName(File.Path) = "vbe" Then

On Error Resume Next
If GetAttr(File.Path) <> vbNormal Then SetAttr File.Path, vbNormal
Set FName = FSO.OpentextFile(File.Path, 1, False)
Codes = FName.ReadAll
For x = 0 To cnt - 1
Tmp1 = Replace(ArrMark(x), Chr(10), "")
Tmp2 = Replace(Tmp1, Chr(13), "")
If InStr(LCase(Codes), LCase(Tmp2)) <> 0 And Tmp2 <> "" Then
List1.AddItem File.Path
Exit For
End If
Next x
End If
Next
Set SubFolders = Folder.SubFolders
For Each SubFolder In SubFolders
Dosearch SubFolder.Path
Next
End Function

Private Sub Command1_Click()
List1.Clear
Me.MousePointer = 11
Me.Caption = ">>MamaDC's antivirus<< - Tunggu, sedang dalam proses..." Command1.Enabled = False Dosearch (Combo1.Text) Command1.Enabled = True Me.Caption = ">>doyok's antivirus<<" Me.MousePointer = 0 End Sub Private Sub Command2_Click() On Error Resume Next If List1.ListIndex > -1 Then
If MsgBox("Anda yakin ingin menghapus file '" + List1.List(List1.ListIndex) + "' ?", vbYesNo + vbQuestion) = vbTes Then
Kill List1.List(List1.ListIndex)
List1.RemoveItem List1.ListIndex
End If
End If
End Sub

Private Sub Command3_Click()
If MsgBox("Anda ingin keluar ?", vbQuestion + vbYesNo) = vbYes Then End
End Sub

End Sub


End

16.Klik menu File -> Make Project.exe


Untuk tampilan lebih jelasnya silahkan lihat presentasi di bawah ini.




Tidak ada komentar:

Posting Komentar