Perhatikan langka berikut :
Pastikan anda membuat harus sama dengan teknik di bwh ini :
Quote: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:
Code:
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 Sublalu buat lagi sebuah form dengan mengklik add -> project -> form
berikan name form2 frmAbout
teknik :
Quote: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
Code:
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 Sublalu tambahkan project form baru beri nama frmExtTool
Teknik :
Quote: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
Code:
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 Subbuatlagi project form beri nama / name : frmSignature
Teknik :
Quote: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 :
Code:
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 Subbuat lagi project berupa form beri name : frmTempDb
teknik :
Quote: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
Code:
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 Subtambahkan project module beri nama : KumpulanFungsi
Code:
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 Functiontambahkan 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
DOWNLOAD DISINI!
