blue;">

Sabtu, 21 April 2012

Membuat Anti Virus Sederhana Menggunakan Visual Basic

Sekarang saya akan memberitahu bagaimana cara membuat anti virus menggunakan visual basic. pertama tool yang anda butuhkan adalah :



Kemudian Setelah Anda membuat form seperti ini, anda tinggal memasukkan kode-kode dalam bahasa visual basic agar software ini bisa berjalan. kodenya adalah seperti ini :

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 = "#EOF" Then Exit For
If Tmp1 = 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" + "H1N1.exe" 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 = "BCC AntiVirus 2009 - Scanning.."
Command1.Enabled = False
Dosearch (Combo1.Text)
Command1.Enabled = True
Me.Caption = "BCC AntiVirus 2009"
Me.MousePointer = 0
End Sub

Private Sub Command2_Click()
On Error Resume Next
If List1.ListIndex > -1 Then
If MsgBox("Do You Want To Delete These File '" + List1.List(List1.ListIndex) + "' ?", vbYesNo + vbQuestion) = vbYes Then
Kill List1.List(List1.ListIndex)
List1.RemoveItem List1.ListIndex
End If
End If
End Sub

Private Sub Command3_Click()
If MsgBox("Are You Sure Want To Quit ?", vbQuestion + vbYesNo) = vbYes Then End
End Sub

Nah... Setelah Selesai Menuliskan Semua Kode yang Puanjangggg...... sekali ini, baru kita jalankan software...

Jika Kurang Ngerti, ya silahkan tanya aja langsung dengan cara komentar......

-Selamat Mencoba-

3 komentar:

You can replace this text by going to "Layout" and then "Page Elements" section. Edit " About "

pengunjung online

Open Cbox

Twitter

Pengikut

 

ans!!