Kali ini saya membuat Aplikasi Antivirus Sederhana dengan Visual Basic 6.0 , script yg saya pelajari dari buku mas AM Hirin ....
Pertama Buat Form kira-kira dengan Layout dibawah ini :
dengan Properti sbb :
Properti Description :
Setelah mendesign Form dan mengatur Properti Object, sebelum coding , kita membutuhkan 3 buah module .
Membuat 3 buah module :
Setelah mendesign Form utama serta mengatur Properties Objek ,
Sebelum melakukan Coding kita perlu menambahkan komponen pada Project
Windows
3 buah module tersebut adalah :
1. Module 1 (name :modBrowse)
2. Module 2 (name :modCeksum)
3. Module 3 (name :modScan)
1. ModBrowse : module ini digunakan untuk menampung kode-kode yang berhubungan dengan
fungsi Browse for Folder
2. ModCeksum : module ini digunakan untuk menampung kode ceksum database internal virus
sebagai target antivirus kita
3. ModScan : module yang digunakan untuk menampung kode yang berhubungan dengan fungsi
pencarian file yang didefinisikan path-nya
ModBrowse
Private Declare Function lstrcat Lib _
"kernel32" Alias "lstrcatA" _
(ByVal lpString1 As String, _
ByVal lpString2 As String) As Long
Private Declare Function SHBrowseForFolder Lib _
"shell32" (lpBI As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib _
"shell32" (ByVal pidList As Long, _
ByVal lpBuffer As String) As Long
Private Declare Sub CoTaskMemFree Lib _
"ole32.dll" (ByVal hMem As Long)
Private Type BrowseInfo
lnghWnd As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
Private Const BIF_NEWDIALOGSTYLE As Long = &H40
Private Const BIF_EDITBOX As Long = &H10
Private Const MAX_PATH As Integer = 260
Private Const SEE_MASK_INVOKEIDLIST = &HC
Private Const SEE_MASK_NOCLOSEPROCESS = &H40
Private Const SEE_MASK_FLAG_NO_UI = &H400
Public Function BrowseForFolder(ByVal hWndOwner As Long, _
ByVal strPrompt As String) As String
On Error GoTo ErrHandle
Dim intNull As Integer
Dim lngIDList As Long, lngResult As Long
Dim strPath As String
Dim udtBI As BrowseInfo
With udtBI
.lnghWnd = hWndOwner
.lpszTitle = lstrcat(strPrompt, "")
.ulFlags = BIF_NEWDIALOGSTYLE + BIF_EDITBOX
End With
lngIDList = SHBrowseForFolder(udtBI)
If lngIDList <> 0 Then
strPath = String(MAX_PATH, 0)
lngResult = SHGetPathFromIDList(lngIDList, _
strPath)
Call CoTaskMemFree(lngIDList)
intNull = InStr(strPath, vbNullChar)
If intNull > 0 Then
strPath = Left(strPath, intNull - 1)
End If
End If
BrowseForFolder = strPath
Exit Function
ErrHandle:
BrowseForFolder = Empty
End Function
ModCeksum
Option Explicit
' Ceksum Standar by : Taufan Maulana
Dim a, b, c, d, e, f, G, h, i, j, k, l, m As Integer
Public na_virus(100) As String
Public no_virus(100) As String
Public Hasil, dataX, addres As String
Public Const R = 99
Public Function Cheksum(alamat As String) As String
Dim data As String
On Error Resume Next
Open alamat For Binary As #1
data = Space(LOF(1))
Get #1, , data
Close #1
If FileLen(alamat) >= 3000 Then
dataX = Left(data, 5000)
dataX = Replace(dataX, Chr(0), "")
dataX = Replace(dataX, Chr(255), "")
'MsgBox Len(dataX)
Else
dataX = Replace(data, Chr(0), "")
dataX = Replace(data, Chr(255), "")
End If
Call Chapter1
End Function
Private Function Chapter1()
Dim x1 As Integer
If Len(dataX) >= 350 Then
For x1 = R To 17 + R
a = Asc(Mid(dataX, x1, 1))
If a > 0 And a < 99 Then
a = Hex(a)
Exit For
End If
Next
Call chapter2
Else
terlalu_kecil ' buat fungsi yang lain
End If
End Function
Private Function chapter2()
Dim x2 As Integer
If Len(dataX) >= 350 Then
For x2 = 17 + R To R + 25
b = Asc(Mid(dataX, x2, 1))
If b > 0 And b < 199 Then
b = Hex(b)
Exit For
End If
Next
Call chapter3
End If
End Function
Private Function chapter3()
Dim x3 As Integer
If Len(dataX) >= 350 Then
For x3 = R + 25 To R + 70
c = Asc(Mid(dataX, x3, 1))
If c > 0 And c < 199 Then
c = Hex(c)
Exit For
End If
Next
Call chapter4
End If
End Function
Private Function chapter4()
Dim x4 As Integer
If Len(dataX) >= 350 Then
For x4 = R + 7 To R + 87
d = Asc(Mid(dataX, x4, 1))
If d > 0 And d < 199 Then
d = Hex(d)
Exit For
End If
Next
Call chapter5
End If
End Function
Private Function chapter5()
Dim x5 As Integer
If Len(dataX) >= 350 Then
For x5 = 87 + R To R + 95
e = Asc(Mid(dataX, x5, 1))
If e > 0 And e < 199 Then
e = Hex(e)
Exit For
End If
Next
Call chapter6
End If
End Function
Private Function chapter6()
Dim x6 As Integer
If Len(dataX) >= 350 Then
For x6 = R + 95 To R + 140
f = Asc(Mid(dataX, x6, 1))
If f > 0 And f < 199 Then
f = Hex(f)
Exit For
End If
Next
Call chapter7
End If
End Function
Private Function chapter7()
Dim x7 As Integer
If Len(dataX) >= 350 Then
For x7 = R + 140 To R + 157
G = Asc(Mid(dataX, x7, 1))
If G > 0 And G < 199 Then
G = Hex(G)
Exit For
End If
Next
Call chapter8
End If
End Function
Private Function chapter8()
Dim x8 As Integer
If Len(dataX) >= 350 Then
For x8 = R + 157 To 165 + R
h = Asc(Mid(dataX, x8, 1))
If h > 0 And h < 199 Then
h = Hex(h)
Exit For
End If
Next
Call chapter9
End If
End Function
Private Function chapter9()
Dim x9 As Integer
If Len(dataX) >= 350 Then
For x9 = R + 165 To R + 210
i = Asc(Mid(dataX, x9, 1))
If i > 0 And i < 199 Then
i = Hex(i)
Exit For
End If
Next
'Hasil = CStr(a) & CStr(b) & CStr(c) & CStr(d) &
CStr(e) & CStr(f) & CStr(g) & CStr(h) & CStr(i)
Call chapter10
End If
End Function
Private Function chapter10()
Dim x10 As Integer
If Len(dataX) >= 350 Then
For x10 = 210 + R To R + 227
j = Asc(Mid(dataX, x10, 1))
If j > 0 And j < 199 Then
j = Hex(j)
Exit For
End If
Next
'Hasil = CStr(a) & CStr(b) & CStr(c) & CStr(d) &
CStr(e) & CStr(f) & CStr(g) & CStr(h) & CStr(i)
Call chapter11
End If
End Function
Private Function chapter11()
Dim x11 As Integer
If Len(dataX) >= 350 Then
For x11 = 227 + R To R + 235
k = Asc(Mid(dataX, x11, 1))
If k > 0 And k < 199 Then
k = Hex(k)
Exit For
End If
Next
Call chapter12
End If
End Function
Private Function chapter12()
Dim x12 As Integer
If Len(dataX) >= 350 Then
For x12 = 235 + R To 285 + R
l = Asc(Mid(dataX, x12, 1))
If l > 0 And l < 199 Then
l = Hex(l)
Exit For
End If
Next
End If
Hasil = CStr(a) & CStr(b) & CStr(c) & CStr(d) _
& CStr(e) & CStr(f) & CStr(G) & CStr(h) _
& CStr(i) & CStr(j) & CStr(k) & CStr(l)
End Function
Public Function terlalu_kecil()
Dim a1, b1, c1, d1, e1, f1, g1, h1, i1, j1 As String
If Len(dataX) >= 15 Then
a1 = CStr(Asc(Mid(dataX, 1, 1)))
b1 = CStr(Asc(Mid(dataX, 2, 1)))
c1 = CStr(Asc(Mid(dataX, 3, 1)))
d1 = CStr(Asc(Mid(dataX, 4, 1)))
e1 = CStr(Asc(Mid(dataX, Len(dataX) / 2, 1)))
f1 = CStr(Asc(Mid(dataX, Len(dataX) - 4, 1)))
g1 = CStr(Asc(Mid(dataX, Len(dataX) - 3, 1)))
h1 = CStr(Asc(Mid(dataX, Len(dataX) - 2, 1)))
i1 = CStr(Asc(Mid(dataX, Len(dataX) - 1, 1)))
Hasil = a1 & b1 & c1 & d1 & e1 & f1 & g1 & h1 & i1
Else
Hasil = "FileNya Terlalu Kecil !"
End If
End Function
Public Sub nama_virus()
na_virus(0) = "word"
na_virus(1) = "M@ma Mia"
na_virus(2) = "Sipilis"
na_virus(3) = "Papa Tofa"
End Sub
Public Sub ceksum_virus()
no_virus(0) = "4C6510F24B464646464646"
no_virus(1) = "21767512AD5325344BD546E"
no_virus(2) = "261402252508C502261437"
no_virus(3) = "358F8F31919C292969295EAF"
End Sub
ModScan
Option Explicit
Dim Total_size As Double
Public jumlah_file, JumDir As Single
Declare Function GetLogicalDrives Lib "kernel32" () As Long
Private Declare Function FindFirstFile Lib "kernel32" Alias _
"FindFirstFileA" (ByVal lpFilename As String, lpFindFileData _
As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias _
"FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As _
WIN32_FIND_DATA) As Long
Private Declare Function GetFileAttributes Lib "kernel32" _
Alias "GetFileAttributesA" (ByVal lpFilename As String) As Long
Private Declare Function FindClose Lib "kernel32" _
(ByVal hFindFile As Long) As Long
Private Declare Function GetSystemDirectory Lib "kernel32" _
Alias "GetSystemDirectoryA" _
(ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function GetWindowsDirectory Lib "kernel32" _
Alias "GetWindowsDirectoryA" _
(ByVal lpBuffer As String, ByVal nSize As Long) As Long
Const MAX_PATH = 260
Const MAXDWORD = &HFFFF
Const INVALID_HANDLE_VALUE = -1
Const FILE_ATTRIBUTE_ARCHIVE = &H20
Const FILE_ATTRIBUTE_DIRECTORY = &H10
Const FILE_ATTRIBUTE_HIDDEN = &H2
Const FILE_ATTRIBUTE_NORMAL = &H80
Const FILE_ATTRIBUTE_READONLY = &H1
Const FILE_ATTRIBUTE_SYSTEM = &H4
Const FILE_ATTRIBUTE_TEMPORARY = &H100
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
'-----------------------------------
Function StripNulls(OriginalStr As String) As String
If (InStr(OriginalStr, Chr(0)) > 0) Then
OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
End If
StripNulls = OriginalStr
End Function
Function Scan(Path As String)
Dim Filename As String
Dim DirName As String
Dim dirNames() As String
Dim nDir As Integer
Dim i As Integer
Dim hSearch As Long
Dim WFD As WIN32_FIND_DATA
Dim Cont As Integer
On Error Resume Next
If frAntiVirus.Command2.Caption = "Scan" Then Exit Function
If Right(Path, 1) <> "\" Then Path = Path & "\"
nDir = 0
ReDim dirNames(nDir)
Cont = True
hSearch = FindFirstFile(Path & "*", WFD)
If hSearch <> INVALID_HANDLE_VALUE Then
Do While Cont
DirName = StripNulls(WFD.cFileName)
If (DirName <> ".") And (DirName <> "..") Then
If GetFileAttributes(Path & DirName) And _
FILE_ATTRIBUTE_DIRECTORY Then
dirNames(nDir) = DirName
nDir = nDir + 1
JumDir = JumDir + 1
ReDim Preserve dirNames(nDir)
End If
End If
Cont = FindNextFile(hSearch, WFD) 'Get next subdirectory.
DoEvents
Loop
Cont = FindClose(hSearch)
End If
hSearch = FindFirstFile(Path & "*.*", WFD)
Cont = True
If hSearch <> INVALID_HANDLE_VALUE Then
While Cont And frAntiVirus.Command2.Caption = "Stop"
Filename = StripNulls(WFD.cFileName)
If (Filename <> ".") And (Filename <> "..") Then
'perhatikan pada code daerah ini [ penting ]
Scan = Scan + (WFD.nFileSizeHigh * MAXDWORD) + _
WFD.nFileSizeLow
jumlah_file = jumlah_file + 1
frAntiVirus.lblScan.Caption = Path & Filename
addres = Path & Filename
If UCase(Right(addres, 3)) = "EXE" Or UCase(Right(addres, 3)) = "SCR" And Len(addres) <= 2000000 Then
Cheksum (addres) ' cek nilai filenya
cek_virus ' ambil info di data_base
End If
Total_size = Total_size + FileLen(Path & Filename)
frAntiVirus.lblFile.Caption = jumlah_file & " [ " & JumDir _
& " ]"
' taruh aksi-aksi diatas z
End If
Cont = FindNextFile(hSearch, WFD) ' Get next file
DoEvents
Wend
Cont = FindClose(hSearch)
End If
If nDir > 0 Then
For i = 0 To nDir - 1
Scan = Scan + Scan(Path & dirNames(i) & "\")
DoEvents
Next i
End If
End Function
Function WinDir() As String
Dim sSave As String, Ret As Long
sSave = Space(255)
Ret = GetWindowsDirectory(sSave, 255)
WinDir = Left$(sSave, Ret)
End Function
Public Sub cek_virus()
Static num As Integer
Static G As ListItem
Static V_name As String
On Error Resume Next
For num = 0 To 3
If Hasil = "" Then Exit Sub
If Hasil = no_virus(num) Then
V_name = na_virus(num)
Set G = frAntiVirus.ListView1.ListItems.Add(, , addres)
G.SubItems(1) = V_name
G.SubItems(2) = "Waiting User"
Exit For
Else
' do Nothing aja
End If
Next
End Sub
Code For frAntivirus
Double Click Form frAntiVirus
Option Explicit
' Program AntiVirus Sederhana
' Oleh Taufan Maulana . ..
' Mulai
Private Sub Check1_Click()
Dim f As Integer
If Check1.Value = 1 Then
For f = 1 To ListView1.ListItems.Count
ListView1.ListItems(f).Checked = True
Next
Else
For f = 1 To ListView1.ListItems.Count
ListView1.ListItems(f).Checked = False
Next
End If
End Sub
Private Sub Command1_Click()
Dim BFF As String
BFF = BrowseForFolder(Me.hWnd, _
"Choose Drive / Directory to be Scanned :")
If Len(BFF) > 0 Then
Text1.Text = BFF
Command2.Enabled = True
End If
End Sub
Private Sub Command2_Click()
Static jum_Vir As Integer
If Len(Text1.Text) > 0 Then
If Command2.Caption = "Scan" Then
Command2.Caption = "Stop"
ListView1.ListItems.Clear
Scan (Text1.Text)
Command2.Caption = "Scan"
Else
Command2.Caption = "Scan"
End If
jum_Vir = ListView1.ListItems.Count
MsgBox "File Discan : " & jumlah_file & Chr(13) & _
"Folder Dscan: " & JumDir & Chr(13) & _
"Threat Found: " & jum_Vir & Chr(13)
Else
MsgBox "Pilih Path address Dahulu !"
End If
jumlah_file = 0
JumDir = 0
End Sub
Private Sub Command3_Click()
Static d As Integer
If Command2.Caption = "Stop" Then
MsgBox "Proses Scan Sedang berjalan !"
Else
For d = 1 To ListView1.ListItems.Count
If ListView1.ListItems(d).Checked = True Then _
Del (ListView1.ListItems(d))
Next
End If
End Sub
Private Sub Form_Load()
nama_virus
ceksum_virus
End Sub
Function Del(mana As String)
SetAttr mana, vbNormal
Kill mana
End Function
Private Sub lblScan_Change()
lblVir.Caption = ListView1.ListItems.Count & " virus"
End Sub
Setealah Code dibuat silahkan test Program anda dengan Klik Run /F5
Lalu Test Programnya , pilih Browse Folder yang akan discan
Lalu klik Scan .....
Hasil Scan seperti tampilan diatas
Selamat mencoba ...
NB: Antivirus ini hanya sebatas Antivirus dan baru dasar, tadak seperti Antivirus yang terkenal, dam mohon maaf kalau antivirus ini malah menjadikan virus (virus detected)
