Membuat ANTIVIRUS

    Share

    CYBER
    CO - Admin
    CO - Admin

    Male
    Thread & Post : 215
    Point Forum : 293637
    Thanks Given : 4034
    Join date : 05.08.11
    Age : 26
    Lokasi : S-N-U-T-Z-E-R

    default Membuat ANTIVIRUS

    Post by CYBER on Fri Sep 30, 2011 12:03 pm

    Buat Standart exe form 1 dengan caption "Antivirus"

    Perhatikan langka berikut :
    Pastikan anda membuat harus sama dengan teknik di bwh ini :

    Spoiler:
    Begin VB.Form Antivirus
    BackColor = &H00000000&
    BorderStyle = 0 'None
    Caption = "s0av Antivirus"
    ClientHeight = 5970
    ClientLeft = 3885
    ClientTop = 2490
    ClientWidth = 9945
    ClipControls = 0 'False
    BeginProperty Font
    Name = "Fixedsys"
    Size = 9
    Charset = 0
    Weight = 400
    Underline = 0 'False
    Italic = 0 'False
    Strikethrough = 0 'False
    EndProperty
    Icon = "Form1.frx":0000
    LinkTopic = "Form1"
    MaxButton = 0 'False
    ScaleHeight = 5970
    ScaleWidth = 9945
    StartUpPosition = 2 'CenterScreen
    Begin VB.Timer Timer2
    Enabled = 0 'False
    Interval = 500
    Left = 240
    Top = 5400
    End
    Begin VB.Timer Timer1
    Enabled = 0 'False
    Interval = 1000
    Left = 120
    Top = 5280
    End
    Begin Project1.DMSXpButton cmdKarantina
    Height = 375
    Left = 5400
    TabIndex = 17
    ToolTipText = "Klik disini untuk memindahkan virus ke karantina."
    Top = 5280
    Width = 1335
    _ExtentX = 2355
    _ExtentY = 661
    BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
    Name = "Tahoma"
    Size = 9
    Charset = 0
    Weight = 700
    Underline = 0 'False
    Italic = 0 'False
    Strikethrough = 0 'False
    EndProperty
    Caption = "Karantina"
    ForeColor = -2147483642
    ForeHover = 192
    End
    Begin Project1.DMSXpButton cmdScan
    Height = 375
    Left = 2520
    TabIndex = 13
    ToolTipText = "Klik disini untuk memeriksa file."
    Top = 5280
    Width = 1335
    _ExtentX = 2355
    _ExtentY = 661
    BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
    Name = "Tahoma"
    Size = 9
    Charset = 0
    Weight = 700
    Underline = 0 'False
    Italic = 0 'False
    Strikethrough = 0 'False
    EndProperty
    Caption = "Scan"
    ForeColor = -2147483642
    ForeHover = 192
    End
    Begin Project1.DMSXpButton cmdHapus
    Height = 375
    Left = 3960
    TabIndex = 12
    ToolTipText = "Klik disini untuk menghapus virus yang terdeteksi."
    Top = 5280
    Width = 1335
    _ExtentX = 2355
    _ExtentY = 661
    BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
    Name = "Tahoma"
    Size = 9
    Charset = 0
    Weight = 700
    Underline = 0 'False
    Italic = 0 'False
    Strikethrough = 0 'False
    EndProperty
    Caption = "Hapus"
    ForeColor = -2147483642
    ForeHover = 192
    End
    Begin Project1.DMSXpButton cmdMenu
    Height = 375
    Left = 6840
    TabIndex = 11
    ToolTipText = "Klik disini untuk menjalankan menu tambahan."
    Top = 5280
    Width = 1335
    _ExtentX = 2355
    _ExtentY = 661
    BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
    Name = "Tahoma"
    Size = 9
    Charset = 0
    Weight = 700
    Underline = 0 'False
    Italic = 0 'False
    Strikethrough = 0 'False
    EndProperty
    Caption = "Menu"
    ForeColor = -2147483642
    ForeHover = 192
    End
    Begin Project1.DMSXpButton cmdKeluar
    Height = 375
    Left = 8280
    TabIndex = 10
    ToolTipText = "Klik disini untuk Keluar."
    Top = 5280
    Width = 1335
    _ExtentX = 2355
    _ExtentY = 661
    BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
    Name = "Tahoma"
    Size = 9
    Charset = 0
    Weight = 700
    Underline = 0 'False
    Italic = 0 'False
    Strikethrough = 0 'False
    EndProperty
    Caption = "Keluar"
    ForeColor = -2147483642
    ForeHover = 192
    End
    Begin MSComctlLib.ProgressBar ProgressBar1
    Height = 255
    Left = 3360
    TabIndex = 8
    Top = 2280
    Width = 6255
    _ExtentX = 11033
    _ExtentY = 450
    _Version = 393216
    BorderStyle = 1
    Appearance = 0
    Scrolling = 1
    End
    Begin MSComctlLib.ListView ListView1
    Height = 2295
    Left = 360
    TabIndex = 4
    Top = 2760
    Width = 9255
    _ExtentX = 16325
    _ExtentY = 4048
    View = 3
    LabelWrap = -1 'True
    HideSelection = -1 'True
    GridLines = -1 'True
    HoverSelection = -1 'True
    _Version = 393217
    ForeColor = 192
    BackColor = 12632256
    BorderStyle = 1
    Appearance = 0
    BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
    Name = "Arial"
    Size = 8.25
    Charset = 0
    Weight = 400
    Underline = 0 'False
    Italic = 0 'False
    Strikethrough = 0 'False
    EndProperty
    NumItems = 5
    BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
    Text = " "
    Object.Width = 0
    EndProperty
    BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
    SubItemIndex = 1
    Text = "Nama Virus "
    Object.Width = 3176
    EndProperty
    BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}
    SubItemIndex = 2
    Text = "Lokasi :"
    Object.Width = 6528
    EndProperty
    BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628}
    Alignment = 1
    SubItemIndex = 3
    Text = "Ukuran (byte)"
    Object.Width = 2912
    EndProperty
    BeginProperty ColumnHeader(5) {BDD1F052-858B-11D1-B16A-00C0F0283628}
    SubItemIndex = 4
    Text = "Keterangan"
    Object.Width = 2911
    EndProperty
    End
    Begin VB.Line Line4
    BorderColor = &H0000FF00&
    X1 = 8520
    X2 = 8520
    Y1 = 120
    Y2 = 1200
    End
    Begin VB.Line Line3
    BorderColor = &H0000FF00&
    X1 = 8520
    X2 = 1440
    Y1 = 1200
    Y2 = 1200
    End
    Begin VB.Line Line2
    BorderColor = &H0000FF00&
    X1 = 1440
    X2 = 1440
    Y1 = 120
    Y2 = 1200
    End
    Begin VB.Label Label6
    Alignment = 2 'Center
    BackStyle = 0 'Transparent
    Caption = "Sobat Antivirus Army of System PC"
    ForeColor = &H0000C000&
    Height = 255
    Left = 2280
    TabIndex = 20
    Top = 600
    Width = 5415
    End
    Begin VB.Label Label5
    Alignment = 2 'Center
    BackStyle = 0 'Transparent
    Caption = "s0av Antivirus Indonesia"
    BeginProperty Font
    Name = "Fixedsys"
    Size = 18
    Charset = 0
    Weight = 400
    Underline = 0 'False
    Italic = 0 'False
    Strikethrough = 0 'False
    EndProperty
    ForeColor = &H0000FF00&
    Height = 615
    Left = 720
    TabIndex = 19
    Top = 120
    Width = 8775
    End
    Begin VB.Line Line1
    BorderColor = &H00008000&
    BorderWidth = 4
    X1 = 0
    X2 = 9960
    Y1 = 1560
    Y2 = 1560
    End
    Begin VB.Label Label1
    BackStyle = 0 'Transparent
    Caption = "Elapsed : 00:00:00"
    BeginProperty Font
    Name = "Tahoma"
    Size = 9
    Charset = 0
    Weight = 700
    Underline = 0 'False
    Italic = 0 'False
    Strikethrough = 0 'False
    EndProperty
    ForeColor = &H0000FF00&
    Height = 255
    Left = 360
    TabIndex = 18
    Top = 5340
    Width = 1815
    End
    Begin VB.Label Label4
    BackStyle = 0 'Transparent
    Caption = ":"
    BeginProperty Font
    Name = "Arial"
    Size = 9
    Charset = 0
    Weight = 400
    Underline = 0 'False
    Italic = 0 'False
    Strikethrough = 0 'False
    EndProperty
    ForeColor = &H0000FF00&
    Height = 255
    Left = 1680
    TabIndex = 16
    Top = 2040
    Width = 135
    End
    Begin VB.Label Label3
    BackStyle = 0 'Transparent
    Caption = ":"
    BeginProperty Font
    Name = "Arial"
    Size = 9
    Charset = 0
    Weight = 400
    Underline = 0 'False
    Italic = 0 'False
    Strikethrough = 0 'False
    EndProperty
    ForeColor = &H0000FF00&
    Height = 255
    Left = 1680
    TabIndex = 15
    Top = 2280
    Width = 135
    End
    Begin VB.Label Label2
    BackStyle = 0 'Transparent
    Caption = ":"
    BeginProperty Font
    Name = "Arial"
    Size = 9
    Charset = 0
    Weight = 400
    Underline = 0 'False
    Italic = 0 'False
    Strikethrough = 0 'False
    EndProperty
    ForeColor = &H0000FF00&
    Height = 255
    Left = 1680
    TabIndex = 14
    Top = 1800
    Width = 135
    End
    Begin VB.Label lblPercentComplete
    Alignment = 1 'Right Justify
    BackColor = &H00303030&
    BackStyle = 0 'Transparent
    Caption = "0 % Complete..."
    BeginProperty Font
    Name = "Tahoma"
    Size = 8.25
    Charset = 0
    Weight = 400
    Underline = 0 'False
    Italic = 0 'False
    Strikethrough = 0 'False
    EndProperty
    ForeColor = &H0000FF00&
    Height = 255
    Left = 7080
    TabIndex = 9
    Top = 2040
    Width = 2535
    End
    Begin VB.Label status
    BackColor = &H00303030&
    BackStyle = 0 'Transparent
    BeginProperty Font
    Name = "Tahoma"
    Size = 8.25
    Charset = 0
    Weight = 400
    Underline = 0 'False
    Italic = 0 'False
    Strikethrough = 0 'False
    EndProperty
    ForeColor = &H0000FF00&
    Height = 255
    Left = 3360
    TabIndex = 7
    Top = 1800
    Width = 6135
    End
    Begin VB.Label persen
    BackColor = &H00303030&
    BackStyle = 0 'Transparent
    Caption = "Total File "
    BeginProperty Font
    Name = "Tahoma"
    Size = 8.25
    Charset = 0
    Weight = 400
    Underline = 0 'False
    Italic = 0 'False
    Strikethrough = 0 'False
    EndProperty
    ForeColor = &H0000FF00&
    Height = 255
    Left = 360
    TabIndex = 6
    Top = 2040
    Width = 975
    End
    Begin VB.Label lblTotalFile
    Alignment = 1 'Right Justify
    BackColor = &H00303030&
    BackStyle = 0 'Transparent
    Caption = "0"
    BeginProperty Font
    Name = "Tahoma"
    Size = 8.25
    Charset = 0
    Weight = 400
    Underline = 0 'False
    Italic = 0 'False
    Strikethrough = 0 'False
    EndProperty
    ForeColor = &H0000FF00&
    Height = 255
    Left = 1920
    TabIndex = 5
    Top = 2040
    Width = 855
    End
    Begin VB.Label lblJumlahvirus
    Alignment = 1 'Right Justify
    BackColor = &H00303030&
    BackStyle = 0 'Transparent
    Caption = "0"
    BeginProperty Font
    Name = "Tahoma"
    Size = 8.25
    Charset = 0
    Weight = 400
    Underline = 0 'False
    Italic = 0 'False
    Strikethrough = 0 'False
    EndProperty
    ForeColor = &H0000FF00&
    Height = 255
    Left = 1920
    TabIndex = 3
    Top = 2280
    Width = 855
    End
    Begin VB.Label Virus_Ditemukan
    BackColor = &H00303030&
    BackStyle = 0 'Transparent
    Caption = "Virus Ditemukan "
    BeginProperty Font
    Name = "Tahoma"
    Size = 8.25
    Charset = 0
    Weight = 400
    Underline = 0 'False
    Italic = 0 'False
    Strikethrough = 0 'False
    EndProperty
    ForeColor = &H0000FF00&
    Height = 255
    Left = 360
    TabIndex = 2
    Top = 2280
    Width = 1215
    End
    Begin VB.Label jumlah_file
    BackColor = &H00303030&
    BackStyle = 0 'Transparent
    Caption = "File Diperiksa "
    BeginProperty Font
    Name = "Tahoma"
    Size = 8.25
    Charset = 0
    Weight = 400
    Underline = 0 'False
    Italic = 0 'False
    Strikethrough = 0 'False
    EndProperty
    ForeColor = &H0000FF00&
    Height = 255
    Left = 360
    TabIndex = 1
    Top = 1800
    Width = 1095
    End
    Begin VB.Label lblFileDiperiksa
    Alignment = 1 'Right Justify
    BackColor = &H00303030&
    BackStyle = 0 'Transparent
    Caption = "0"
    BeginProperty Font
    Name = "Tahoma"
    Size = 8.25
    Charset = 0
    Weight = 400
    Underline = 0 'False
    Italic = 0 'False
    Strikethrough = 0 'False
    EndProperty
    ForeColor = &H0000FF00&
    Height = 255
    Left = 1920
    TabIndex = 0
    Top = 1800
    Width = 855
    End
    Begin VB.Menu mnu
    Caption = "mnu"
    Visible = 0 'False
    Begin VB.Menu mnuTemp
    Caption = "Temp Database"
    End
    Begin VB.Menu mnuTool
    Caption = "External Tool"
    End
    Begin VB.Menu mnuViewSigna
    Caption = "View Signature"
    End
    Begin VB.Menu mnuAbout
    Caption = "About"

    kalau sudah masukkan kode ini pada form1:
    Spoiler:
    Dim LokasiDir As String

    Private z As Integer
    Private Ucapan As String
    Private Titik As String

    Private Type pewaktu
    i As Integer
    s As String
    End Type

    Private detik As pewaktu, menit As pewaktu, jam As pewaktu

    'Pendeklarasian fungsi windows API
    'Tak berhasil diletakkan di Fungsi
    Private Sub cmdhapus_Click()
    'Jika tombol Hapus di klik
    tindakan "hapus"
    End Sub

    Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    On Error Resume Next 'Penanganan error
    If cmdScan.Caption = "Stop" Then 'Jika proses scanning sedang berjalan
    If MsgBox("Anda yakin akan keluar saat pemeriksaan file sedang berlangsung?", vbYesNo + vbQuestion, "Anda Yakin?") = vbNo Then
    'jika konfirmasi di jawab ya, maka program di tutup
    Cancel = -1
    Else
    End
    End If
    Else 'jika proses scanning tak berlangsung
    End ' keluar saja
    End If
    End Sub

    Private Sub mnuTemp_click()
    frmTempDb.Show , Me
    End Sub
    Private Sub mnuTool_click()
    frmExtTool.Show , Me
    End Sub
    Private Sub mnuabout_click()
    frmAbout.Show , Me
    End Sub
    Private Sub mnuviewsigna_click()
    frmSignature.Show , Me
    End Sub
    Private Sub cmdKarantina_Click()
    'Jika tombol Karantina di klik
    tindakan "karantina"
    End Sub
    Private Sub cmdKeluar_Click()
    'jika tombol keluar di klik
    Call Form_QueryUnload(1, 1)

    End Sub

    Private Sub cmdMenu_Click()
    PopupMenu mnu
    End Sub

    Private Sub cmdscan_Click()
    If cmdScan.Caption = "Scan" Then 'Jika akan memulai proses scan
    Dim lpIDList As Long
    Dim sBuffer As String
    Dim szTitle As String
    Dim tBrowseInfo As BrowseInfo
    szTitle = "Pilih lokasi yang akan di periksa."
    With tBrowseInfo
    .hWndOwner = Me.hwnd
    .lpszTitle = lstrcat(szTitle, "")
    .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
    End With
    lpIDList = SHBrowseForFolder(tBrowseInfo)
    If (lpIDList) Then
    sBuffer = Space(MAX_PATH)
    SHGetPathFromIDList lpIDList, sBuffer
    sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
    LokasiDir = sBuffer
    'Proses pemeriksaan dimulai
    ListView1.ListItems.Clear
    lblPercentComplete.Caption = "0 % Complete..."
    ProgressBar1.Value = 0
    cmdScan.Caption = "Stop"
    cmdHapus.Enabled = False
    cmdMenu.Enabled = False
    cmdKarantina.Enabled = False
    lblFileDiperiksa.Caption = "0"
    lblTotalFile.Caption = "0"
    lblJumlahVirus.Caption = "0"
    Call Loading
    Call JalankanWaktu
    MENGANALISA "Hitung"
    Call Berhenti_Loading
    MENGANALISA "Pindai"
    Call HentikanWaktu
    'Proses pemeriksaan selesai
    lblJumlahVirus.Caption = ListView1.ListItems.Count
    cmdScan.Caption = "Scan"
    cmdMenu.Enabled = True
    cmdHapus.Enabled = True
    cmdKarantina.Enabled = True
    If lblJumlahVirus.Caption = "0" Then
    If lblFileDiperiksa.Caption < lblTotalFile.Caption Then
    status.Caption = "Proses dihentikan, tak ada virus ditemukan."
    ProgressBar1.Value = 0
    Else
    status.Caption = "Pemeriksaan selesai, tak ada virus ditemukan."
    End If
    Else
    If lblFileDiperiksa.Caption < lblTotalFile.Caption Then
    status.Caption = "Proses dihentikan, " & lblJumlahVirus.Caption & " virus ditemukan."
    ProgressBar1.Value = 0
    Else
    status.Caption = "Pemeriksaan selesai, " & lblJumlahVirus.Caption & " virus ditemukan."
    Beep
    End If
    End If
    End If
    Else ' Jika proses scan sedang berlangsung
    cmdScan.Caption = "Scan"
    End If
    End Sub
    Private Sub Form_Activate()
    'Berfungsi mengecek kelayakan versi.
    Dim tanggal, bulan, tahun 'pendeklarasian
    tanggal = Format(Now, "dd") 'Memeriksa sekarang tanggal berapa
    bulan = Format(Now, "mm") 'memeriksa sekarang bulan berapa
    tahun = Format(Now, "yyyy") ' Memeriksa sekarang tahun berapa
    If tanggal >= 10 And bulan >= 12 And tahun >= 2012 Or bulan >= 12 And tahun >= 2012 Or tahun > 2012 Then
    MsgBox "Mohon update antivirus ke versi baru." & vbCrLf & "Harap hapus, lalu download update dari http://www.eastjavahacker.blogspot.com", vbOKOnly + vbExclamation, "Pesan"
    End If
    If Dir(App.path & "\s0av.dll") = "" Then
    MsgBox "error time..." & vbCrLf & "File ''" & App.path & "\s0av.dll''" & " Not Found." & vbCrLf & "Cek Kembali atau bisa " & vbCrLf & "Download kembali dari http://www.eastjavahacker.blogspot.com/", 0 + vbExclamation, "Error"
    End
    End If
    status.Caption = "Selamat datang di s0av Beta 11 [05 Agustus 2011]. Klik Scan untuk memulai..."
    Call List_Process 'List_Process
    End Sub

    Function CEK_DENGAN_CRC(namadir As String, NamaFile As String)
    'Fungsi untuk mengecek dengan metode CRC32
    On Error Resume Next
    Dim ceksum As String
    Dim m_CRC As clsCRC
    Dim namavirus As String
    Set m_CRC = New clsCRC
    ceksum = Hex(m_CRC.CalculateFile(namadir & NamaFile))
    namavirus = cek_with_navi(ceksum)
    'If lblChecksum.Caption = ceksum Then namavirus = "Permintaan User"

    If namavirus <> "" Then
    With ListView1
    Set lvItm = .ListItems.Add
    lvItm.SubItems(1) = namavirus
    lvItm.SubItems(2) = namadir & NamaFile
    lvItm.SubItems(3) = FileLen(namadir & NamaFile)
    End With
    Call List_Process
    Bunuh namadir & NamaFile
    lblJumlahVirus = lblJumlahVirus + 1
    End If

    End Function
    Function CEK_DENGAN_STRING(namadir As String, NamaFile As String)
    Dim i As Integer, ukuran As Integer
    Dim namavirus As String
    Dim virname(1000) As String
    Dim sign(1000) As String
    Dim sampel(1000) As String
    Dim ukuran_asli(1000) As Long

    i = 1
    Do 'For i = 1 To gettotalsampel()
    sampel(i) = ambilsampel(i)
    'mengambil signature dari sampel
    sign(i) = Mid(sampel(i), 1, InStr(1, sampel(i), ":") - 1)
    'mengambil namavirus dari sampel
    virname(i) = Mid(sampel(i), Len(sign(i)) + 2, (InStr(Len(sign(i)) + 2, sampel(i), ":") - (Len(sign(i)) + 2)))
    'mengambil namavirus yg dihasilkan
    ukuran_asli(i) = Mid(sampel(i), Len(sign(i)) + 1 + Len(virname(i)) + 2, Len(sampel(i)))

    namavirus = stringcheck(namadir & NamaFile, hex2ascii(sign(i)), virname(i))
    'jika ada virus, tampilkan pada list
    If namavirus <> "" And namavirus <> "Selesai" Then
    With ListView1
    Set lvItm = .ListItems.Add
    lvItm.SubItems(1) = namavirus
    lvItm.SubItems(2) = namadir & NamaFile
    lvItm.SubItems(3) = FileLen(namadir & NamaFile)
    If ukuran_asli(i) < FileLen(namadir & NamaFile) Then lvItm.SubItems(4) = "File Terinfeksi"
    End With
    Call List_Process
    Bunuh namadir & NamaFile
    lblJumlahVirus = lblJumlahVirus + 1
    Exit Do
    End If
    i = i + 1
    Loop Until sampel(i - 1) = "Selesai:Selesai:Selesai"

    End Function
    Function tindakan(aksi As String)
    On Error Resume Next
    Dim jumlahvirus As Integer
    Dim jmlvirus As Integer
    Dim a As Integer
    Dim i As Integer
    jumlahvirus = lblJumlahVirus.Caption
    jmlvirus = lblJumlahVirus.Caption
    If lblJumlahVirus.Caption = 0 Then
    If aksi = "hapus" Then
    status.Caption = "Tak ada virus yang dihapus..."
    Else
    status.Caption = "Tak ada virus yang dikarantina..."
    End If
    Else
    If aksi = "karantina" Then MkDir ("C:\Karantina\")
    For i = 0 To jumlahvirus
    Call List_Process
    Bunuh ListView1.ListItems(jumlahvirus).SubItems(2)
    SetAttr (ListView1.ListItems(jumlahvirus).SubItems(2)), vbNormal
    If aksi = "hapus" Then
    DeleteFile (ListView1.ListItems(jumlahvirus).SubItems(2))
    Else
    MoveFile ListView1.ListItems(jumlahvirus).SubItems(2), "C:\Karantina\" & Dir(ListView1.ListItems(jumlahvirus).SubItems(2)) & "_vir"
    End If
    ListView1.ListItems.Remove (jumlahvirus)
    a = (100 / lblJumlahVirus.Caption) * i
    ProgressBar1.Value = a
    lblPercentComplete.Caption = a & " % Complete..."
    jumlahvirus = jumlahvirus - 1
    Next i
    lblFileDiperiksa.Caption = "0"
    lblJumlahVirus.Caption = "0"
    If aksi = "hapus" Then
    status.Caption = jmlvirus & " virus telah dihapus..."
    Else
    status.Caption = jmlvirus & " virus telah dipindahkan ke folder 'C:\Karantina\' ..."
    End If
    End If
    End Function

    Private Sub Timer1_Timer()
    detik.i = detik.i + 1
    If detik.i > 59 Then
    menit.i = menit.i + 1
    detik.i = 0
    End If

    If menit.i > 59 Then
    jam.i = jam.i + 1
    menit.i = 0
    End If

    detik.s = detik.i
    menit.s = menit.i
    jam.s = jam.i

    If Len(detik.s) = 1 Then
    detik.s = "0" & detik.s
    End If

    If Len(menit.s) = 1 Then
    menit.s = "0" & menit.s
    End If

    If Len(jam.s) = 1 Then
    jam.s = "0" & jam.s
    End If
    Label1.Caption = "Elapsed : " & jam.s & ":" & menit.s & ":" & detik.s
    End Sub

    Private Sub JalankanWaktu()
    detik.i = 0
    menit.i = 0
    jam.i = 0

    Timer1.Enabled = True
    End Sub

    Private Sub HentikanWaktu()
    Timer1.Enabled = False
    End Sub
    Function MENCARI_VIRUS(path As String, SearchStr As String, FileCount As Double, Kerja As String)
    'Fungsi ini berguna untuk melakukan scanning dan menghitung file.
    'Tergantung parameter kerja.
    On Error Resume Next
    Dim Filename As String, NAMA_DIRECTORY As String, DIR_NAMES() As String
    Dim nDIR As Integer, i As Integer
    If cmdScan.Caption = "Scan" Then
    Exit Function
    End If
    If Right(path, 1) <> "\" Then path = path & "\"
    nDIR = 0
    ReDim DIR_NAMES(nDIR)
    NAMA_DIRECTORY = Dir(path, vbDirectory Or vbHidden Or vbArchive Or vbReadOnly Or vbSystem)
    Do While Len(NAMA_DIRECTORY) > 0
    If (NAMA_DIRECTORY <> ".") And (NAMA_DIRECTORY <> "..") Then
    If GetAttr(path & NAMA_DIRECTORY) And vbDirectory Then
    DIR_NAMES(nDIR) = NAMA_DIRECTORY
    DirCount = DirCount + 1
    nDIR = nDIR + 1


    ReDim Preserve DIR_NAMES(nDIR)
    End If
    sysFileERRCont:
    End If
    NAMA_DIRECTORY = Dir()
    Loop
    Filename = Dir(path & SearchStr, vbNormal Or vbHidden Or vbSystem Or vbReadOnly Or vbArchive)
    While Len(Filename) <> 0
    If cmdScan.Caption = "Scan" Then
    Exit Function
    End If
    If Kerja = "Pindai" Then
    'FindFiles = FindFiles + FileLen(path & Filename)
    If Len(path & Filename) > 50 Then 'jika panjang nama file > 50
    If Len(Filename) < 15 Then
    status.Caption = Mid(path, 1, InStr(4, path, "\")) & "..." & "\" & Filename
    Else
    status.Caption = Mid(path, 1, InStr(4, path, "\")) & "..." & "\" & "..." & Right(Filename, 15)
    End If

    Else 'jika tidak
    status.Caption = path & Filename
    End If ' akhir jika panjangfile > 50

    If Mid(path, 1, 12) = "C:\Karantina" Or FileLen(path & Filename) / 1024 >= 4000 Then
    GoTo nggakusah ' Jika folder karantina, tidak usah dicek
    End If

    '///////////////////////////////////////////////////////
    'Fungsi untuk melakukan pengecekan dengan sampel string
    If typefile(Filename) = "Application" Or typefile(Filename) = "Screen Saver" Then
    CEK_DENGAN_STRING path, Filename
    End If
    If FileLen(path & Filename) / 1024 >= 750 Then
    GoTo nggakusah ' Jika ukuran besar, tidak usah dicek dengan crc32
    End If

    'Jika ukuran file kecil
    'jika bukan pada folder karantina
    'periksa sudah terdeteksi oleh sampel string apa belum
    Dim virus_akhir As Integer
    Dim lblvirusakhir As String, lblnamafile As String
    virus_akhir = lblJumlahVirus.Caption
    lblvirusakhir = ListView1.ListItems(virus_akhir).SubItems(2)
    lblnamafile = path & Filename
    If lblvirusakhir = lblnamafile Then
    GoTo nggakusah
    End If
    'Perintah dibawah ini untuk memanggil fungsi cek dengan CRC32
    CEK_DENGAN_CRC path, Filename

    'Jika sudah terdeteksi dengan crc, tidak usah dicek dengan string
    '/////////////////////////////////////////////////////////
    nggakusah:

    '////////////////////////////////////////////////////////
    lblFileDiperiksa.Caption = lblFileDiperiksa.Caption + 1
    i = (100 / lblTotalFile.Caption) * lblFileDiperiksa.Caption
    If i <= 100 Then
    ProgressBar1.Value = i
    lblPercentComplete.Caption = i & " % Complete..."
    End If
    '///////////////////////////////////////////////////////
    End If
    FileCount = FileCount + 1
    DoEvents
    Filename = Dir()
    Wend
    If nDIR > 0 Then
    For i = 0 To nDIR - 1
    MENCARI_VIRUS = MENCARI_VIRUS + MENCARI_VIRUS(path & DIR_NAMES(i) & "\", _
    SearchStr, FileCount, Kerja)
    Next i
    DoEvents
    End If
    End Function
    Function MENGANALISA(Kerja As String)
    Dim SearchPath As String, FindStr As String
    Dim FileSize As Long
    Dim NumFiles As Double
    ListView1.ListItems.Clear
    SearchPath = LokasiDir
    FindStr = "*.*"
    FileSize = MENCARI_VIRUS(SearchPath, FindStr, NumFiles, Kerja)
    DoEvents
    If Kerja = "Hitung" Then
    lblTotalFile.Caption = NumFiles
    End If
    FileSize = Empty
    ErrorHandler:
    End Function
    'fungsi dibawah ini untuk mendapatkan program-program apa yang sedang dalam proses
    Private Sub List_Process()
    jmlProcess = 1
    Dim hSnapShot As Long, uProcess As PROCESSENTRY32
    hSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0&)
    'Mendapatkan informasi tentang semua proses yang sedang dijalankan
    uProcess.dwSize = Len(uProcess)
    r = Process32First(hSnapShot, uProcess)
    'Mendapatkan informasi tentang proses yang pertama
    Do While r
    'perulangan selama r <> 0

    'List1.AddItem Left$(uProcess.szExeFile, InStr(1, uProcess.szExeFile, Chr$(0), vbTextCompare) - 1)
    'Memasukkan nama aplikasi pada List1
    ProcessID(jmlProcess) = uProcess.th32ProcessID
    path(jmlProcess) = PathByPID(ProcessID(jmlProcess))
    'Memasukkan Process ID untuk masing-masing aplikasi
    r = Process32Next(hSnapShot, uProcess)
    'Mendapatkan informasi dari proses selanjutnya pada windows
    jmlProcess = jmlProcess + 1
    Loop
    jmlProcess = jmlProcess - 1
    CloseHandle hSnapShot
    End Sub

    Public Function PathByPID(pid As Long) As String
    'Fungsi dibawah ini berfungsi untuk mencari path atau lokasi dari
    'program yang sedang berjalan
    'Kode ini dapat dilihat di :
    'http://support.microsoft.com/default.aspx?scid=kb;en-us;187913
    Dim cbNeeded As Long
    Dim Modules(1 To 200) As Long
    Dim ret As Long
    Dim ModuleName As String
    Dim nSize As Long
    Dim hProcess As Long

    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION _
    Or PROCESS_VM_READ, 0, pid)

    If hProcess <> 0 Then

    ret = EnumProcessModules(hProcess, Modules(1), _
    200, cbNeeded)

    If ret <> 0 Then
    ModuleName = Space(MAX_PATH)
    nSize = 500
    ret = GetModuleFileNameExA(hProcess, _
    Modules(1), ModuleName, nSize)
    PathByPID = Left(ModuleName, ret)
    End If
    End If

    ret = CloseHandle(hProcess)

    If PathByPID = "" Then
    PathByPID = ""
    End If

    If Left(PathByPID, 4) = "\??\" Then
    PathByPID = ""
    End If


    If Left(PathByPID, 12) = "\SystemRoot\" Then
    PathByPID = ""
    End If
    End Function

    Private Sub Bunuh(NamaFile As String)
    'procedure ini berfungsi untuk menghentikan proses dari sebuah program
    Dim a As Long
    For a = 1 To jmlProcess
    If path(a) = NamaFile Then
    TerminateProcess OpenProcess(PROCESS_ALL_ACCESS, 1, ProcessID(a)), 0
    Exit For
    Call List_Process
    End If
    Next a
    End Sub


    Private Sub Timer2_Timer()
    If z = Len(Titik) + 1 Then
    z = 0
    Else
    status.Caption = Ucapan & Mid(Ucapan & Titik, InStr(1, Ucapan & Titik, "."), z)
    z = z + 1
    End If
    End Sub

    Private Sub Loading()
    Timer2.Enabled = True
    z = 0
    Ucapan = "Sedang Menganalisa, Harap Tunggu"
    Titik = "...."
    End Sub

    Private Sub Berhenti_Loading()
    Timer2.Enabled = False
    End Sub

    lalu buat lagi sebuah form dengan mengklik add -> project -> form
    berikan name form2 frmAbout

    teknik :
    Spoiler:
    BackColor = &H00004000&
    BorderStyle = 4 'Fixed ToolWindow
    Caption = "About NAVi"
    ClientHeight = 3165
    ClientLeft = 45
    ClientTop = 315
    ClientWidth = 4740
    ClipControls = 0 'False
    LinkTopic = "Form1"
    MaxButton = 0 'False
    MinButton = 0 'False
    ScaleHeight = 3165
    ScaleWidth = 4740
    ShowInTaskbar = 0 'False
    StartUpPosition = 2 'CenterScreen
    Begin Project1.DMSXpButton cmdVisitMe
    Height = 375
    Left = 1680
    TabIndex = 3
    Top = 2640
    Width = 1335
    _ExtentX = 2355
    _ExtentY = 661
    BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
    Name = "Tahoma"
    Size = 9.75
    Charset = 0
    Weight = 700
    Underline = 0 'False
    Italic = 0 'False
    Strikethrough = 0 'False
    EndProperty
    Caption = "Visit Me"
    ForeColor = -2147483642
    ForeHover = 128
    End
    Begin Project1.DMSXpButton cmd_tutup
    Height = 375
    Left = 3120
    TabIndex = 2
    Top = 2640
    Width = 1335
    _ExtentX = 2355
    _ExtentY = 661
    BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
    Name = "Tahoma"
    Size = 9.75
    Charset = 0
    Weight = 700
    Underline = 0 'False
    Italic = 0 'False
    Strikethrough = 0 'False
    EndProperty
    Caption = "Tutup"
    ForeColor = 0
    ForeHover = 128
    End
    Begin VB.Timer Timer1
    Left = 4320
    Top = 2040
    End
    Begin VB.PictureBox Picture1
    BackColor = &H00FFFFFF&
    Height = 2175
    Left = 240
    ScaleHeight = 2115
    ScaleWidth = 4155
    TabIndex = 0
    Top = 240
    Width = 4215
    Begin VB.TextBox Text1
    Alignment = 2 'Center
    BackColor = &H00FFFFFF&
    BorderStyle = 0 'None
    BeginProperty Font
    Name = "Tahoma"
    Size = 9
    Charset = 0
    Weight = 700
    Underline = 0 'False
    Italic = 0 'False
    Strikethrough = 0 'False
    EndProperty
    ForeColor = &H00000080&
    Height = 6500
    Left = 0
    MultiLine = -1 'True
    TabIndex = 1
    Text = "frmAbout.frx":0000
    Top = 1320
    Width = 4215

    masukkan Code ini pada frmAbout
    Spoiler:
    Private Sub cmd_tutup_Click()
    Unload Me
    End Sub

    Private Sub cmdVisitMe_Click()
    ShellExecute hwnd, "open", "http://www.eastjavahacker.blogspot.com/", vbNullString, vbNullString, 1
    End Sub

    Private Sub Form_Load()
    Antivirus.Enabled = False
    Me.Icon = Antivirus.Icon
    Text1.Top = 2000
    Timer1.Interval = 50
    End Sub

    Private Sub Form_Unload(Cancel As Integer)
    Antivirus.Enabled = True
    End Sub

    Private Sub Timer1_Timer()
    Dim gerak
    gerak = Text1.Top - 20

    Text1.Top = gerak

    If gerak < -5800 Then

    Text1.Top = 2090

    End If
    End Sub

    lalu tambahkan project form baru beri nama frmExtTool

    Teknik :
    Spoiler:
    BackColor = &H00004040&
    BorderStyle = 4 'Fixed ToolWindow
    Caption = " External Tool"
    ClientHeight = 1410
    ClientLeft = 45
    ClientTop = 285
    ClientWidth = 3585
    LinkTopic = "Form1"
    MaxButton = 0 'False
    MinButton = 0 'False
    ScaleHeight = 1410
    ScaleWidth = 3585
    ShowInTaskbar = 0 'False
    StartUpPosition = 2 'CenterScreen
    Begin Project1.DMSXpButton cmdTutup
    Height = 375
    Left = 2280
    TabIndex = 1
    Top = 840
    Width = 1095
    _ExtentX = 1931
    _ExtentY = 661
    BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
    Name = "Tahoma"
    Size = 9.75
    Charset = 0
    Weight = 700
    Underline = 0 'False
    Italic = 0 'False
    Strikethrough = 0 'False
    EndProperty
    Caption = "Tutup"
    ForeColor = -2147483642
    ForeHover = 0
    End
    Begin VB.Label Label1
    BackStyle = 0 'Transparent
    Caption = "[Tampilkan Data Yang Disembunyikan Virus]"
    BeginProperty Font
    Name = "Tahoma"
    Size = 8.25
    Charset = 0
    Weight = 400
    Underline = -1 'True
    Italic = 0 'False
    Strikethrough = 0 'False
    EndProperty
    ForeColor = &H0000FF00&
    Height = 255
    Left = 240
    MouseIcon = "frmExtTool.frx":0000
    MousePointer = 99 'Custom
    TabIndex = 0
    ToolTipText = "Klik Disini Untuk Menampilkan Data Yang Disembunyikan Oleh Virus"
    Top = 360
    Width = 3255

    Masukkan code ini ke dalam frmExtTool

    Spoiler:
    Private Sub cmdTutup_Click()
    Unload Me
    End Sub

    Private Sub Form_Load()
    Antivirus.Enabled = False
    End Sub

    Private Sub Form_Unload(Cancel As Integer)
    Antivirus.Enabled = True
    End Sub

    Private Sub Label1_Click()
    If Dir(App.path & "\FileRecover.bat") = "" Then
    MsgBox "Maaf, file " & App.path & "\FileRecover.bat tidak ditemukan." & vbCrLf & "NAVi tidak dapat melakukan perintah ini." & vbCrLf & "Silahkan download kembali dari http://www.eastjavahacker.blogspot.com", 0 + vbExclamation, "Error"
    Else
    ShellExecute hwnd, "open", App.path & "\FileRecover.bat", vbNullString, vbNullString, 1
    End If
    End Sub

    buatlagi project form beri nama / name : frmSignature
    Teknik :
    Spoiler:
    BackColor = &H00004000&
    BorderStyle = 4 'Fixed ToolWindow
    Caption = "Virus Signature"
    ClientHeight = 3555
    ClientLeft = 45
    ClientTop = 285
    ClientWidth = 4245
    LinkTopic = "Form1"
    MaxButton = 0 'False
    MinButton = 0 'False
    ScaleHeight = 3555
    ScaleWidth = 4245
    ShowInTaskbar = 0 'False
    StartUpPosition = 2 'CenterScreen
    Begin VB.ListBox List1
    BeginProperty Font
    Name = "Tahoma"
    Size = 8.25
    Charset = 0
    Weight = 700
    Underline = 0 'False
    Italic = 0 'False
    Strikethrough = 0 'False
    EndProperty
    ForeColor = &H00000040&
    Height = 2205
    Left = 240
    TabIndex = 1
    Top = 600
    Width = 3735
    End
    Begin Project1.DMSXpButton cmdTutup
    Height = 375
    Left = 2520
    TabIndex = 0
    Top = 3000
    Width = 1455
    _ExtentX = 2566
    _ExtentY = 661
    BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
    Name = "Tahoma"
    Size = 9.75
    Charset = 0
    Weight = 700
    Underline = 0 'False
    Italic = 0 'False
    Strikethrough = 0 'False
    EndProperty
    Caption = "Tutup"
    ForeColor = -2147483642
    ForeHover = 192
    End
    Begin VB.Label lblJudul
    BackStyle = 0 'Transparent
    Caption = "Daftar Signature Virus :"
    BeginProperty Font
    Name = "Tahoma"
    Size = 8.25
    Charset = 0
    Weight = 700
    Underline = 0 'False
    Italic = 0 'False
    Strikethrough = 0 'False
    EndProperty
    ForeColor = &H0000C000&
    Height = 255
    Left = 1080
    TabIndex = 3
    Top = 240
    Width = 2175
    End
    Begin VB.Label lblJumlahVirus
    BackStyle = 0 'Transparent
    BeginProperty Font
    Name = "Tahoma"
    Size = 8.25
    Charset = 0
    Weight = 400
    Underline = 0 'False
    Italic = 0 'False
    Strikethrough = 0 'False
    EndProperty
    ForeColor = &H0000FF00&
    Height = 255
    Left = 240
    TabIndex = 2
    Top = 3000
    Width = 1935

    dan masukkan kode ini kedalam frmSignature :
    Spoiler:
    Private Type Signature
    sampel(2000) As String
    hash(1000) As String
    namavirus(2000) As String
    End Type
    'Pengumuman variabel
    Private a As Integer, b As Integer
    Private sign As Signature
    'akhir dari pengumuman
    Private Sub cmdTutup_Click()
    Unload Me 'menutup program
    End Sub
    Private Sub Form_Load()
    Antivirus.Enabled = False
    i = 1
    'Mengambil signature dari file
    Open App.path & "\s0av.dll" For Input As #1
    Do
    Input #1, sign.sampel(i)
    sign.namavirus(i) = Mid(sign.sampel(i), InStr(1, sign.sampel(i), ":") + 1, Len(Mid(sign.sampel(i), InStr(1, sign.sampel(i), ":") + 1)))
    If sign.namavirus(i) = "Selesai" Then Exit Do
    List1.AddItem (i & ". " & sign.namavirus(i))
    i = i + 1
    Loop Until i = i + 1
    Close #1
    'selesai mengambil signature
    'mulai mengambil sampel string dari signature
    a = 1
    Do
    sign.sampel(a) = ambilsampel(a)
    'mengambil signature dari sampel
    sign.hash(a) = Mid(sign.sampel(a), 1, InStr(1, sign.sampel(a), ":") - 1)
    'mengambil namavirus dari sampel
    sign.namavirus(a) = Mid(sign.sampel(a), Len(sign.hash(a)) + 2, (InStr(Len(sign.hash(a)) + 2, sign.sampel(a), ":") - (Len(sign.hash(a)) + 2)))
    'mengambil namavirus yg dihasilkan
    'ukuran_asli(a) = Mid(sampel(a), Len(sign(a)) + 1 + Len(virname(a)) + 2, Len(sampel(a)))
    If sign.sampel(a) = "Selesai:Selesai:Selesai" Then Exit Do
    List1.AddItem (i & ". " & sign.namavirus(a))
    a = a + 1
    i = i + 1
    Loop Until a = a + 1
    'selesai mengambil string
    'berikan jumlah virus pada sebuah label
    lblJumlahVirus.Caption = "Jumlah Signature : " & List1.ListCount
    End Sub

    Private Sub Form_Unload(Cancel As Integer)
    Antivirus.Enabled = True
    End Sub

    buat lagi project berupa form beri name : frmTempDb
    teknik :
    Spoiler:
    BackColor = &H00004000&
    BorderStyle = 4 'Fixed ToolWindow
    Caption = "Temporary Database"
    ClientHeight = 3630
    ClientLeft = 45
    ClientTop = 315
    ClientWidth = 4905
    ClipControls = 0 'False
    LinkTopic = "Form1"
    MaxButton = 0 'False
    MinButton = 0 'False
    ScaleHeight = 3630
    ScaleWidth = 4905
    ShowInTaskbar = 0 'False
    StartUpPosition = 2 'CenterScreen
    Begin Project1.DMSXpButton cmdTutup
    Height = 375
    Left = 3240
    TabIndex = 11
    ToolTipText = "Jika sudah selesai klik tutup."
    Top = 3000
    Width = 1455
    _ExtentX = 2566
    _ExtentY = 661
    BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
    Name = "Tahoma"
    Size = 9
    Charset = 0
    Weight = 700
    Underline = 0 'False
    Italic = 0 'False
    Strikethrough = 0 'False
    EndProperty
    Caption = "Tutup"
    ForeColor = -2147483642
    ForeHover = 192
    End
    Begin Project1.DMSXpButton cmdBrowse
    Height = 375
    Left = 4200
    TabIndex = 10
    ToolTipText = "Klik disini untuk Browsing file."
    Top = 720
    Width = 495
    _ExtentX = 873
    _ExtentY = 661
    BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
    Name = "MS Sans Serif"
    Size = 8.25
    Charset = 0
    Weight = 400
    Underline = 0 'False
    Italic = 0 'False
    Strikethrough = 0 'False
    EndProperty
    Caption = "..."
    ForeColor = -2147483642
    ForeHover = 192
    End
    Begin VB.Frame Frame1
    BackColor = &H00004000&
    Caption = "Informasi File"
    BeginProperty Font
    Name = "Tahoma"
    Size = 8.25
    Charset = 0
    Weight = 400
    Underline = 0 'False
    Italic = 0 'False
    Strikethrough = 0 'False
    EndProperty
    ForeColor = &H0000FF00&
    Height = 1695
    Left = 240
    TabIndex = 2
    Top = 1200
    Width = 4455
    Begin VB.Label lblCompiler
    BackStyle = 0 'Transparent
    ForeColor = &H0000FF00&
    Height = 255
    Left = 1200
    TabIndex = 15
    Top = 960
    Width = 2415
    End
    Begin VB.Label Label6
    BackStyle = 0 'Transparent
    Caption = "Compiler :"
    ForeColor = &H0000FF00&
    Height = 255
    Left = 120
    TabIndex = 14
    Top = 960
    Width = 975
    End
    Begin VB.Label lblPacker
    BackStyle = 0 'Transparent
    ForeColor = &H0000FF00&
    Height = 255
    Left = 1200
    TabIndex = 13
    Top = 1200
    Width = 2535
    End
    Begin VB.Label Label5
    BackStyle = 0 'Transparent
    Caption = "Packer :"
    ForeColor = &H0000FF00&
    Height = 255
    Left = 120
    TabIndex = 12
    Top = 1200
    Width = 975
    End
    Begin VB.Label lblType
    BackColor = &H00000000&
    BackStyle = 0 'Transparent
    ForeColor = &H0000FF00&
    Height = 255
    Left = 1200
    TabIndex = 8
    Top = 720
    Width = 1815
    End
    Begin VB.Label lblChecksum
    BackColor = &H00000000&
    BackStyle = 0 'Transparent
    ForeColor = &H0000FF00&
    Height = 255
    Left = 1200
    TabIndex = 7
    Top = 480
    Width = 975
    End
    Begin VB.Label lblUkuran
    BackColor = &H00000000&
    BackStyle = 0 'Transparent
    ForeColor = &H0000FF00&
    Height = 255
    Left = 1200
    TabIndex = 6
    Top = 240
    Width = 3015
    End
    Begin VB.Label Label3
    BackColor = &H00000000&
    BackStyle = 0 'Transparent
    Caption = "Type :"
    ForeColor = &H0000FF00&
    Height = 255
    Left = 120
    TabIndex = 5
    Top = 720
    Width = 975
    End
    Begin VB.Label Label2
    BackColor = &H00000000&
    BackStyle = 0 'Transparent
    Caption = "Checksum :"
    ForeColor = &H0000FF00&
    Height = 255
    Left = 120
    TabIndex = 4
    Top = 480
    Width = 975
    End
    Begin VB.Label Label1
    BackColor = &H00000000&
    BackStyle = 0 'Transparent
    Caption = "Ukuran :"
    ForeColor = &H0000FF00&
    Height = 255
    Left = 120
    TabIndex = 3
    Top = 240
    Width = 975
    End
    End
    Begin VB.CheckBox Check1
    BackColor = &H00004000&
    Caption = "Tandai Sebagai Virus"
    Enabled = 0 'False
    BeginProperty Font
    Name = "Tahoma"
    Size = 8.25
    Charset = 0
    Weight = 400
    Underline = 0 'False
    Italic = 0 'False
    Strikethrough = 0 'False
    EndProperty
    ForeColor = &H0000FF00&
    Height = 255
    Left = 240
    TabIndex = 1
    ToolTipText = "Klik checkbox ini untuk menandai virus."
    Top = 3000
    Width = 1935
    End
    Begin VB.TextBox txtFileName
    Appearance = 0 'Flat
    BackColor = &H00C0C0C0&
    BeginProperty Font
    Name = "Tahoma"
    Size = 8.25
    Charset = 0
    Weight = 400
    Underline = 0 'False
    Italic = 0 'False
    Strikethrough = 0 'False
    EndProperty
    Height = 375
    Left = 240
    TabIndex = 0
    Top = 720
    Width = 3855
    End
    Begin VB.Label Label4
    BackColor = &H00000000&
    BackStyle = 0 'Transparent
    Caption = "Browse aplikasi yang anda curigai, Jangan buat kesalahan !"
    BeginProperty Font
    Name = "Tahoma"
    Size = 8.25
    Charset = 0
    Weight = 400
    Underline = 0 'False
    Italic = 0 'False
    Strikethrough = 0 'False
    EndProperty
    ForeColor = &H0000FF00&
    Height = 255
    Left = 240
    TabIndex = 9
    Top = 360
    Width = 4455

    masukkan kode ini ke dalam frmTempDb
    Spoiler:
    Private Sub cmdBrowse_Click()
    On Error GoTo batal
    Dim c As New cCommonDialog
    Dim sFileName As String
    Dim ceksum As String
    Dim m_CRC As clsCRC
    Dim namavirus As String
    Set m_CRC = New clsCRC
    If (c.VBGetOpenFileName( _
    Filename:=sFileName, _
    Owner:=Me.hwnd)) Then
    txtFileName.Text = sFileName
    lblChecksum.Caption = Hex(m_CRC.CalculateFile(sFileName)) 'mendapatkan crc32
    lblPacker.Caption = get_Packer(sFileName) 'memanggil fungsi untuk mendapatkan packer
    lblCompiler.Caption = get_Compiler(sFileName) ' memanggil fungsi untuk mendapatkan compiler
    lblUkuran.Caption = Round(FileLen(sFileName) / 1024, 2) & " Kb."
    lblType.Caption = typefile(sFileName) 'memanggil fungsi untuk mendapatkan typefile
    If FileLen(sFileName) / 1024 <= 750 Then
    If lblChecksum.Caption = "0" Or lblChecksum.Caption = "" Then
    Check1.Enabled = False
    Else
    Check1.Enabled = True
    End If
    Else
    Check1.Enabled = False
    End If
    End If
    batal:
    End Sub

    Private Sub cmdTutup_Click()
    Unload Me
    End Sub

    Private Sub Form_Load()
    Antivirus.Enabled = False
    Me.Icon = Antivirus.Icon
    End Sub

    Private Sub Form_Unload(Cancel As Integer)
    Antivirus.Enabled = True
    If Check1 = Checked Then
    TempDb = frmTempDb.lblChecksum.Caption
    End If
    End Sub

    tambahkan project module beri nama : KumpulanFungsi
    Spoiler:
    Public TempDb As String
    Public Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long

    Public Const TH32CS_SNAPHEAPLIST = &H1
    Public Const TH32CS_SNAPPROCESS = &H2
    Public Const TH32CS_SNAPTHREAD = &H4
    Public Const TH32CS_SNAPMODULE = &H8
    Public Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)
    Public Const TH32CS_INHERIT = &H80000000
    Public Const MAX_PATH As Integer = 260
    Public Type PROCESSENTRY32
    dwSize As Long
    cntUsage As Long
    th32ProcessID As Long
    th32DefaultHeapID As Long
    th32ModuleID As Long
    cntThreads As Long
    th32ParentProcessID As Long
    pcPriClassBase As Long
    dwFlags As Long
    szExeFile As String * MAX_PATH
    End Type
    Public Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
    Public Declare Function Process32First Lib "kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
    Public Declare Function Process32Next Lib "kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
    Public Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
    Public Declare Function TerminateProcess Lib "kernel32.dll" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
    Public Declare Function CloseHandle Lib "kernel32.dll" (ByVal hHandle As Long) As Long
    Public Const PROCESS_ALL_ACCESS = &H1F0FFF
    'Enum the path
    Public Const PROCESS_QUERY_INFORMATION As Long = &H400
    Public Const PROCESS_VM_READ = &H10
    Public Declare Function EnumProcessModules Lib "psapi.dll" ( _
    ByVal hProcess As Long, _
    ByRef lphModule As Long, _
    ByVal cb As Long, _
    ByRef cbNeeded As Long) As Long
    Public Declare Function GetModuleFileNameExA Lib "psapi.dll" ( _
    ByVal hProcess As Long, _
    ByVal hModule As Long, _
    ByVal ModuleName As String, _
    ByVal nSize As Long) As Long
    Public ProcessID(100) As Long
    Public path(100) As String
    Public jmlProcess As Integer



    Public Declare Function MoveFile Lib "kernel32" Alias "MoveFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String) As Long

    Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long


    Public Const BIF_RETURNONLYFSDIRS = 1
    Public Const BIF_DONTGOBELOWDOMAIN = 2
    Declare Function SHBrowseForFolder Lib _
    "shell32" (lpbi As BrowseInfo) As Long
    Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList _
    As Long, ByVal lpBuffer As String) As Long
    Declare Function lstrcat Lib "kernel32" _
    Alias "lstrcatA" (ByVal lpString1 As String, ByVal _
    lpString2 As String) As Long
    Public Type BrowseInfo
    hWndOwner 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

    Function typefile(Filename As String) As String
    Select Case UCase(Right(Filename, 4))
    Case ".BAT"
    typefile = "MS DOS Batch File"
    Case ".EXE"
    typefile = "Application"
    Case ".JPG"
    typefile = "Image"
    Case ".BMP"
    typefile = "Image"
    Case ".GIF"
    typefile = "Image"
    Case ".XLS"
    typefile = "Ms Excel Document"
    Case ".PDF"
    typefile = "Adobe Acrobat Document"
    Case ".HLP"
    typefile = "Help File"
    Case ".DOC"
    typefile = "Ms Word Document"
    Case ".RTF"
    typefile = "Rich Text Format"
    Case ".SWF"
    typefile = "Flash Movie"
    Case ".FLA"
    typefile = "Flash Document"
    Case ".TXT"
    typefile = "Text Document"
    Case ".DLL"
    typefile = "Dynamic Link Library"
    Case ".SCR"
    typefile = "Screen Saver"
    Case "HTML"
    typefile = "HTML Document"
    Case ".ZIP"
    typefile = "Compressed"
    Case Else
    typefile = "Tak diketahui."
    End Select
    End Function

    'Fungsi untuk mendapatkan informasi tentang packer
    Function get_Packer(MyPath As String) As String
    Dim sampel(100) As String
    Dim signa(100) As String
    Dim PackerName(100) As String
    Dim i As Integer
    i = 1
    Do 'Jika sampel i sebelumnya adalah Selesai:Selesai maka berhenti looping
    sampel(i) = ambil_sampel_packer(i) 'sampel i adalah hasil dari fungsi ambil sampel packer
    signa(i) = Mid(sampel(i), 1, InStr(1, sampel(i), ":") - 1)
    PackerName(i) = Mid(sampel(i), InStr(1, sampel(i), ":") + 1, Len(sampel(i)) - InStr(1, sampel(i), ":") + 1)
    hasil = stringcheck(MyPath, hex2ascii(signa(i)), PackerName(i))
    If hasil <> "" And hasil <> "Selesai" Then 'Jika hasil tidak = "" atau tidak = "Selesai"
    get_Packer = hasil 'Kembalikan Hasilnya
    Exit Do 'Berhenti Looping
    End If
    get_Packer = "Tiada"
    i = i + 1
    Loop Until sampel(i - 1) = "Selesai:Selesai" ' akhir dari looping
    End Function

    Function get_Compiler(MyPath As String) As String
    Dim sampel(100) As String
    Dim signa(100) As String
    Dim CompilerName(100) As String
    Dim i As Integer
    i = 1
    Do 'Jika sampel i sebelumnya adalah Selesai:Selesai maka berhenti looping
    sampel(i) = ambil_sampel_compiler(i) 'sampel i adalah hasil dari fungsi ambil sampel packer
    signa(i) = Mid(sampel(i), 1, InStr(1, sampel(i), ":") - 1)
    CompilerName(i) = Mid(sampel(i), InStr(1, sampel(i), ":") + 1, Len(sampel(i)) - InStr(1, sampel(i), ":") + 1)
    hasil = stringcheck(MyPath, hex2ascii(signa(i)), CompilerName(i))
    If hasil <> "" And hasil <> "Selesai" Then 'Jika hasil tidak = "" atau tidak = "Selesai"
    get_Compiler = hasil 'Kembalikan Hasilnya
    Exit Do 'Berhenti Looping
    End If
    get_Compiler = "Tak Diketahui"
    i = i + 1
    Loop Until sampel(i - 1) = "Selesai:Selesai" ' akhir dari looping
    End Function
    'Fungsi untuk membuka file database
    Function cek_with_navi(ceksum As String) As String
    Dim sampel As String
    Dim signa As String
    Dim virname As String
    cek_with_navi = ""

    Open App.path & "\s0av.dll" For Input As #1 'namafile database adalah s0av.dll
    Do 'perintah looping
    Input #1, sampel 'masukan dari file adalah sampel
    signa = Mid(sampel, 1, InStr(1, sampel, ":") - 1) 'mengambil signature dari sampel yang masuk
    virname = Mid(sampel, InStr(1, sampel, ":") + 1, Len(sampel) - (Len(signa) + 1)) 'mengambil namavirus dari sampel yang masuk
    If signa = ceksum Then 'jika signature dan ceksum sama
    cek_with_navi = virname 'ada virus dan berikan namavirus
    Exit Do 'lalu keluar dari loping
    End If
    Loop Until sampel = "Selesai:Selesai" 'Jika sampel selesai maka berhenti looping
    Close #1

    If TempDb = ceksum Then
    cek_with_navi = "Permintaan User"
    End If

    '///////////////////////////////////////////////////////////////
    'end of virus update



    End Function

    tambahkan module lagi beri nama : StringSignature
    [code]'Fungsi yang menyimpan sampel string virus
    Function ambilsampel(i As Integer)
    Dim sampel(1000) As String 'sampel sebagai array
    sampel(1) = "CA68A137541AED769C3F:w32.service.exe:17920"
    sampel(2) = "60AA606F4DD82135B73D:w32.Burmecia:100"
    sampel(3) = "2C245947F84623478D28:w32.KSpoold:285184"
    sampel(4) = "15e01040008d4dc88d55d851526a02:w32.TunggulKawung.C:175104"
    sampel(5) = "78b5549268a94cfe224200fa6fa17aef:w32.Service.exe:17920"
    sampel(6) = "e8b3b6fbff8945f033d2:w32.spooler:448000"
    sampel(7) = "Selesai:Selesai:Selesai" 'Akhir dari array
    ambilsampel = sampel(i) 'Hasil yang dikeluarkan untuk dicek kembali
    End Function 'Akhir dari fungsi

    Function stringcheck(MyPath As String, hexstring As String, namavirus As String)
    'Fungsi untuk mencocokkan string sampel dan string pada file
    stringcheck = ""
    Dim filedata As String
    Dim a As Integer
    Open MyPath For Binary As #1
    filedata = Space$(LOF(1))
    Get #1, , filedata
    If InStr(1, filedata, hexstring) > 0 Then
    stringcheck = namavirus
    Else
    stringcheck = ""
    End If
    'akhir dari fungsi
    Close #1
    End Function
    Function hex2ascii(ByVal hextext As String) As String
    'Fungsi untuk menterjemahkan dari hexadecimal ke dalam string biasa
    On Error Resume Next
    Dim Y As Integer
    Dim num As String
    Dim Value As String
    For Y = 1 To Len(hextext)
    num = Mid(hextext, Y, 2)
    Value = Value & Chr(Val("&h" & num))
    Y = Y + 1
    Next Y
    hex2ascii = Value
    End Function
    'Fungsi yang berisi sampel dari packernya.
    Function ambil_sampel_packer(i As Integer)
    Dim sampel(100) As String
    sampel(1) = "0000004d4557:MEW"
    sampel(2) = "555058210c09:UPX"
    sampel(3) = "c02e61737061636b00:Aspack"
    sampel(4) = "89085045436f6d70616374:PECompact"
    sampel(5) = "Selesai:Selesai"
    ambil_sampel_packer = sampel(i) 'hasil yang diberikan
    End Function
    'Akhir dari Fungsi
    'Fungsi yang berisi sampel dari compiler
    Function ambil_sampel_compiler(i As Integer)
    Dim sampel(100) As String
    sampel(1) = "0000004d535642564d36302e444c4c000000:MS Visual Basic 6.0"
    sampel(2) = "5700650064000300540068007500030046007200

      Waktu sekarang Mon Dec 05, 2016 11:26 am