Cara Membuat Antivirus sendiri with VB 6 ~ Computer-Blog000

Pertama Buat Form kira-kira dengan Layout dibawah ini :

dengan Properti

Properti Description

Setelah mendesign Form dan mengatur Properti Object, sebelum coding , kita membutuhkan 3 buah module .

Tambahkan 3 module
Setelah mendesign Form utama serta mengatur Properties Objek , Sebelum melakukan Coding kita perlu menambahkan komponen pada Project Windows
yaitu 3 buah module
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