Kisah 1001 Kelereng

Makin tua, aku makin menikmati Sabtu pagi. Mungkin karena adanya keheningan sunyi senyap sebab aku yang pertama bangun pagi, atau mungkin juga karena tak terkira gembiraku sebab tak usah masuk kerja. Apapun alasannya, beberapa jam pertama Sabtu pagi amat menyenangkan.

Beberapa minggu yang lalu, aku agak memaksa diriku ke dapur dengan membawa secangkir kopi hangat di satu tangan dan koran pagi itu di tangan lainnya. Apa yang biasa saya lakukan di Sabtu pagi, berubah menjadi saat yang tak terlupakan dalam hidup ini. Begini kisahnya.

Aku keraskan suara radioku untuk mendengarkan suatu acara Bincang-bincang Sabtu Pagi. Aku dengar seseorang agak tua dengan suara emasnya. Ia sedang berbicara mengenai seribu kelereng kepada seseorang di telpon yang dipanggil “Tom”. Aku tergelitik dan duduk ingin mendengarkan apa obrolannya.


“Dengar Tom, kedengarannya kau memang sibuk dengan pekerjamu. Aku yakin mereka menggajimu cukup banyak, tapi kan sangat sayang sekali kau harus meninggalkan rumah dan keluargamu terlalu sering. Sulit kupercaya kok ada anak muda yang harus bekerja 60 atau 70 jam seminggunya untuk memenuhi kebutuhan sehari-hari. Untuk menonton pertunjukan tarian putrimu pun kau tak sempat”.

Ia melanjutkan : “Biar kuceritakan ini, Tom, sesuatu yang membantuku mengatur dan menjaga prioritas apa yang yang harus kulakukan dalam hidupku”.

Lalu mulailah ia menerangkan teori “seribu kelereng” nya.” Begini Tom, suatu hari aku duduk-duduk dan mulai menghiitung-hitung. Kan umumnya orang rata-rata hidup 75 tahun. Ya aku tahu, ada yang lebih dan ada yang kurang, tapi secara rata-rata umumnya kan sekitar 75 tahun. Lalu, aku kalikan 75 ini dengan 52 dan mendapatkan angka 3900 yang merupakan jumlah semua hari Sabtu yang rata-rata dimiliki seseorang selama hidupnya. Sekarang perhatikan benar-benar Tom, aku mau beranjak ke hal yang lebih penting”.

“Tahu tidak, setelah aku berumur 55 tahun baru terpikir olehku semua detail ini”, sambungnya, “dan pada saat itu aku kan sudah melewatkan 2800 hari Sabtu. Aku terbiasa memikirkan, andaikata aku bisa hidup sampai 75 tahun, maka buatku cuma tersisa sekitar 1000 hari Sabtu yang masih bisa kunikmati”.

“Lalu aku pergi ketoko mainan dan membeli tiap butir kelereng yang ada. Aku butuh mengunjungi tiga toko, baru bisa mendapatkan 1000 kelereng itu. Kubawa pulang, kumasukkan dalam sebuah kotak plastik bening besar yang kuletakkan di tempat kerjaku, di samping radio. Setiap Sabtu sejak itu, aku selalu ambil sebutir kelereng dan membuangnya”.

“Aku alami, bahwa dengan mengawasi kelereng-kelereng itu menghilang, aku lebih memfokuskan diri pada hal-hal yang betul-betul penting dalam hidupku. Sungguh, tak ada yang lebih berharga daripada mengamati waktumu di dunia ini menghilang dan berkurang, untuk menolongmu membenahi dan meluruskan segala prioritas hidupmu”.

“Sekarang aku ingin memberikan pesan terakhir sebelum kuputuskan teleponmu dan mengajak keluar istriku tersayang untuk sarapan pagi. Pagi ini, kelereng terakhirku telah kuambil, kukeluarkan dari kotaknya. Aku berfikir, kalau aku sampai bertahan hingga Sabtu yang akan datang, maka Allah telah meberi aku dengan sedikit waktu tambahan ekstra untuk kuhabiskan dengan orang-orang yang kusayangi”.

“Senang sekali bisa berbicara denganmu, Tom. Aku harap kau bisa melewatkan lebih banyak waktu dengan orang-orang yang kau kasihi, dan aku berharap suatu saat bisa berjumpa denganmu. Selamat pagi!”

Saat dia berhenti, begitu sunyi hening, jatuhnya satu jarumpun bisa terdengar ! Untuk sejenak, bahkan moderator acara itupun membisu. Mungkin ia mau memberi para pendengarnya, kesempatan untuk memikirkan segalanya. Sebenarnya aku sudah merencanakan mau bekerja pagi itu, tetapi aku ganti acara, aku naik ke atas dan membangunkan istriku dengan sebuah kecupan.

“Ayo sayang, kuajak kau dan anak-anak ke luar, pergi sarapan”. “Lho, ada apa ini…?”, tanyanya tersenyum. “Ah, tidak ada apa-apa, tidak ada yang spesial”, jawabku, “Kan sudah cukup lama kita tidak melewatkan hari Sabtu dengan anak-anak ? Oh ya, nanti kita berhenti juga di toko mainan ya? Aku butuh beli kelereng.”

Sumber: Unknown (Tidak Diketahui)
Dikutip dari Indonesian groups

Dari setiap satu kelereng yang telah terbuang, apakah yang telah anda dapatkan ?

Apakah ……..
kesedihan
keraguan
kebosanan
rasa marah
putus asa
hambatan
permusuhan
pesimis
kegagalan ?

ataukah …….
kebahagiaan
kepercayaan
antusias
cinta kasih
motivasi
peluang
persahabatan
optimis
kesuksesan ?

Waktu akan berlalu dengan cepat. Tidak banyak kelereng yang tersisa dalam kantong anda saat ini. Gunakan secara bijak untuk memberikan kebahagiaan yang lebih baik bagi anda sendiri, keluarga, dan lingkungan anda.

Tutor membuat antivirus dri VB6

lngsung aja

dsni kita membuat antivirus dgn VB6

-> Teknik checksum
antivirus ini tidak menggunakan teknik scan menggunakan CRC32 melainkan menggunakan teknik READ BYTE langsung dari tubuh virus/worm nya

"Mengapa aye menerapkan teknik ini ?
tentu saja karena waktu scan akan lebih cepat daripada menggunakan CRC32,akurat pada saat pendeteksian & menghemat penggunaan string agar ukuran antivirus nya tidak terlalu besar

-> Fitur karantina file yang terdeteksi
"Dengan adanya fitur ini user tidak perlu takut file nya akan terhapus,karena dengan menggunakan fitur ini,file akan dikarantina oleh antivirus ke dalam suatu folder dan file yang terdeteksi tidak akan bisa di jalankan/di eksekusi"

-> Fitur Heuristic
"Heuristic dalam dunia antivirus berarti mendapatkan virus/worm baru"
pada antivirus ini akan diterapkan 2 teknik heuristic yaitu :

1. Heuristic Icon
Hampir rata-rata semua virus lokal menggunakan icon seperti icon Office word,winamp,Icon Folder yang bertujuan agar user awam mengklik file virus tersebut,
dengan teknik ini antivirus dapat melihat mana file virus yang menyamar dengan icon palsu atau file asli yang tidak terinfeksi virus

2. Heuristic VBS
Dengan teknik ini antivirus mampu membaca source dari file VBS yang biasa di pakai virus,
antivirus akan mencocokan source yang ada pada database dengan source yang terdapat pada virus,jika cocok maka akan langsung di anggap virus

Itu sedikit penjelasan tentang antivirus yang akan kita buat sekarang,
yuk langsung saja kita mulai membuat antivirus nya
aye akan berikan source code fullnya pada akhir postingan

-------------------------------------------
Author : Dias Taufik Rahman a.k.a mydisha
Compiller : Microsoft Visual Basic 6.0
Program Type : Antivirus
Source Code : Yes
-------------------------------------------

1.Buka program microsoft visual basic 6.0 -> Standard EXE -> OK
maka akan tampil form baru sesuai dengan gambar di bawah,desain form sesuai keinginan anda

Beri nama form tersebut : frmUtama

2.Setelah form selesai di rubah namanya tambahkan component Mscomctl.Ocx dengan cara
Klik Project -> Components -> Microsoft Windows Common Controls 6.0 -> lalu klik OK

3.Setelah component sukses di tambahkan langkah selanjutnya adalah menambah Command Button,Textbox,Listview,Picture Box
disini aye menggunakan desain yang sangat sederhana,desain bisa anda rubah sendiri sesuai kreatifitas anda ^^

- Tambahkan Listview kedalam form dan beri nama lvScan
yg da lingkaran merah adalah listview yang telah di tambahkan ke dalam form.

setelah itu setting listview dengan cara
Klik Listview -> Disebelah kanan bawah ada kotak properties -> Custom

Lalu pada tab Column Headers klik insert column
- Column 1 beri nama : Virus Name
- Column 2 beri nama : Path
- Column 3 beri nama : Checksum Virus
- Column 4 beri nama : Status Virus
lalu klik Ok

Tambahkan picture box buat picture box itu sekecil mungkin dan beri nama sIcon
Setting :
Appearance : Flat
Auto Redraw : True
Border Style : None
Visible : False

Tambahkan Textbox ke dalam form dengan nama txtPath
Setting :
Appearance : Flat
Border Style : None

Tambahkan Command Button dengan nama cmdBrowse di samping Textbox yang telah di buat tadi
Setting :
Caption : ...

Masukan Code ini ke dalam cmdBrowse

Code:
Dim Pathnya As String
Pathnya = ""
Pathnya = BrowseFolder("Pilih folder yang akan di Scan:", Me)
If Pathnya <> "" Then
txtPath.Text = Pathnya
End If

Code di atas berfungsi untuk membuka kotak dialog yang berisi path" yang ada di dalam komputer lalu mencetaknya ke dalam textbox yang bernama txtPath

Tambahkan label dengan nama default
Setting :
Caption : Dir Scanned

Tambahkan label dengan nama lblDirScan
Setting :
Caption : 0

Tambahkan label dengan nama default
Setting :
Caption : Detected

Tambahkan label dengan nama lblFileDet
Setting :
Caption : 0

Tambahkan label dengan nama default
Setting :
Caption : File Scanned

Tambahkan label dengan nama lblFileScan
Setting :
Caption : 0

Tambahkan Textbox dengan nama txtFileScan
Setting :
Multiline : True
Scroll Bar : 2-Vertical

Tambahkan Command Button dengan nama cmdScan
Setting :
Caption : &Scan

Code:
If cmdScan.Caption = "Scan" Then
Pathnya = txtPath.Text
If Mid(Pathnya, 2, 1) <> ":" Or Pathnya = "" Then
MsgBox "Direktori Tidak Ditemukan", vbCritical, "Error"
Exit Sub
Else
lvScan.Enabled = False
cmdEnable False, False, False
clear_log
cmdScan.Caption = "Stop"
StopScan = False
FindFilesEx txtPath.Text, CBool(chkSubDir.Value)
MsgBox "Scan finished !" & vbNewLine & vbNewLine & "Total Dir Scanned = " & lblDirScan.Caption & _
vbNewLine & "Total File Scanned = " & lblFileScan.Caption & vbNewLine & "Total File Detected = " & lblFileDet.Caption, vbInformation, "Finish"
If lblFileDet.Caption <> "0" Then
cmdEnable True, True, True
Else
cmdEnable False, False, True
End If
lvScan.Enabled = True
cmdScan.Caption = "Scan"
End If
Else
cmdScan.Caption = "Scan"
StopScan = True
End If
fungsi kode di atas adalah untuk memulai scan pada antivirus

Tambahkan Command Button dengan nama cmdAction
Setting :
Caption : &Delete

Tambahkan Command Button dengan nama cmdAction
Setting :
Caption : &Quarantine

Tambahkan Command Button dengan nama cmdViewQ
Setting :
Caption : &View Quarantine File

Tambahkan Command Button dengan nama cmdAction
Setting :
Caption : &Delete

Tambahkan kode ini di dalamnya

Code:
Dim DftrFile As String
DftrFile = GetSelected(lvScan)
If DftrFile = "" Then
MsgBox "No Detected File(s) Selected", vbCritical, ""
Exit Sub
End If
Select Case Index
Case 0
clean = Action(DftrFile, lvScan, "D")
MsgBox clean & " File(s) has been deleted"
Case 1
clean = Action(DftrFile, lvScan, "Q")
MsgBox clean & " File(s) has been quarantine"
End Select
Fungsi di atas adalah fungsi untuk menghapus/mengkarantina file yang terdeteksi

Tambahkan Command Button dengan nama cmdAction
Setting :
Caption : &Quarantine

Tambahkan Command Button dengan nama cmdViewQ
Setting :
Caption : &View Quarantine File

Lalu masukan code ini ke dalamnya

Code:
frmQuarantine.Show , Me
frmUtama.Enabled = False
Code di atas berfungsi untuk memunculkan form quarantine dan meng enabled form utama

nah selesai untuk memasukan control ke dalam formnya

lalu klik kanan pada form masukan kode di bawah ini

Code:
Private Sub lvScan_ItemCheck(ByVal Item As MSComctlLib.ListItem)
UnSelect lvScan, "Di Karantina"
UnSelect lvScan, "Di Hapus"
End Sub

Private Function cmdEnable(hapus As Boolean, Quarantine As Boolean, openQuarantine As Boolean)
cmdAction(0).Enabled = hapus
cmdAction(1).Enabled = Quarantine
cmdViewQ.Enabled = openQuarantine
End Function

Private Function clear_log()
lblDirScan.Caption = 0
lblFileScan.Caption = 0
lblFileDet.Caption = 0
lvScan.ListItems.Clear
jumlahDir = 0
jumlahFile = 0
jumlahVirus = 0
End Function


lalu di Form_load() masukan kode ini

Code:
On Error Resume Next
MkDir "Quarantine"
BuildDatabase

Lalu buatlah 1 module dengan nama modAPI

Lalu tambahkan code di bawah ini

Code:
Public Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Public Declare Function PathIsDirectory Lib "shlwapi.dll" Alias "PathIsDirectoryA" (ByVal pszPath As String) As Long
Public Declare Function CopyFile Lib "kernel32.dll" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
Public Declare Function MoveFile Lib "kernel32.dll" Alias "MoveFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String) As Long
Public Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
Public Declare Function PathFileExists Lib "shlwapi.dll" Alias "PathFileExistsA" (ByVal pszPath As String) As Long
Public Declare Function GetSystemDirectory Lib "kernel32.dll" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Declare Function GetWindowsDirectory Lib "kernel32.dll" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Public Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Private Declare Function RealizePalette Lib "gdi32" (ByVal hDC As Long) As Long
Public Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Public Declare Function VirtualAlloc Lib "kernel32" (lpAddress As Any, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Public Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long
Public Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As Any) As Long
Public Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Public Declare Function SetEndOfFile Lib "kernel32" (ByVal hFile As Long) As Long

Public Const GENERIC_READ = &H80000000
Public Const GENERIC_WRITE = &H40000000
Public Const FILE_SHARE_READ = &H1
Public Const OPEN_EXISTING = 3
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const INVALID_HANDLE_VALUE = -1
Public Const FILE_END = 2
Public Const FILE_BEGIN = 0
Public Const FILE_CURRENT = 1
Public Const LWA_COLORKEY = &H1
Public Const GWL_EXSTYLE = (-20)
Public Const WS_EX_LAYERED = &H80000
Public Const MAX_PATH = 260
Public Const SW_SHOWNORMAL = 1

Public Type FileTime
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Public Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FileTime
ftLastAccessTime As FileTime
ftLastWriteTime As FileTime
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type

Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

'untuk browse folder
Public Function BrowseFolder(ByVal aTitle As String, ByVal aForm As Form) As String
Dim bInfo As BROWSEINFO
Dim rtn&, pidl&, path$, pos%
Dim BrowsePath As String
bInfo.hOwner = aForm.hWnd
bInfo.lpszTitle = aTitle
bInfo.ulFlags = &H1
pidl& = SHBrowseForFolder(bInfo)
path = Space(512)
t = SHGetPathFromIDList(ByVal pidl&, ByVal path)
pos% = InStr(path$, Chr$(0))
BrowseFolder = Left(path$, pos - 1)
If Right$(Browse, 1) = "\" Then
BrowseFolder = BrowseFolder
Else
BrowseFolder = BrowseFolder + "\"
End If
If Right(BrowseFolder, 2) = "\\" Then BrowseFolder = Left(BrowseFolder, Len(BrowseFolder) - 1)
If BrowseFolder = "\" Then BrowseFolder = ""
End Function

Public Function StripNulls(ByVal OriginalStr As String) As String
If (InStr(OriginalStr, Chr$(0)) > 0) Then
OriginalStr = Left$(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
End If
StripNulls = OriginalStr
End Function

'fungsi untuk menentukan file script atau bukan
Public Function IsScript(Filename As String) As Boolean
IsScript = False
ext = Split("|vbs|vbe", "|")
For i = 1 To UBound(ext)
If LCase(Right(Filename, 3)) = LCase(ext(i)) Then IsScript = True
Next
End Function

Code di atas adalah Fungsi API yang di butuhkan untuk antivirus

Buat 1 module dengan nama modChecksum
masukan code di bawah ini

Code:
Public Function GetChecksum(FilePath As String) As String
Dim CheckSum(1 To 2) As String
CheckSum(1) = CalcBinary(FilePath, 499, 4500)
CheckSum(2) = CalcBinary(FilePath, 499, 4000)
GetChecksum = CheckSum(1) & CheckSum(2)
End Function
Public Function CalcBinary(ByVal lpFileName As String, ByVal lpByteCount As Long, Optional ByVal StartByte As Long = 0) As String
On Error GoTo err
Dim Bin() As Byte
Dim ByteSum As Long
Dim i As Long
ReDim Bin(lpByteCount) As Byte
Open lpFileName For Binary As #1
If StartByte = 0 Then
Get #1, , Bin
Else
Get #1, StartByte, Bin
End If
Close #1
For i = 0 To lpByteCount
ByteSum = ByteSum + Bin(i) ^ 2
Next i
CalcBinary = Hex$(ByteSum)
Exit Function
err:
CalcBinary = "00"
End Function

potongan code di atas di gunakan untuk meng kalkulasi checksum


buat 1 module lagi dengan nama modDatabase
lalu tambahkan code di bawah ini

Code:
Public VirusDB(5), IconDB(48), Bahaya(5) As String
Public Sub BuildDatabase()
Call Checksum_DB
Call IconCompare_DB
Call Script_DB
End Sub
Private Sub Checksum_DB()
VirusDB(1) = "Alman.A|8911D290F723"
VirusDB(2) = "Malingsi.A|A6292EA60230"
VirusDB(3) = "Conficker.A|9EC112ABB2F3"
VirusDB(4) = "N4B3.A|B5CCD36CDB98"
VirusDB(5) = "N4B3.B|A1FE6D6DBE07"
End Sub
Public Sub IconCompare_DB()
On Error Resume Next
IconDB(1) = "20938B2"
IconDB(2) = "19F4ED6"
IconDB(3) = "133BE0B"
IconDB(4) = "18EDEAE"
IconDB(5) = "1EF89C2"
IconDB(6) = "1C915FF"
IconDB(7) = "24563C4"
IconDB(8) = "1B2DB74"
IconDB(9) = "208EA72"
IconDB(10) = "22A064D"
IconDB(11) = "19B64EE"
IconDB(12) = "1D4B7E1"
IconDB(13) = "2087762"
IconDB(14) = "29C7258"
IconDB(15) = "1B18705"
IconDB(16) = "1B5FCAB"
IconDB(17) = "126D4CF"
IconDB(18) = "1C58E5C"
IconDB(19) = "15D7730"
IconDB(20) = "1FB82B7"
IconDB(21) = "112763E"
IconDB(22) = "2165AF9"
IconDB(23) = "25F46BE"
IconDB(24) = "206556B"
IconDB(25) = "22A8D69"
IconDB(26) = "19237F8"
IconDB(27) = "15022B4"
IconDB(28) = "1D8B4EB"
IconDB(29) = "1DBC1EA"
IconDB(30) = "2333F5D"
IconDB(31) = "1F37C2F"
IconDB(32) = "1C9CCA4"
IconDB(33) = "1DFDFB4"
IconDB(34) = "1C1283E"
IconDB(35) = "1F6598C"
IconDB(36) = "27F4C1A"
IconDB(37) = "22F92E0"
IconDB(38) = "191DBDC"
IconDB(39) = "27BFE4A"
IconDB(40) = "20E0907"
IconDB(46) = "2FA4C88"
IconDB(47) = "25AA630"
IconDB(48) = "1DE28E2"
End Sub
Public Sub Script_DB()
On Error Resume Next
Bahaya(1) = "Scripting.FileSystemObject|Wscript.ScriptFullName|WScript.Shell|.regwrite|.copy"
Bahaya(2) = "Wscript.ScriptFullName|createobject|strreverse|.regwrite"
Bahaya(3) = "createobject|Wscript.ScriptFullName|.regwrite|[autorun]"
Bahaya(4) = "createobject|Wscript.ScriptFullName|specialfolder|.regwrite"
Bahaya(5) = "chr(asc(mid(|createobject|Wscript.ScriptFullName|.GetFolder|.RegWrite"
End Sub

potongan code di atas adalah database pada antivirusnya

buat lagi 1 buah module dengan nama modQuar
masukan code yang ada di bawah ini

Code:
Option Explicit
Public Function EncodeFile(SourceFile As String, DestFile As String)
Dim ByteArray() As Byte, Filenr As Integer
Filenr = FreeFile
Open SourceFile For Binary As #Filenr
ReDim ByteArray(0 To LOF(Filenr) - 1)
Get #Filenr, , ByteArray()
Close #Filenr
Call Coder(ByteArray())
If (PathFileExists(DestFile)) <> 0 Then DeleteFile DestFile
Open DestFile For Binary As #Filenr
Put #Filenr, , ByteArray()
Close #Filenr
End Function
Public Function DecodeFile(SourceFile As String, DestFile As String)
Dim ByteArray() As Byte, Filenr As Integer
Filenr = FreeFile
Open SourceFile For Binary As #Filenr
ReDim ByteArray(0 To LOF(Filenr) - 1)
Get #Filenr, , ByteArray()
Close #Filenr
Call DeCoder(ByteArray())
If (PathFileExists(DestFile)) <> 0 Then DeleteFile DestFile
Open DestFile For Binary As #Filenr
Put #Filenr, , ByteArray()
Close #Filenr
End Function
Private Sub Coder(ByteArray() As Byte)
Dim x As Long
Dim Value As Integer
Value = 0
For x = 0 To UBound(ByteArray)
Value = Value + ByteArray(x)
If Value > 255 Then Value = Value - 256
ByteArray(x) = Value
Next
End Sub
Private Sub DeCoder(ByteArray() As Byte)
Dim x As Long
Dim Value As Integer
Dim newValue As Integer
newValue = 0
For x = 0 To UBound(ByteArray)
Value = newValue
newValue = ByteArray(x)
Value = ByteArray(x) - Value
If Value < 0 Then Value = Value + 256
ByteArray(x) = Value
Next
End Sub

Code di atas adalah code untuk enkripsi/dekripsi pada virus yang akan di karantina

Buat lagi 1 module dengan nama modHeuristic
lalu masukan code di bawah ini

Code:
Private Declare Function ExtractIconEx Lib "shell32.dll" Alias "ExtractIconExA" (ByVal lpszFile As String, ByVal nIconIndex As Long, ByRef phiconLarge As Long, ByRef phiconSmall As Long, ByVal nIcons As Long) As Long
Private Declare Function DestroyIcon Lib "user32.dll" (ByVal hIcon As Long) As Long
Private Declare Function DrawIconEx Lib "user32" (ByVal hDC As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As Boolean
Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExefileName As String, ByVal nIconIndex As Long) As Long
Private Const DI_MASK = &H1
Private Const DI_IMAGE = &H2
Private Const DI_NORMAL = &H3
Private Const DI_COMPAT = &H4
Private Const DI_DEFAULTSIZE = &H8
Private Const SHGFI_DISPLAYNAME = &H200
Private Const SHGFI_EXETYPE = &H2000
Private Const SHGFI_SYSICONINDEX = &H4000
Private Const SHGFI_LARGEICON = &H0
Private Const SHGFI_SMALLICON = &H1
Private Const ILD_TRANSPARENT = &H1
Private Const SHGFI_SHELLICONSIZE = &H4
Private Const SHGFI_TYPENAME = &H400
Private Const BASIC_SHGFI_FLAGS = SHGFI_TYPENAME Or SHGFI_SHELLICONSIZE Or SHGFI_SYSICONINDEX Or SHGFI_DISPLAYNAME Or SHGFI_EXETYPE
Private SIconInfo As SHFILEINFO
Private SectionHeaders() As IMAGE_SECTION_HEADER
Dim i As Integer
Dim j As Integer
Public Function CekHeuristic(Filename As String)
CekHeuristic = ""
On Error GoTo hError
Dim hFile As Long, bRW As Long
Dim DOSheader As IMAGE_DOS_HEADER
Dim NTHeaders As IMAGE_NT_HEADERS
Dim Filedata As String
DOS_HEADER_INFO = ""
NT_HEADERS_INFO = ""
hFile = CreateFile(Filename, ByVal (GENERIC_READ Or GENERIC_WRITE), FILE_SHARE_READ, ByVal 0&, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, ByVal 0)
ReadFile hFile, DOSheader, Len(DOSheader), bRW, ByVal 0&
SetFilePointer hFile, DOSheader.e_lfanew, 0, 0
ReadFile hFile, NTHeaders, Len(NTHeaders), bRW, ByVal 0&
If NTHeaders.Signature <> IMAGE_NT_SIGNATURE Then
If IsScript(Filename) = True Then
Open Filename For Binary As #1
Filedata = Space$(LOF(1))
Get #1, , Filedata
Close #1
CekHeuristic = CekHeur(Filedata)
End If
Exit Function
End If
CekHeuristic = CekIconBinary(Filename)
hError:
End Function
Private Function CekHeur(Data As String)
Dim hsl, asl As Integer
strasli = LCase(Replace(Data, vbNewLine, "$"))
For i = 1 To UBound(Bahaya)
hsl = 0
strData = Split(Bahaya(i), "|")
asl = 0
For k = 0 To UBound(strData)
xxx = LCase(strData(k))
If InStr(strasli, xxx) > 0 Then hsl = hsl + 1
asl = asl + 1
Next
If hsl = asl Then
CekHeur = "Malicious-Script"
Exit Function
End If
Next
CekHeur = ""
End Function
Private Function CekIconBinary(PathFile As String)
Dim q As Integer
Dim IconIDNow As String
CekIconBinary = ""
IconIDNow = CalcIcon(PathFile)
If IconIDNow = "" Then Exit Function
For q = 1 To UBound(IconDB)
If IconDB(q) = IconIDNow Then
CekIconBinary = "Malicious-Icon"
Exit Function
End If
Next q
End Function
Private Function CalcBinary(ByVal lpFileName As String, ByVal lpByteCount As Long, Optional ByVal StartByte As Long = 0) As String
Dim Bin() As Byte
Dim ByteSum As Long
Dim i As Long
ReDim Bin(lpByteCount) As Byte
Open lpFileName For Binary As #1
If StartByte = 0 Then
Get #1, , Bin
Else
Get #1, StartByte, Bin
End If
Close #1
For i = 0 To lpByteCount
ByteSum = ByteSum + Bin(i) ^ 2
Next i
CalcBinary = Hex$(ByteSum)
End Function
Private Function CalcIcon(ByVal lpFileName As String) As String
Dim PicPath As String
Dim ByteSum As String
Dim IconExist As Long
Dim hIcon As Long
IconExist = ExtractIconEx(lpFileName, 0, ByVal 0&, hIcon, 1)
If IconExist <= 0 Then
IconExist = ExtractIconEx(lpFileName, 0, hIcon, ByVal 0&, 1)
If IconExist <= 0 Then Exit Function
End If
frmUtama.sIcon.BackColor = vbWhite
DrawIconEx frmUtama.sIcon.hDC, 0, 0, hIcon, 0, 0, 0, 0, DI_NORMAL
DestroyIcon hIcon
PicPath = Environ$("windir") & "\tmp.tmp"
SavePicture frmUtama.sIcon.Image, PicPath
ByteSum = CalcBinary(PicPath, FileLen(PicPath))
DeleteFile PicPath
CalcIcon = ByteSum
End Function
Fungsi di atas adalah fungsi untuk mengecek suatu file dengan metode heuristic icon + heuristic untuk virus VBS


Buat 1 module dengan nama modIconCompare
lalu masukan code di bawah ini

Code:
Option Explicit
Private Const SHGFI_DISPLAYNAME = &H200, SHGFI_EXETYPE = &H2000, SHGFI_SYSICONINDEX = &H4000, SHGFI_LARGEICON = &H0, SHGFI_SMALLICON = &H1, SHGFI_SHELLICONSIZE = &H4, SHGFI_TYPENAME = &H400, ILD_TRANSPARENT = &H1, BASIC_SHGFI_FLAGS = SHGFI_TYPENAME Or SHGFI_SHELLICONSIZE Or SHGFI_SYSICONINDEX Or SHGFI_DISPLAYNAME Or SHGFI_EXETYPE
Public Type SHFILEINFO
hIcon As Long: iIcon As Long: dwAttributes As Long: szDisplayName As String * MAX_PATH: szTypeName As String * 80
End Type
Private Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" (ByVal pszPath As String, ByVal dwFileAttributes As Long, psfi As SHFILEINFO, ByVal cbSizeFileInfo As Long, ByVal uFlags As Long) As Long
Private Declare Function ImageList_Draw Lib "comctl32.dll" (ByVal himl As Long, ByVal i As Long, ByVal hdcDest As Long, ByVal x As Long, ByVal y As Long, ByVal flags As Long) As Long
Private shinfo As SHFILEINFO, sshinfo As SHFILEINFO
Private Declare Function DrawIconEx Lib "user32.dll" (ByVal hDC As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As Long
Private SIconInfo As SHFILEINFO

Public Enum IconRetrieve
ricnLarge = 32
ricnSmall = 16
End Enum

Public Sub RetrieveIcon(fName As String, DC As PictureBox, icnSize As IconRetrieve)
Dim hImgSmall, hImgLarge As Long
Debug.Print fName
Select Case icnSize
Case ricnSmall
hImgSmall = SHGetFileInfo(fName$, 0&, shinfo, Len(shinfo), BASIC_SHGFI_FLAGS Or SHGFI_SMALLICON)
Call ImageList_Draw(hImgSmall, shinfo.iIcon, DC.hDC, 0, 0, ILD_TRANSPARENT)
Case ricnLarge
hImgLarge& = SHGetFileInfo(fName$, 0&, shinfo, Len(shinfo), BASIC_SHGFI_FLAGS Or SHGFI_LARGEICON)
Call ImageList_Draw(hImgLarge, shinfo.iIcon, DC.hDC, 0, 0, ILD_TRANSPARENT)
End Select
End Sub
Public Function ExtractIcon(Filename As String, AddtoImageList As ImageList, PictureBox As PictureBox, PixelsXY As IconRetrieve, iKey As String) As Long
Dim SmallIcon As Long
Dim NewImage As ListImage
Dim IconIndex As Integer
On Error GoTo Load_New_Icon
If iKey <> "Application" And iKey <> "Shortcut" Then
ExtractIcon = AddtoImageList.ListImages(iKey).Index
Exit Function
End If
Load_New_Icon:
On Error GoTo Reset_Key
RetrieveIcon Filename, PictureBox, PixelsXY
IconIndex = AddtoImageList.ListImages.Count + 1
Set NewImage = AddtoImageList.ListImages.Add(IconIndex, iKey, PictureBox.Image)
ExtractIcon = IconIndex
Exit Function
Reset_Key:
iKey = ""
Resume
End Function
Public Sub GetLargeIcon(icPath$, pDisp As PictureBox)
Dim hImgLrg&: hImgLrg = SHGetFileInfo(icPath$, 0&, SIconInfo, Len(SIconInfo), BASIC_SHGFI_FLAGS Or SHGFI_LARGEICON)
ImageList_Draw hImgLrg, SIconInfo.iIcon, pDisp.hDC, 0, 0, ILD_TRANSPARENT
End Sub

kode di atas di butuhkan untuk metode heuristic icon pada antivirus

Buat 1 module dengan nama modLV
lalu masukan code di bawah ini

Code:
Public Function GetSelected(TheLV As ListView)
Dim Sel As String
For i = 1 To TheLV.ListItems.Count
If TheLV.ListItems.Item(i).Checked = True Then
Sel = Sel & "|" & TheLV.ListItems.Item(i).SubItems(1)
End If
Next
GetSelected = Sel
End Function

Public Function SelectedAll(TheLV As ListView)
For i = 1 To TheLV.ListItems.Count
TheLV.ListItems.Item(i).Checked = True
Next
End Function

Public Function SelectedNone(TheLV As ListView)
For i = 1 To TheLV.ListItems.Count
TheLV.ListItems.Item(i).Checked = False
Next
End Function

Public Function GetIndex(TheLV As ListView, Data As String) As Integer
For i = 1 To TheLV.ListItems.Count
If TheLV.ListItems.Item(i).SubItems(1) = Data Then
GetIndex = i
End If
Next
End Function

Public Function UnSelect(TheLV As ListView, Data As String)
For i = 1 To TheLV.ListItems.Count
If TheLV.ListItems.Item(i).SubItems(3) = Data Then
TheLV.ListItems.Item(i).Checked = False
End If
Next
End Function

Public Function AddDetect(TheLV As ListView, FilePath As String, VirData As String)
With TheLV
If Left(VirData, 9) <> "Malicious" Then
Set lvItm = .ListItems.Add(, , Split(VirData, "|")(0), , frmUtama.ImgSmall.ListImages(1).Index)
lvItm.SubItems(1) = FilePath
lvItm.SubItems(2) = Split(VirData, "|")(1)
lvItm.SubItems(3) = "Virus File"
Else
Set lvItm = .ListItems.Add(, , VirData, , frmUtama.ImgSmall.ListImages(1).Index)
lvItm.SubItems(1) = FilePath
lvItm.SubItems(2) = GetChecksum(FilePath)
lvItm.SubItems(3) = "Virus File"
End If
End With
End Function

Code di atas berguna untuk dengatur Listview pada saat virus terdeteksi

Buat 1 module dengan nama modPE
lalu masukan code di bawah ini

Code:
Public Type IMAGE_DOS_HEADER
e_magic As Integer
e_cblp As Integer
e_cp As Integer
e_crlc As Integer
e_cparhdr As Integer
e_minalloc As Integer
e_maxalloc As Integer
e_ss As Integer
e_sp As Integer
e_csum As Integer
e_ip As Integer
e_cs As Integer
e_lfarlc As Integer
e_ovno As Integer
e_res(1 To 4) As Integer
e_oemid As Integer
e_oeminfo As Integer
e_res2(1 To 10) As Integer
e_lfanew As Long
End Type

Public Type IMAGE_SECTION_HEADER
nameSec As String * 6
PhisicalAddress As Integer

VirtualSize As Long
VirtualAddress As Long
SizeOfRawData As Long
PointerToRawData As Long
PointerToRelocations As Long
PointerToLinenumbers As Long
NumberOfRelocations As Integer
NumberOfLinenumbers As Integer
Characteristics As Long

End Type

Public Type IMAGE_DATA_DIRECTORY
VirtualAddress As Long
size As Long
End Type

Public Type IMAGE_OPTIONAL_HEADER
Magic As Integer
MajorLinkerVersion As Byte
MinorLinkerVersion As Byte
SizeOfCode As Long
SizeOfInitializedData As Long
SizeOfUninitializedData As Long
AddressOfEntryPoint As Long
BaseOfCode As Long
BaseOfData As Long
ImageBase As Long
SectionAlignment As Long
FileAlignment As Long
MajorOperatingSystemVersion As Integer
MinorOperatingSystemVersion As Integer
MajorImageVersion As Integer
MinorImageVersion As Integer
MajorSubsystemVersion As Integer
MinorSubsystemVersion As Integer
Win32VersionValue As Long
SizeOfImage As Long
SizeOfHeaders As Long
CheckSum As Long
Subsystem As Integer
DllCharacteristics As Integer
SizeOfStackReserve As Long
SizeOfStackCommit As Long
SizeOfHeapReserve As Long
SizeOfHeapCommit As Long
LoaderFlags As Long
NumberOfRvaAndSizes As Long
DataDirectory(0 To 15) As IMAGE_DATA_DIRECTORY
End Type

Public Type IMAGE_FILE_HEADER
Machine As Integer
NumberOfSections As Integer
TimeDateStamp As Long
PointerToSymbolTable As Long
NumberOfSymbols As Long
SizeOfOptionalHeader As Integer
Characteristics As Integer
End Type

Public Type IMAGE_NT_HEADERS
Signature As Long
FileHeader As IMAGE_FILE_HEADER
OptionalHeader As IMAGE_OPTIONAL_HEADER
End Type

Public Type IMAGE_EXPORT_DIRECTORY
Characteristics As Long
TimeDateStamp As Long
MajorVersion As Integer
MinorVersion As Integer
Name As Long
Base As Long
NumberOfFunctions As Long
NumberOfNames As Long
AddressOfFunctions As Long
AddressOfNames As Long
AddressOfNameOrdinals As Long
End Type

Public Type IMAGE_IMPORT_DESCRIPTOR
OriginalFirstThunk As Long
TimeDateStamp As Long
ForwarderChain As Long
Name As Long
FirstThunk As Long
End Type

Public Type IMAGE_IMPORT_BY_NAME
Hint As Integer
Name As String * 255
End Type

Public Const IMAGE_SIZEOF_SECTION_HEADER = 40
Public Const IMAGE_DOS_SIGNATURE = &H5A4D
Public Const IMAGE_NT_SIGNATURE = &H4550
Public Const IMAGE_ORDINAL_FLAG = &H80000000

Public Enum SECTION_CHARACTERISTICS
IMAGE_SCN_LNK_NRELOC_OVFL = &H1000000 'Section contains extended relocations.
IMAGE_SCN_MEM_DISCARDABLE = &H2000000 'Section can be discarded.
IMAGE_SCN_MEM_NOT_CACHED = &H4000000 'Section is not cachable.
IMAGE_SCN_MEM_NOT_PAGED = &H8000000 'Section is not pageable.
IMAGE_SCN_MEM_SHARED = &H10000000 'Section is shareable.
IMAGE_SCN_MEM_EXECUTE = &H20000000 'Section is executable.
IMAGE_SCN_MEM_READ = &H40000000 'Section is readable.
IMAGE_SCN_MEM_WRITE = &H80000000 'Section is writeable.
End Enum

Public Enum IMAGE_DIRECTORY
IMAGE_DIRECTORY_ENTRY_EXPORT = 0 ' Export Directory
IMAGE_DIRECTORY_ENTRY_IMPORT = 1 ' Import Directory
IMAGE_DIRECTORY_ENTRY_RESOURCE = 2 ' Resource Directory
IMAGE_DIRECTORY_ENTRY_EXCEPTION = 3 ' Exception Directory
IMAGE_DIRECTORY_ENTRY_SECURITY = 4 ' Security Directory
IMAGE_DIRECTORY_ENTRY_BASERELOC = 5 ' Base Relocation Table
IMAGE_DIRECTORY_ENTRY_DEBUG = 6 ' Debug Directory
IMAGE_DIRECTORY_ENTRY_ARCHITECTURE = 7 ' Architecture Specific Data
IMAGE_DIRECTORY_ENTRY_GLOBALPTR = 8 ' RVA of GP
IMAGE_DIRECTORY_ENTRY_TLS = 9 ' TLS Directory
IMAGE_DIRECTORY_ENTRY_LOAD_CONFIG = 10 ' Load Configuration Directory
IMAGE_DIRECTORY_ENTRY_BOUND_IMPORT = 11 ' Bound Import Directory in headers
IMAGE_DIRECTORY_ENTRY_IAT = 12 ' Import Address Table
IMAGE_DIRECTORY_ENTRY_DELAY_IMPORT = 13 ' Delay Load Import Descriptors
IMAGE_DIRECTORY_ENTRY_COM_DESCRIPTOR = 14 ' COM Runtime descriptor
End Enum

code di atas berfungsi untuk pengecekan PE HEADER

buat 1 module dengan nama modScanning
lalu tambahkan code di bawah ini

Code:
Public jumlahDir As Long, jumlahFile As Long, jumlahVirus As Long
Public StopScan As Boolean

Public Function CekVirus(FilePath As String) As String
CekVirus = ""
For i = 1 To UBound(VirusDB)
If GetChecksum(FilePath) = Split(VirusDB(i), "|")(1) Then
CekVirus = VirusDB(i)
Exit Function
End If
Next
If FileLen(FilePath) / 1024 <= 512 Then
CekVirus = CekHeuristic(FilePath)
End If
End Function

Public Sub FindFilesEx(ByVal lpFolderName As String, ByVal SubDirs As Boolean)
Dim i As Long
Dim hSearch As Long, WFD As WIN32_FIND_DATA
Dim Result As Long, CurItem As String
Dim tempDir() As String, dirCount As Long
Dim RealPath As String, GetViri As String

GetViri = ""
dirCount = -1

ScanInfo = "Scan File"

If Right$(lpFolderName, 1) = "\" Then
RealPath = lpFolderName
Else
RealPath = lpFolderName & "\"
End If

hSearch = FindFirstFile(RealPath & "*", WFD)
If Not hSearch = INVALID_HANDLE_VALUE Then
Result = True
Do While Result
DoEvents
If StopScan = True Then Exit Do
CurItem = StripNulls(WFD.cFileName)
If Not CurItem = "." And Not CurItem = ".." Then
If PathIsDirectory(RealPath & CurItem) <> 0 Then
jumlahDir = jumlahDir + 1
frmUtama.lblDirScan.Caption = jumlahDir
If SubDirs = True Then
dirCount = dirCount + 1
ReDim Preserve tempDir(dirCount) As String
tempDir(dirCount) = RealPath & CurItem
End If
Else
jumlahFile = jumlahFile + 1
frmUtama.lblFileScan.Caption = jumlahFile
frmUtama.txtFileScan.Text = RealPath & CurItem
frmUtama.txtFileScan.SelStart = Len(frmUtama.txtFileScan.Text)
If WFD.nFileSizeLow > 5120 Or WFD.nFileSizeHigh > 5120 Then
GetViri = CekVirus(RealPath & CurItem)
If GetViri <> "" Then
AddDetect frmUtama.lvScan, RealPath & CurItem, GetViri
jumlahVirus = jumlahVirus + 1
frmUtama.lblFileDet.Caption = jumlahVirus
End If
End If
End If
End If
Result = FindNextFile(hSearch, WFD)
Loop
FindClose hSearch

If SubDirs = True Then
If dirCount <> -1 Then
For i = 0 To dirCount
FindFilesEx tempDir(i), True
Next i
End If
End If
End If
End Sub

Code di atas adalah code untuk scan file & folder pada antivirus

buat 1 module dengan nama modEtc
masukan code di bawah ini

Code:
Public Function Action(Data As String, TheLV As ListView, Mode As String)
Dim Filedata() As String
Dim fName, tmp, Status As String
Dim y As Integer
Filedata = Split(Data, "|")
For i = 1 To UBound(Filedata)
a = a + 1
If Mode = "Q" Then
fName = GetFileName(Filedata(i))
EncodeFile Filedata(i), AppPath & "Quarantine\" & Left$(fName, Len(fName) - Len(GetExt(Filedata(i)))) & ".avq"
AddQList TheLV, Filedata(i), Left$(fName, Len(fName) - Len(GetExt(Filedata(i)))) & ".avq"
DeleteFile Filedata(i)
Status = "Di Karantina"
ElseIf Mode = "D" Then
DeleteFile Filedata(i)
Status = "Di Hapus"
End If
y = GetIndex(TheLV, Filedata(i))
With TheLV.ListItems.Item(y)
.SubItems(3) = Status
.Checked = False
.SmallIcon = frmUtama.ImgSmall.ListImages(2).Index
End With
Next
Action = a
End Function

Public Function AddQList(TheLV As ListView, FilePath As String, Source As String)
Dim Dat As String
Dat = AppPath & "Quarantine\HN.dat"
If PathFileExists(Dat) <> 0 Then
Open Dat For Input As #1
Input #1, isi
Close #1
DeleteFile Dat
Else
isi = ""
End If
namavir = TheLV.ListItems(GetIndex(TheLV, FilePath))
If InStrRev(isi, Source, , vbTextCompare) = 0 Then
Open Dat For Output As #2
Print #2, isi & "|" & namavir & "?" & FilePath & "?" & Source
Close #2
Else
Open Dat For Output As #3
Print #3, isi
Close #3
End If
End Function

Public Function GetFileName(PathFile As String) As String
Dim i As Long
Dim DirString As Long
For i = 1 To Len(PathFile)
If Mid$(PathFile, i, 1) = "\" Then DirString = i
Next i
GetFileName = Right$(PathFile, Len(PathFile) - DirString)
End Function

Public Function GetExt(ByVal lpFileName As String)
Dim sTemp As String
Dim i As Long
sTemp = GetFileName(lpFileName)
If InStr(lpFileName, ".") Then
For i = 0 To Len(sTemp) - 1
If Mid$(sTemp, Len(sTemp) - i, 1) = "." Then
GetExt = Mid$(sTemp, Len(sTemp) - i, i)
Exit Function
End If
Next i
End If
End Function

Code di atas adalah kumpulan fungsi etc untuk scanning,karantina,delete
[/php]
sekarang tinggal cara membuat form quarantinenya

setelah form baru sudah di buat,lalu rubah nama formnya menjadi frmQuarantine

Tambah 1 buah listview dengan nama lvQ
lalu setting listview tersebut sesuai dengan gambar di bawah ini,cara setting listview sudah tertera di postingan ke #1

Tambahkan 3 buah Command button dengan nama

- cmdDelete
- cmdRestore
- cmdRestore(1)

Tambahkan code di bawha ini ke dalam Command [ cmdDelete ]

Code:
If lvQ.ListItems.Count = 0 Then Exit Sub
Dim Data() As String
If PathFileExists(Dat) <> 0 Then
Open Dat For Input As #1
Input #1, isi
Close #1
DeleteFile Dat
Else
isi = ""
End If
Data = Split(isi, "|")
For i = 1 To UBound(Data)
namafile = lvQ.SelectedItem.SubItems(2)
If namafile <> Split(Data(i), "?")(1) Then
nyu = nyu & "|" & Data(i)
End If
Next
DeleteFile AppPath & "Quarantine\" & lvQ.SelectedItem.SubItems(1)
Open Dat For Output As #2
Print #2, nyu
Close #2
MsgBox "Success Deleting File !!!", vbInformation, ""
UpdateQ

code di atas berfungsi untuk menghapus file yang telah di karantina

Masukan code di bawah ini ke Command [ cmdRestore ]

Code:

If lvQ.ListItems.Count = 0 Then Exit Sub
Select Case Index
Case 0
DecodeFile AppPath & "Quarantine\" & lvQ.SelectedItem.SubItems(1), lvQ.SelectedItem.SubItems(2)
MsgBox "File Restored to " & Chr(34) & lvQ.SelectedItem.SubItems(2) & Chr(34) & " !!!", vbInformation, ""
Case 1
sTitle = "Select path:" & vbNewLine & "Select path to restore file."
ThePath = BrowseFolder(sTitle, Me)
If ThePath <> "" Then
DecodeFile AppPath & "Quarantine\" & lvQ.SelectedItem.SubItems(1), ThePath & GetFileName(lvQ.SelectedItem.SubItems(2))
MsgBox "File Restored to " & Chr(34) & ThePath & GetFileName(lvQ.SelectedItem.SubItems(2)) & Chr(34) & " !!!", vbInformation, ""
End If
End Select

Fungsi code di atas berguna untuk me restore file kembali ke asalnya

Lalu pada Form_Load() tambahkan code di bawah ini
Code:
frmUtama.Enabled = False
Dat = AppPath & "Quarantine\HN.dat"
UpdateQ

Masukan code di bawah ini ke dalam frmQuarantine

Code:
Dim Dat As String
Private Sub UpdateQ()
lvQ.ListItems.Clear
Dim Data() As String
If PathFileExists(Dat) = 0 Then Exit Sub
Open Dat For Input As #1
Input #1, isi
Close #1
Data = Split(isi, "|")
For i = 1 To UBound(Data)
With lvQ.ListItems.Add(, , Split(Data(i), "?")(0))
.SubItems(1) = Split(Data(i), "?")(2)
.SubItems(2) = Split(Data(i), "?")(1)
End With
Next
Me.Caption = "Quarantine (" & lvQ.ListItems.Count & ")"
End Sub

Berfungsi untuk memanggil data yang ada di folder karantina


Nah sudah selesai kita membuat antivirusnya

Untuk mendownload source code lengkapnya dapat di download di :

http://adf.ly/OuOM


cukup sekian tutorial membuat antivirus dari aye,semoga berguna untuk semua kawan" di Forum ini ^^



maaf bang klo g da SS nya bang


source code by :Mydisha

Tutor Cara Bikin Task Manager Di VB 6

Langkah-langkahnya :
1. Buka VB 6
2. Bikin 2 buah Command (Kill & Refresh) Jangan tanya masangnya gimana ya?
3. Copas Code Ini di Form..... Caranya Klick Kanan => View Code

Code:

Const TH32CS_SNAPHEAPLIST = &H1
Const TH32CS_SNAPPROCESS = &H2
Const TH32CS_SNAPTHREAD = &H4
Const TH32CS_SNAPMODULE = &H8
Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)
Const TH32CS_INHERIT = &H80000000
Const MAX_PATH As Integer = 260
Private 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
Private Declare Function CreateToolhelp32Snapshot Lib "Kernel32" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Function Process32First Lib "Kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "Kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32.dll" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hHandle As Long) As Long
Private Const PROCESS_ALL_ACCESS = &H1F0FFF
'Enum the path
Private Const PROCESS_QUERY_INFORMATION As Long = &H400
Private Const PROCESS_VM_READ = &H10
Private Declare Function EnumProcessModules Lib "psapi.dll" ( _
    ByVal hProcess As Long, _
    ByRef lphModule As Long, _
    ByVal cb As Long, _
    ByRef cbNeeded As Long) As Long
Private 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 Function PathByPID(pid As Long) As String
    'Fungsi ini berfungsi untuk mendapatkan informasi tentang aplikasi yang sedang
    'berjalan dengan menggunakan Process ID masing-masing aplikasi
    '----
    '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 List_Process()
    Dim lItem As ListItem
    Dim path As String
   
    Dim hSnapShot As Long, uProcess As PROCESSENTRY32

    'Memastikan agar semua List Box dalam keadaan kosong agar tidak terjadi penumpukan /duplikasi
    ListView1.ListItems.Clear
   
    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
        Set lItem = ListView1.ListItems.Add
        With lItem.ListSubItems
            .Add , , Left$(uProcess.szExeFile, InStr(1, uProcess.szExeFile, Chr$(0), vbTextCompare) - 1)
            .Add , , uProcess.th32ProcessID
            path = PathByPID(uProcess.th32ProcessID)
            .Add , , IIf(path <> "", path, "[Protected]")
        End With
        r = Process32Next(hSnapShot, uProcess)
            'Mendapatkan informasi dari proses selanjutnya pada windows
    Loop
    CloseHandle hSnapShot
End Sub


Private Sub cmdMatikan_Click()
    Dim processID As Long
    processID = CLng(ListView1.SelectedItem.ListSubItems(2).Text)
    TerminateProcess OpenProcess(PROCESS_ALL_ACCESS, 1, processID), 0
    Call List_Process
End Sub

Private Sub cmdRefresh_Click()
    List_Process
End Sub

Private Sub cmdTutup_Click()
    Unload Me
End Sub
Private Sub Form_Load()
Dim Wellcome As String
Wellcome = MsgBox("Task Manager Sederhana By Hackedbyme")
Wellcome = MsgBox("DC Is Our Forum ^^")
    List_Process
End Sub

Private Sub Form_Unload(Cancel As Integer)
MsgBox "Om Yakin Mau keluar?", vbQuestion + vbYesNo, "Exit Ah..!!!"
If (vbNo = True) Then
Call Form_Load
End If
End Sub

'maaf kalo tutor agak ribet :suram

4. Klick file => Make taskmanager.exe
5. Selesai

Belum punya VB 6 Nya?
Visual Basic 6 Portable
Visual Basic Full Version

Ini Projectnya => Project

Ini Yang Sudah Jadi Bikinan Ane => DC Task Manager

 

 

 

Sumber :  http://devilzc0de.org/

Cara Mempercepat Transfer Data Flashdisk

Seperti yang kita ketahui, flashdisk itu adalah perangkat penyimpanan data (Device Storage) yang ukuran fisiknya kecil namun memiliki kapasitas yang besar. Karena itu flashdisk sangat banyak digunakan di dunia. Namun, kadang kita juga dibuat kesal karena kecepatan transfer data yang lama saat kita menyalin file yang ukurannya cukup besar. Karena itulah saya akan mencoba untuk share bagaimana cara untuk meningkatkan kualitas transfer data suatu flashdisk.

Dengan cara ini, sobat bisa sedikitnya mempercepat proses transfer data pada flashdisk sobat. Seperti yang kita ketahui kalau format system flashdisk default itu adalah FAT 32 (File Allocation Type). System FAT 32 jika dibandingkan dengan NTFS (New Technology File System) jauh lebih baik NTFS, format system tipe NTFS lebih aman dan stabil serta lebih baik dalam meminimalkan fragmentasi dan unggul dibidang kecepatan. Namun demikian NTFS masih ada sedikit kekurangan, NTFS hanya bisa diakses oleh Windows NT, 2000, XP, Vista dan Seven. Akan sangat sulit diakses, bahkan mungkin tidak dapat diakses sama sekali oleh sistem operasi lain seperti Windows 9x terutama apabila sobat melakukan dualboot system operasi.

Dengan demikian, jika sobat menggunakan sistem operasi yang disebutkan diatas maka langkah terbaik adalah merubah format system flashdisk sobat dari FAT 32 menjadi NTFS. Selain itu flashdisk dapat digunakan dengan dua opsi, yaitu Optimize For Performance (Performanya dioptimalkan) dan Optimize For Quikc Removal (Performanya tidak dioptimalkan agar lebih mudah dalam proses removal). Kalo sobat ingin lebih cepat, solusi terbaik rubah menjadi Optimize For Performance.

Bagi yang belum tau caranya ikutin aja langkah-langkah ini :

1. Klik kanan pada drive flashdisk sobat kemudian pilih Properties
2. Pilih opsi tab Hardware
3. Di kolom All Disk Drives, pilih yang icon flashdisk sobat
4. Kemudian klik Properties di bagian bawah.
5. Pilih opsi tab Policies
6. Pilih yang Optimize For Performance kemudian klik OK.

Kalo mau nge-format flashdisk jangan lupa backup/copy dulu data-data di flash disk ke harddisk, karena setelah diformat data-data yang ada di dalam flashdisk akan terhapus. Kalo buat cara formatnya sendiri tinggal Klik kanan pada drive flashdisk è Klik Format (Pada file system pilih NTFS) è Kemudian klik Start è Sebelumnya akan ada peringatan yang kurang lebih artinya “Apakah anda yakin akan tetap memformat drive ini, jika drive ini di format maka semua data yang tersimpan pada drive ini akan terhapus”, klik saja OK è Baru proses pemformatan akan segera dimulai. Masalah cepat atau lambat proses pemformatan tergantung pada kapasitas data dalam flashdisk dan spec komputer sobat sendiri.

Cara Mendapatkan Uang Lewat Blog dari Adf.ly

Apa sih adf.ly?

Adf.ly merupakan salah satu web/situs yang memungkinkan sobat untuk mendapatkan uang dari setiap pengunjung atau orang yg mengklik link sobat.

Bagaimana cara kerjanya?

Sebenarnya cukup mudah sih. Pertama, sobat mempersingkat link dengan situs adf.ly, dan kemudian Anda menyebarnya, mempostingnya atau mengirimkannya kepada teman-teman sobat, juga bisa di posting di web, blog maupun di forum forum atau juga bisa sobat gunakan untuk blogwalking di buku tamu blog atau situs orang sehingga akan semakin cepat kamu mendapatkan uangnya. $4 (sekitar Rp. 32.000,-) per 1000 visitor/kunjungan dan bisa anda ambil setelah $5.

Kok sedikit banget komisinya, cuman $4/1000 visitor?

Selain dari visitor, kita juga dapat duit dari referal. Maksudnya, setiap member adf.ly yang mendaftar melalui kita maka setiap ada visitor ke link-nya dia, kita akan dapat duit juga dan begitu seterusnya. Selain itu kan ini adalah usaha sampingan, dan kalo pengen sukses ya berarti harus kerja extra keras dong. Tapi gak ada salahnya kan nyoba, sedikit-sedikit lama-lama menjadi bukit.

Cara Daftar di adf.ly

1. Klik Di Sini atau klik banner di bawah ini

Daftar Ke Adf.lyGet paid to share your links!

2. Klik Join Now
 
 

Beranda Adf.ly

3. Isi nama, email, password, centang I agree to...
 
 

Form Pendaftaran Adf.ly

 

4. Kemudian Submit
5. Setelah itu buka email kamu kemudian klik link verifikasi yang di kasih adf.ly
6. Silahkan anda Log in, masukkan email dan password
7. Mulai lah mempersingkat URL dan dapatkan uang

*Cara menggunakannya sangat mudah, cukup pilih link yang ingin kamu persingkat. Boleh link apa saja, terserah kamu ^^ bisa link situs jejaring sosial mu atau blogmu atau link situs lain. Setelah link sudah ada, masukkan link nya ke adf.ly kemudian klik Shrink!

.: Semoga Bermanfaat :.

Membangun Motivasi Dalam Diri

Cita-cita atau tujuan hidup ini hanya bisa diraih jika anda memiliki motivasi yang kuat dalam diri anda. Tanpa motivasi apapun, sulit sekali anda menggapai apa yang anda cita-citakan. Tapi tak dapat dipungkiri, memang cukup sulit membangun motivasi di dalam diri sendiri. Bahkan mungkin anda tidak tahu pasti bagaimana cara membangun motivasi di dalam diri sendiri. Padahal sesungguhnya banyak hal yang dapat dilakukan untuk menumbuhkan motivasi tersebut.
Caranya? coba simak tips berikut ini:


1. Ciptakan sensasi
Ciptakan sesuatu yang dapat “membangunkan” dan membangkitkan gairah anda saat pagi menjelang. Misalnya, anda berpikir esok hari harus mendapatkan keuntungan 1 milyar rupiah. Walau kedengarannya mustahil, tapi sensasi ini kadang memacu semangat anda untuk berkarya lebih baik lagi melebihi apa yang sudah anda lakukan kemarin.

2. Kembangkan terus tujuan anda
Jangan pernah terpaku pada satu tujuan yang sederhana. Tujuan hidup yang terlalu sederhana membuat anda tidak memiliki kekuatan lebih. Padahal untuk meraih sesuatu anda memerlukan tantangan yang lebih besar, untuk mengerahkan kekuatan anda yang sebenarnya. Tujuan hidup yang besar akan membangkitkan motivasi dan kekuatan tersendiri dalam hidup anda.

3. Tetapkan saat kematian
Anda perlu memikirkan saat kematian meskipun gejala ke arah itu tidak dapat diprediksikan. Membayangkan saat-saat terakhir dalam hidup ini sesungguhnya merupakan saat-saat yang sangat sensasional. Anda dapat membayangkan ‘flash back’ dalam kehidupan anda. Sejak anda menjalani masa kanak-kanak, remaja, hingga tampil sebagai pribadi yang dewasa dan mandiri. Jika anda membayangkan ‘ajal’ anda sudah dekat, akan memotivasi anda untuk berbuat lebih banyak lagi selama hidup anda.

4. Tinggalkan teman yang tidak perlu
Jangan ragu untuk meninggalkan teman-teman yang tidak dapat mendorong anda mencapai tujuan. Sebab, siapapun teman anda, seharusnya mampu membawa anda pada perubahan yang lebih baik. Ketahuilah bergaul dengan orang-orang yang optimis akan membuat anda berpikir optimis pula. Bersama mereka hidup ini terasa lebih menyenangkan dan penuh motivasi.

5. Hampiri bayangan ketakutan
Saat anda dibayang-bayangi kecemasan dan ketakutan, jangan melarikan diri dari bayangan tersebut. Misalnya selama ini anda takut akan menghadapi masa depan yang buruk. Datang dan nikmati rasa takut anda dengan mencoba mengatasinya. Saat anda berhasil mengatasi rasa takut, saat itu anda telah berhasil meningkatkan keyakinan diri bahwa anda mampu mencapai hidup yang lebih baik.

6. Ucapkan “selamat datang” pada setiap masalah
Jalan untuk mencapai tujuan tidak selamanya semulus jalan tol. Suatu saat anda akan menghadapi jalan terjal, menanjak dan penuh bebatuan. Jangan memutar arah untuk mengambil jalan pintas. Hadapi terus jalan tersebut dan pikirkan cara terbaik untuk bisa melewatinya. Jika anda memandang masalah sebagai sesuatu yang mengerikan, anda akan semakin sulit termotivasi. Sebaliknya bila anda selalu siap menghadapi setiap masalah, anda seakan memiliki energi dan semangat berlebih untuk mencapai tujuan anda.

7. Mulailah dengan rasa senang
Jangan pernah merasa terbebani dengan tujuan hidup anda. Coba nikmati hidup dan jalan yang anda tempuh. Jika sejak awal anda sudah merasa ‘tidak suka’ rasanya motivasi hidup tidak akan pernah anda miliki.

8. Berlatih dengan keras
Tidak bisa tidak, anda harus berlatih terus bila ingin mendapatkan hasil terbaik. Pada dasarnya tidak ada yang tidak dapat anda raih jika anda terus berusaha keras. Semakin giat berlatih semakin mudah pula mengatasi setiap kesulitan.
Kesimpulan:
Motivasi dapat menumbuhkan semangat dalam mencapai tujuan. Motivasi yang kuat di dalam diri, kita akan memiliki apresiasi dan penghargaan yang tinggi terhadap diri dan hidup ini. Sehingga kita tidak akan ragu untuk melangkah ke depan, yaitu mencapai visi hidup kita.
Salam Sukses !