19 March 2013

Membuat Antivirus Sederhana dengan VB.6[Updated]




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


*******************************Update 10/06/2013**********************************

klo bingung dengan code diatas silahkan Download Projectnya di link bawah ini :

atau Aplikasi Finalnya :



*Update* aplikasi untuk Ceksum Virus

Selamat mencoba ...


Taufan |Email Me


35 comments:

Bingung minta projectnya aja gan

Iya sob,,, tolong minta Project nya,,,
Kirim Via Email => rully@rvthemes.tk

@All : Mudah gan Bikin Project kayak Gini

@dimas: minggu ini saya upload ya ..maaf blm sempat mklum rutinitas kerja yg lgi banyak2nya ..

@All : sudah di upload file Project nya , silahkan dicoba ....

ada kok di tab sebelah kanan , klo mas buka file rar taufan_AV_Sederhana.rar

Gw coba tes dulu ya gan .... tapi kalo buat windows 7 agak susah yah

Signaturenya berapa koq gak ada satupun virus terdeteksi

sob saya coba projectnya tidak bisa kenapa yaa
ada tulisan :
Path not found:
C:\Users\user\Downloads\Forms\frAntiVirus.frm'--Continue Loading
Project?

@Dear Okta

Pastikan semua filenya sudah di ekstrak di Localdisk , (ada 7 file) , lalu buka file proAntiVirus.vbp ,seharusnya sudah bisa dieksekusi ..

Gan cara menambahkan database virusnya gimana ...? mohon pencerahannya gan....!

untuk menambahkannya buka file aplikasi ceksum_virus diatas (update), kemudian masuk ke mod_ceksum tambahkan nama virus dan signature dari dr aplikasi ceksum
------------------------------------------------------------
Public Sub nama_virus()
na_virus(0) = "Fajar"
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

semoga membantu ...:)

Thanks gan atas bantuannya, tapi saya mau tanya lagi tipe file yang dapat terditeksi sama antivirus ini apakah cuman .exe aja atau tipe file yang lain juga bisa sama satu lagi gan cara menambahkan form karantinanya gimana gan ....? Thanks gan sebelumnya

Dear Admin,

Public Sub ceksum_virus()
no_virus(0) = "4C6510F24B464646464646"
no_virus(1) = "21767512AD5325344BD546E"
no_virus(2) = "261402252508C502261437"
no_virus(3) = "358F8F31919C292969295EAF"
End Sub

bisa tolong jelaskan mengenai hal itu g?
bingung masalah penulisan-penulisan seperti ini "4C6510F24B464646464646"

Mohon pencerahannya...
Terima kasih,

untuk mengetahui ceksum file download dengan aplikasi ceksum file diatas mas

Udah saya extract...
tp kok gag bisa dibuka projectnya....

Gan Saya Juga Minta Project Av Sederhanan Kirim Ke jodaadampurba@ymail.com (Huruf Kecil Semua Gan) Thanks

Public Sub nama_virus()
na_virus(0) = "Fajar"
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

buat kode-kode yang diatas, itu emang udah dari sananya atau harus diisi sama kita ? kalo diisi sama kita, boleh ga minta kodenya ?

makasih sebelumnya ..

Klo mau belajar buat module nya dimana ya ?

pengen nyoba ah biar bisa hiihihihihihi

Mas extensi file virusnya apa aja nih yang bisa di buka dengan aplikasi ceksum di atas ? .exe / .bat / .vbs ?

Bolh Tanya kalo cara buat Checksum Checker gimana nya , mohon penjelasanya

Link mati semua gan!
Reupload ya...

sudah di perbaiki link Downloadnya

Password : fara2012

kok path not found terus gan? padahal sudah ekstrak semua 7 file

Gan punya saya itu kok compile error ya method or data member not found dibagian command3

bg boleh minta full sc aplikasinya ?
tolong ya bg
kirim ke anggipranata04@gmail.com

Post a Comment

Silahkan jika ingin Komentar , Tetap menjaga kesopanan dan rasa saling menghormati dalam memberikan komentar pada sesama blogger ...