Membuat Anti Virus Sendiri Dengan Visual Basic 6

Sebelum anda memamsukan Source Code dalam pembuatan Anti Virus,buatlah design form nya seperti pada gambar di bawah ini 

Ikuti petunjuk gambar di atas,untuk menampilkan Component Listview pada form design,buatlah pengaturan seting dari tab komponent seperti pada gambar di bawah ini 

lalu setelah anda selesai membuat design form nya,kemudian buatlah 3 buah Module.

Module1 simpan dengan nama - Browse
Module2 simpan dengan nama - Ceksum
Module3 simpan dengan nama - scan

tampak seperti pada gambar di bawah ini

Lalu setelah anda membuat Design form dan juga ketiga buah Module tersebut,sekarang saat nya kita bermain dengan Source Code atau codingan nya.

Perhatikan Kodingan di bawah ini :

Source code untuk Mod Browse :
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


Source Code untuk Mod Ceksum :
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

Source Code untuk Mod Scan :
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
    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 Form1.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 Form1.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
                Form1.lblscan.Caption = Path & Filename
                addres = Path & Filename
                                    Cheksum (addres) ' cek nilai filenya
                    cek_virus ' ambil info di data_base
                    End If
                Total_size = Total_size + FileLen(Path & Filename)
                Form1.Label5.Caption = jumlah_file & " [ " & JumDir _
                & " ]"
                ' taruh aksi-aksi diatas z
                        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 = Form1.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

Selanjut nya anda tinggal memasukan Source Code di bawah ini ke dalam form design dengan mengklick 2x pada form nya :


Option Explicit
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()
Label4.Caption = ListView1.ListItems.Count & " virus"
End Sub
Private Sub Command4_Click()
Unload Me
End Sub

Setelah Design form dan juga source code nya telah anda masukan pada tempat masing-masing nya,lalu silahkan anda coba run program nya,tampak seperti pada gambar di bawah ini setelah hasil jadi nya.

Jika terjadi suatu kesalahan atau program nya tidak berjalan dengan baik,silahkan berikan komentar anda pada postingan ini,untuk source code bawaan nya nanti akan saya berikan via email anda.

Demikianlah Sobat Blogger bagaimana caranya kita membuat Anti Virus sendiri dengan Visual Basic 6,silahkan anda kembangkan Anti Virus tersebut agar lebih kreatif lagi sesuai dengan keinginan anda.

Atas kunjungan nya saya haturkan terima kasih,semoga apa yang saya share bisa bermanfaat untuk sobat Blogger semua.. Salam Blogger