13 replies to this topic

[retxel]

   Hola, Podría realizarse un par de sencillas aplicaciones Cliente - Servidor con el objetivo de intermediar en el acceso o no entre una PC cliente y PC servidor (como función de server, no un server oficial, cliente de win normal como win7 8, etc), chequeando la ip del cliente y una clave maestra encriptada. Si una pc cliente tiene ejecutada la app cliente el app servidor  del pc servidor chequea dicha clave y registra en un listado la ip autorizada dejándola pasar para realizar sus peticiones, si otra pc cliente quiere acceder a dicho servidor y no tiene ejecutada esta app cliente será denegado su acceso por su ip, hasta que la ejecute. Las Pc clientes que hayan sido autorizadas a seguir hacia el pc servidor se chequerán cada 30 seg que tenga abierta la app cliente, si alguna cierra dicha app será expulsada de la lista y se denegará el acceso al servidor pc hasta que ejecute nuevamente la app cliente.

 

    El objetivo de esta pareja de app Cliente - Servidor es validar el acceso de una pc a otra mediante una condición. Estas se pueden utilizar en miles de casos, sobre todos entre aplicaciones de terceros como intermediario imponiendo una condición.

[escafandra]

Sin más información del "servidor oficial" que es el que debe o no aceptar la IP del cliente en cuestión y no sabemos si disponemos del código fuente ni el protocolo que usa, se me ocurre hacer un Hook a dos APIs para controlar los protocolos TCP y UDP. Para el primero será a recv de la que obtendremos la IP del cliente a través del soket de comunicación. Para el segundo caso a recvfrom de la que obtendremos la IP en cuestión sin problemas. La IP del cliente la buscaremos en la lista blanca y si no existe denegamos la lectura de datos devolviendo -1.

 

Otra posibilidad es jugar con la tabla ARP.

 

Saludos.

[escafandra]

Voy a poner un ejemplo de un sistema de bloqueo de IPs.
 
El protocolo será del cliente-servidor TCP para que sea seguro.
 
Hay que diseñar un cliente que se ejecutará en la máquina que deseamos bloquear si durante un tiempo no se conecta, para ello, el cliente enviará un mensaje a su servidor con una palabra clave cada cierto tiempo. He elegido algo simple: "HOLA" cada 500 milisegundos.
El servidor estará atendiendo conexiones, leyendo la palabra clave y si es correcta añadirá la IP del cliente a una lista junto con la hora de conexión. Tras esto cierra la conexión y espera otra nueva para hacer lo mismo.
Será necesaria una dll que se inyectará en el "servidor oficial" para dotarle de la capacidad de bloquear las conexiones de las IP que cierran su cliente. Daremos un margen de 30 segundos tras el cierre del cliente.
Para cumplir su labor, la dll hace un Hook a las APis siguientes:
  recv
  recvfrom
  WSARecv
  WSARecvEx
  WSARecvFrom

Si bien a las dos primeras, recv y recvfrom, no haría falta pues terminan en sus correspondientes WSA y de hecho no son hookeables, las dejo como muestra didáctica.
 
Cada Hook comprueba si la IP de procedencia concuerda con una en la lista blanca de permitidas, las que alguna vez se conectaron. A su vez, comprueba la hora de última conexión, si pasaron más de 30 segundos bloquea la API devolviendo un error  WSAETIMEDOUT, esto provocará que el servidor cierre dicha conexión. El sistema es válido para protocolo TCP y UDP del "servidor oficial"

Aclarar que el cliente del ejemplo se conecta al localhost, en pruebas reales habrá que resolver la dirección del servidor allí donde esté.

Ahora un poco de código:
 
El cliente:

delphi

Unit UPassClient;
 
interface
 
uses
  SysUtils,
  Windows,
  Messages,
  winsock;
 
procedure Client;
 
const
  Port: DWORD = 9999;
  Server: PCHAR = 'localhost';
var
  Terminated: BOOL = false;
 
implementation
 
function Recv_(Sock: TSOCKET; var Buffer; Size, flags, TimeOut: integer): integer;
var
  FDSet: WinSock.TFDSET;
  TimeVal: WinSock.TTIMEVAL;
begin
  TimeVal.tv_sec:= TimeOut div 1000;
  TimeVal.tv_usec:= TimeOut mod 1000;
  FD_ZERO(FDSet);
  FD_SET(Sock, FDSet);
 
  Result:= 0;
  // Comprobamos si ha recibido algun mensaje
  if Winsock.select(0, @FDSet, nil, nil, @TimeVal) > 0 then
    Result:= recv(Sock, Buffer, Size, flags)
  else
    WSASetLastError(WSAETIMEDOUT);
end;
 
function Send_(Sock: TSOCKET; var Buffer; Size, flags, TimeOut: integer): integer;
var
  FDSet: WinSock.TFDSET;
  TimeVal: WinSock.TTIMEVAL;
begin
  TimeVal.tv_sec:= TimeOut div 1000;
  TimeVal.tv_usec:= TimeOut mod 1000;
  FD_ZERO(FDSet);
  FD_SET(Sock, FDSet);
 
  Result:= 0;
  // Comprobamos si se puede enviar el mensaje
  if select(0, nil, @FDSet, nil, @TimeVal) > 0 then
    Result:= send(Sock, Buffer, Size, flags)
  else
    WSASetLastError(WSAETIMEDOUT);
end;
 
function Connect_(IP: PCHAR; Port: DWORD): TSOCKET;
var
  host: Phostent;
  direc: sockaddr_in;
  Error: boolean;
begin
  Error:= true;
  Result:= Winsock.socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
  if(Result <> -1) then
  begin
    //Dirección IP del servidor y Puerto
    host:= gethostbyname(IP);
    if host <> nil then
    begin
      direc.sin_family:= AF_INET;
      direc.sin_port:= htons(Port);
      direc.sin_addr.S_addr:= PInAddr(host.h_addr_list^)^.S_addr;
      ZeroMemory(@direc.sin_zero[0], 8);
      if Winsock.Connect(Result, direc, sizeof(direc)) <> -1 then
        Error:= false;
    end;
    if Error then
    begin
      closesocket(Result);
      Result:= -1;
    end;
  end;
end;
 
procedure Client;
var
  Wsa: WSADATA;
  Socket: TSOCKET;
  Buffer: array [0..123] of CHAR;
begin
  // Inicializamos
  if WSAStartup(MAKEWORD(2, 0), Wsa) <> 0 then exit;
 
  // Bucle de comunicación
  repeat
    Socket:= Connect_(PCHAR(Server), Port);
    if Socket <> -1 then
      lstrcpy(Buffer, 'HOLA'); //Palabra clave de ejemplo
      Send_(Socket, Buffer, lstrlen(Buffer)+1, 0, 1000);
      Sleep(500);
    closesocket(Socket);
  until Terminated;
  closesocket(Socket);
  WSACleanup;
end;
 
end.

El programa cliente completo:

delphi

program PassClient;
 
uses
  UPassClient in 'UPassClient.pas';
 
 
begin
  Client;
end.

Para no sobrecargar el post, sigo en el siguiente.
 
 
Saludos.

[escafandra]

El servidor que tiene una función login que, por el momento y para este ejemplo, siempre devuelve true. Deberá implementarse para descifrar la clave y actuar en consecuencia.

 

Cada IP que se conecte se introduce en una Array junto con la hora de conexión en una estructura como esta:

delphi

type
  TIPData = record
    IP: DWORD;
    Time: TDateTime;
  end;
 
const
  SizeList =  1024*sizeof(TIPData);
 
type
  PWhiteList = ^TWhiteList;
  TWhiteList = array [0..1023] of TIPData;

El array tiene 1024 entradas, IPs a controlar. Aunque se puede hacer mas largo, no creo que sea muy necesario para una red local. Este array se enviará como un archivo de memoria compartida a la dll que se encarga del bloqueo.

 

Esta es el código del servidor:

delphi

program PassServer;
 
uses
  SysUtils,
  Windows,
  Messages,
  winsock,
  APIHook,
  SharedMemory;
 
//procedure GlobalHook; stdcall external 'ServerHook.dll';
 
type
  TIPData = record
    IP: DWORD;
    Time: TDateTime;
  end;
 
const
  SizeList =  1024*sizeof(TIPData);
 
type
  PWhiteList = ^TWhiteList;
  TWhiteList = array [0..1023] of TIPData;
 
const
  Port: DWORD = 9999;
 
var
  Memory: TSharedMemory;
  WhiteList: PWhiteList;
  IPCount: integer = 0;
  Terminated: BOOL = false;
 
// Obtener la IP desde el Socket
function GetIPFromSoket(Sock: TSOCKET): DWORD;
var
  addr: WinSock.sockaddr_in;
  addr_size: integer;
begin
  addr_size:= sizeof(sockaddr_in);
  getpeername(Sock, addr, addr_size);
  Result:= addr.sin_addr.S_addr;
end;
 
function Recv_(Sock: TSOCKET; var Buffer; Size, flags, TimeOut: integer): integer;
var
  FDSet: WinSock.TFDSET;
  TimeVal: WinSock.TTIMEVAL;
begin
  TimeVal.tv_sec:= TimeOut div 1000;
  TimeVal.tv_usec:= TimeOut mod 1000;
  FD_ZERO(FDSet);
  FD_SET(Sock, FDSet);
 
  Result:= 0;
  // Comprobamos si ha recibido algun mensaje
  if Winsock.select(0, @FDSet, nil, nil, @TimeVal) > 0 then
    Result:= recv(Sock, Buffer, Size, flags)
  else
    WSASetLastError(WSAETIMEDOUT);
end;
 
function Send_(Sock: TSOCKET; var Buffer; Size, flags, TimeOut: integer): integer;
var
  FDSet: WinSock.TFDSET;
  TimeVal: WinSock.TTIMEVAL;
begin
  TimeVal.tv_sec:= TimeOut div 1000;
  TimeVal.tv_usec:= TimeOut mod 1000;
  FD_ZERO(FDSet);
  FD_SET(Sock, FDSet);
 
  Result:= 0;
  // Comprobamos si se puede enviar el mensaje
  if select(0, nil, @FDSet, nil, @TimeVal) > 0 then
    Result:= send(Sock, Buffer, Size, flags)
  else
    WSASetLastError(WSAETIMEDOUT);
end;
 
procedure AddIP(IP: DWORD);
var
  n: integer;
begin
  if IPCount < (sizeof(TWhiteList) div sizeof(TIPData))-1 then
  begin
    for n:= 0 to IPCount-1 do if  WhiteList[n].IP = IP then break;
    if n >= IPCount then
    begin
      WhiteList[IPCount].IP:= IP;
      WhiteList[IPCount].Time:= Now;
      inc(IPCount);
    end
    else WhiteList[n].Time:= Now;
  end;
end;
 
function login(Buffer: PCHAR): BOOL;
begin
  result:= true;
end;
 
var
  Wsa: WSADATA;
  Sock_e, Sock_c: TSOCKET; // Sock de escucha y comunicación
  Addr_s, Addr_c: sockaddr_in;
  Len: integer;
  Buffer: array [0..123] of CHAR;
  hLib: HMODULE;
  API: Pointer;
begin
  IPCount:= 0;
  Terminated:= false;
 
  Len:= 0;
  Memory:= TSharedMemory.Create('_WhiteList_', sizeof(TWhiteList));
  WhiteList:= Memory.Buffer;
 
  // Inicializamos
  if WSAStartup(MAKEWORD(2, 0), Wsa) <> 0 then exit;
  //Creamos el socket
  Sock_e:= socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
  if Sock_e <> INVALID_SOCKET then
  begin
    // Dirección IP y puerto
    Addr_s.sin_family:= AF_INET;
    Addr_s.sin_addr.s_addr:= INADDR_ANY;
    Addr_s.sin_port:= htons(Port);
 
    // Asociamos el socket al puerto
    if bind(Sock_e, Addr_s, sizeof(sockaddr_in)) <> -1 then
    begin
      // Bucle principal del servidor
      while not Terminated do
      begin
        // Escuchando puerto
        if listen(Sock_e, 1) <> -1 then
        begin
          //hay una conexión entrante y la aceptamos
          Len:= sizeof(sockaddr_in);
          Sock_c:= accept(Sock_e, @Addr_c, @Len);
          if Sock_c <> INVALID_SOCKET then
          begin
            //Len:= recv(Sock_c, Buffer, sizeof(Buffer)-1, 0);
            Len:= Recv_(Sock_c, Buffer, sizeof(Buffer)-1, 0, 1000);
            if Len>0 then
            begin
              Buffer[Len]:= #0;
              if login(Buffer) then
                AddIP(GetIPFromSoket(Sock_c));
            end;
            closesocket(Sock_c);
          end;
        end;
      end; // listen
    end; // if(bind)
    closesocket(Sock_e);
  end; // if(Sock_e)
  WSACleanup;
end.

La dll que se encargará del control de bloqueo la mando en la siguiente entrega.

 

 

Saludos.

[escafandra]

La dll que habilita el bloqueo de IPs no permitidas
 

delphi

library ServerHook;
 
uses
  SysUtils,
  Windows,
  winsock,
  APIHook,
  SharedMemory;
 
type
  TIPData = record
    IP: DWORD;
    Time: TDateTime;
  end;
  PWhiteList = ^TWhiteList;
  TWhiteList = array [0..1023] of TIPData;
 
const
 SizeMemory: DWORD = sizeof(TWhiteList);
 TimeBlock: WORD = 30; //segundos sin conexión -> Bloqueo
 
type
 
Precv = function(S: TSOCKET; var buf: CHAR; len, flags: integer): integer; stdcall;
Precvfrom = function(s: TSOCKET; var buf: CHAR; len, flags: integer; var from: Tsockaddr; fromlen: integer): integer; stdcall;
PWSARECV = function (s: TSOCKET; lpBuffers: Pointer; dwBufferCount: DWORD;  lpNumberOfBytesRecvd: LPDWORD; lpFlags: LPDWORD; lpOverlapped: Pointer; lpCompletionRoutine: Pointer): integer; stdcall;
PWSARECVFROM = function(s: TSOCKET; lpBuffers: Pointer; dwBufferCount: DWORD;  lpNumberOfBytesRecvd: LPDWORD; lpFlags: LPDWORD; lpfrom: Psockaddr; lpFromlen: PINT; lpOverlapped, lpCompletionRoutine: Pointer): integer; stdcall;
PWSARECVEX = function(s: TSOCKET; buf: PCHAR; len: integer; flags: Pinteger): integer; PASCAL;
 
var
  Oldrecv: Precv = nil;
  Oldrecvfrom : Precvfrom  = nil;
  OldWSARecv: PWSARECV = nil;
  OldWSARecvEx: PWSARECVEX = nil;
  OldWSARecvFrom: PWSARECVFROM = nil;
 
  WinHook: HHOOK = 0;
  Memory: TSharedMemory;
  WhiteList: PWhiteList;
 
//----------------------------------------------------------------------------
// Obtener la IP desde el Socket
function GetIPFromSoket(Sock: TSOCKET): DWORD;
var
  addr: WinSock.sockaddr_in;
  addr_size: integer;
begin
  addr_size:= sizeof(sockaddr_in);
  getpeername(Sock, addr, addr_size);
  Result:= addr.sin_addr.S_addr;
end;
 
// Busca un IP con más de un tiempo determinado sin conexión
function BlockIP(IP: DWORD): BOOL;
var
  n: integer;
  IPCount: integer;
begin
  Result:= TRUE;
  WhiteList:= Memory.Buffer;
  IPCount:= sizeof(TWhiteList) div sizeof(TIPData);
  for n:= 0 to IPCount-1 do
  begin
    if WhiteList[n].IP = 0 then break;
    if WhiteList[n].IP = IP then
      // Si hace más de 30 segundos que no se conecta lo bloqueo
      if Now - WhiteList[0].Time < TimeBlock/(24*3600) then
      begin
        Result:= FALSE;
        Exit;
      end;
  end;
end;
 
//----------------------------------------------------------------------------
// La APIs Hookeadas
function NewWSARecv(s: TSOCKET; lpBuffers: Pointer; dwBufferCount: DWORD; lpNumberOfBytesRecvd: LPDWORD; lpFlags: LPDWORD; lpOverlapped: Pointer; lpCompletionRoutine: Pointer): integer; stdcall;
begin
  if BlockIP(GetIPFromSoket(S)) then
  begin
    Result:= WSAETIMEDOUT;
    WSASetLastError(WSAETIMEDOUT);
    lpNumberOfBytesRecvd^:= DWORD(-1);
  end
  else
    Result:= OldWSARecv(s, lpBuffers, dwBufferCount, lpNumberOfBytesRecvd, lpFlags, lpOverlapped, lpCompletionRoutine);
end;
 
function NewWSARecvEx(S: TSOCKET; buf: PCHAR; len: integer; flags: Pinteger): integer; PASCAL;
begin
  Result:= SOCKET_ERROR;
  if BlockIP(GetIPFromSoket(S)) then
    WSASetLastError(WSAETIMEDOUT)
  else
    Result:= OldWSARecvEx(S, buf, len, flags);
end;
 
function NewWSARecvFrom(s: TSOCKET; lpBuffers: Pointer; dwBufferCount: DWORD;  lpNumberOfBytesRecvd: LPDWORD; lpFlags: LPDWORD; lpfrom: Psockaddr; lpFromlen: PINT; lpOverlapped, lpCompletionRoutine: Pointer): integer; stdcall;
begin
  if (lpfrom.sin_addr.S_addr <> 0) and BlockIP(lpfrom.sin_addr.S_addr) then
  begin
    Result:= WSAETIMEDOUT;
    WSASetLastError(WSAETIMEDOUT);
    lpNumberOfBytesRecvd^:= DWORD(-1);
  end
  else
    Result:= OldWSARecvFrom(s, lpBuffers, dwBufferCount, lpNumberOfBytesRecvd, lpFlags, lpfrom, lpFromlen, lpOverlapped, lpCompletionRoutine);
end;
 
function NewRecv(S: TSOCKET; var buf: CHAR; len, flags: integer): integer; stdcall;
begin
  Result:= SOCKET_ERROR;
  if BlockIP(GetIPFromSoket(S), ) then
    WSASetLastError(WSAETIMEDOUT)
  else
    Result:= OldRecv(S, buf, len, flags);
end;
 
function NewRecvfrom(s: TSOCKET; var buf: CHAR; len, flags: integer; var from: Tsockaddr; fromlen: integer): integer; stdcall;
begin
  Result:= SOCKET_ERROR;
  if BlockIP(from.sin_addr.S_addr) then
    WSASetLastError(WSAETIMEDOUT)
  else
    Result:= OldRecvfrom(s, buf, len, flags, from, fromlen);
end;
 
 
//----------------------------------------------------------------------------
// Instalando los Hooks a las API
procedure InstallHooks;
begin
  InstallHook(@NewRecv, @OldRecv, 'Ws2_32.dll', 'recv', true);
  InstallHook(@NewRecvfrom, @OldRecvfrom, 'Ws2_32.dll', 'recvfrom', true);
  InstallHook(@NewWSARecv, @OldWSARecv, 'Ws2_32.dll', 'WSARecv', true);
  InstallHook(@NewWSARecvEx, @OldWSARecvEx, 'Mswsock.dll', 'WSARecvEx', true);
  InstallHook(@NewWSARecvFrom, @OldWSARecvFrom, 'Ws2_32.dll', 'WSARecvFrom', true);
end;
 
//----------------------------------------------------------------------------
// Desinstalando todos los Hooks
procedure UnInstallHooks;
begin
  UnInstallHook(@OldRecv, 'Ws2_32.dll', 'recv');
  UnInstallHook(@OldRecvfrom, 'Ws2_32.dll', 'recvfrom');
  UnInstallHook(@OldWSARecv, 'Ws2_32.dll', 'WSARecv');
  UnInstallHook(@OldWSARecvEx, 'Mswsock.dll', 'WSARecvEx');
  UnInstallHook(@OldWSARecvFrom, 'Ws2_32.dll', 'WSARecvFrom');
end;
 
procedure DllMain(reason: integer);
begin
   case reason of
     DLL_PROCESS_ATTACH:
     begin
       Memory:= TSharedMemory.Create('_WhiteList_', sizeof(TWhiteList));
       InstallHooks;
     end;
     DLL_PROCESS_DETACH:
     begin
       UnInstallHooks;
       Memory.Free;
     end;
   end;
end;
 
begin
 DllProc := @DllMain;
 DllProc(DLL_PROCESS_ATTACH);
end.

 
Esta dll debe ser inyectada en el "servidor oficial" dotándole de la capacidad de bloquear las IPs que no estén en la lista blanca o que haga más de 30 segundos desde su última conexión, es decir, las díscolas que eliminaron su cliente validador. Ahora queda pensarse que más cosas hará el cliente validador y la verdadera razón de su existencia en el PC que queremos validar.

 

Todo el sistema esta probado en un WinXP y Win10 contra un "servidor oficial" compilado a 32 bits para los protocolos TCP y UDP.

 

Espero que esta estrategia y su código, de respuesta a la necesidad que hizo abrir el tema y que sea de interés general.

 

 

 

Saludos.

[Dante]

Eres un genio

[Dante]

Ya probe el codigo pero al llebarlo a una GUI me conjela la ventana y no puedo hacer mas nada, intente hacer un hilo de ejecucion aparte para esto pero me da un error al  tratar de detener el server.

delphi

unit Hilo;
 
interface
    uses
    Windows, Messages, SysUtils, Variants, Graphics, Controls, Forms,
  Dialogs, StdCtrls,
 Classes, winsock, APIHook, SharedMemory;
 
 type
  TServerStar = class(TThread)
  private
    port: DWORD;
 
  protected
    procedure Execute; override;
 
  public
     procedure Salir;
    constructor Create(Ports :DWORD);
  end;
 
 
 
 
 
implementation
 
 type
  TIPData = record
    IP: DWORD;
    Time: TDateTime;
  end;
 
  PWhiteList = ^TWhiteList;
  TWhiteList = array [0..1023] of TIPData;
const
  SizeList =  1024*sizeof(TIPData);
 
var
  Memory: TSharedMemory;
  WhiteList: PWhiteList;
  IPCount: integer = 0;
  terminar: Boolean;
 
 
constructor TServerStar.Create(PortS: DWORD);
begin
  inherited Create(True);
  port := PortS;
  end;
 
 
 
// Obtener la IP desde el Socket
function GetIPFromSoket(Sock: TSOCKET): DWORD;
var
  addr: WinSock.sockaddr_in;
  addr_size: integer;
begin
  addr_size:= sizeof(sockaddr_in);
  getpeername(Sock, addr, addr_size);
  Result:= addr.sin_addr.S_addr;
end;
 
function Recv_(Sock: TSOCKET; var Buffer; Size, flags, TimeOut: integer): integer;
var
  FDSet: WinSock.TFDSET;
  TimeVal: WinSock.TTIMEVAL;
begin
  TimeVal.tv_sec:= TimeOut div 1000;
  TimeVal.tv_usec:= TimeOut mod 1000;
  FD_ZERO(FDSet);
  FD_SET(Sock, FDSet);
 
  Result:= 0;
  // Comprobamos si ha recibido algun mensaje
  if Winsock.select(0, @FDSet, nil, nil, @TimeVal) > 0 then
    Result:= recv(Sock, Buffer, Size, flags)
  else
    WSASetLastError(WSAETIMEDOUT);
end;
 
function Send_(Sock: TSOCKET; var Buffer; Size, flags, TimeOut: integer): integer;
var
  FDSet: WinSock.TFDSET;
  TimeVal: WinSock.TTIMEVAL;
begin
  TimeVal.tv_sec:= TimeOut div 1000;
  TimeVal.tv_usec:= TimeOut mod 1000;
  FD_ZERO(FDSet);
  FD_SET(Sock, FDSet);
 
  Result:= 0;
  // Comprobamos si se puede enviar el mensaje
  if select(0, nil, @FDSet, nil, @TimeVal) > 0 then
    Result:= send(Sock, Buffer, Size, flags)
  else
    WSASetLastError(WSAETIMEDOUT);
end;
 
procedure AddIP(IP: DWORD);
var
  n: integer;
begin
  if IPCount < (sizeof(TWhiteList) div sizeof(TIPData))-1 then
  begin
    for n:= 0 to IPCount-1 do if  WhiteList[n].IP = IP then break;
    if n >= IPCount then
    begin
      WhiteList[IPCount].IP:= IP;
      WhiteList[IPCount].Time:= Now;
      inc(IPCount);
    end
    else WhiteList[n].Time:= Now;
  end;
end;
 
function login(Buffer: PCHAR): BOOL;
begin
  result:= True;
end;
 
 
procedure TServerStar.Execute;
var
  Wsa: WSADATA;
  Sock_e, Sock_c: TSOCKET; // Sock de escucha y comunicación
  Addr_s, Addr_c: sockaddr_in;
  Len: integer;
  Buffer: array [0..123] of CHAR;
  hLib: HMODULE;
  API: Pointer;
 
begin
  IPCount:= 0;
  Len:= 0;
  terminar:=False;
  Memory:= TSharedMemory.Create('_WhiteList_', sizeof(TWhiteList));
  WhiteList:= Memory.Buffer;
 
  // Inicializamos
  if WSAStartup(MAKEWORD(2, 0), Wsa) <> 0 then exit;
  //Creamos el socket
  Sock_e:= socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
  if Sock_e <> INVALID_SOCKET then
  begin
    // Dirección IP y puerto
    Addr_s.sin_family:= AF_INET;
    Addr_s.sin_addr.s_addr:=INADDR_ANY;
    Addr_s.sin_port:= htons(port);
 
    // Asociamos el socket al puerto
    if bind(Sock_e, Addr_s, sizeof(sockaddr_in)) <> -1 then
    begin
      // Bucle principal del servidor
      //MessageBox(0,'hola','terminar',MB_OK);
 
      while not terminar do
      begin
 
           // MessageBox(0,'hola','111',MB_OK);
        // Escuchando puerto
        if listen(Sock_e, 1) <> -1 then
        begin
          //hay una conexión entrante y la aceptamos
          Len:= sizeof(sockaddr_in);
          Sock_c:= accept(Sock_e, @Addr_c, @Len);
          if Sock_c <> INVALID_SOCKET then
          begin
            //Len:= recv(Sock_c, Buffer, sizeof(Buffer)-1, 0);
            Len:= Recv_(Sock_c, Buffer, sizeof(Buffer)-1, 0, 1000);
            if Len>0 then
            begin
              Buffer[Len]:= #0;
              if login(Buffer) then
                AddIP(GetIPFromSoket(Sock_c));
            end;
            closesocket(Sock_c);
          end;
        end;
 
        //   MessageBox(0,'hola1','mio',MB_OK);
      end; // listen
 
      end; // if(bind)
 
    closesocket(Sock_e);
  end; // if(Sock_e)
  WSACleanup;
end;
 
 
  procedure TServerStar.Salir();
      begin
      terminar := true;
     if terminar then   MessageBox(0,'Salir','si',MB_OK);
 
       end;
 
 
end.

[escafandra]

Efectivamente hay que colocarlo en un hilo distinto al principal y establecer un Mutex para acceder a un área y de memoria con las aplicaciones a proteger. En cuanto tenga un rato te muestro un ejemplo de como llevarlo a un GUI con un thread a bajo nivel.

 

El programa permitirá elegir en un entorno gráfico lis nombres de aplicaciones a protegerente que enviará a la red local.  Los clientes recibirán la información y actuarán en consecuencia.

 

Saludos.

[escafandra]

No he compilado tu código pero la solución viene por aquí:
 

delphi

procedure TServerStar.Salir();
begin
  if MessageBox(0,'Server','¿Salir?',MB_YESNO) = IDOK then
  begin
    terminar := true;
    WSACleanup;
  end;
end;

Ha preparado un ejemplo funcional de una aplicación que permite elegir una serie de ejecutables que queremos protejer y un "Servidor Oficial" que bloquearemos si el cliente no se conecta por más de 30 segundos. El programa inyectará una dll que permite el bloqueo del servidor y lo desinyecta al salir.

 

Dispone de un hilo con un servidor que se comunica con los clientes y les envía una lista de programas que deben proteger, los clientes deberán hacer su tarea.

 

Para comunicar el hilo principal de la aplicación con el servidor, uso un mutex que permite acceder a ambos a la lista de programas de manera sincronizada. El servidor envía a la dll una lista blanca de IPs con cliente activo y la dll habilita al "Servidor Oficial" para bloquear a las que no estén en esa lista.

 

Así hace el hilo principal:

delphi

procedure TForm1.Send;
var
  i: integer;
  Name: PCHAR;
begin
  // Mandamos al sistema de protección los ejecutables a protejer
  // Esperamos a tener control del Mutex antes de aceder a datos del hilo principal
  if WaitForSingleObject(Mutex, INFINITE) = WAIT_OBJECT_0 then
  begin
    Name:= NamesToProtect;
    for i:= 0 to ListView1.Items.Count -1 do
    begin
      lstrcpy(Name, PCHAR(ListView1.Items[i].Caption));
      inc(Name, lstrlen(Name)+1);
    end;
    Name^:= #0;
  end;
  // Cedemos el control del Mutex
  ReleaseMutex(Mutex);
end;

Y esto hace el servidor:

delphi

procedure SendProcessNames(Socket: TSOCKET);
var
  i: DWORD;
  Name: PCHAR;
begin
  if WaitForSingleObject(Mutex, INFINITE) = WAIT_OBJECT_0 then
  begin
    Name:= NamesToProtect;
    i:= 0;
    while  (Name^ <> #0) and (i < MAX_PID) do
    begin
      Send_(Socket, Name^, lstrlen(Name)+1, 0, 1000);
      inc(i);
      inc(Name, lstrlen(Name)+1);
    end;
  end;
  ReleaseMutex(Mutex);
end;

La lista de programas se guarda en el PC servidor de forma encriptada en un archivo

Todo está escrito a bajo nivel excepto la parte visual.

 

El código de la unidad servidor es este:

delphi

Unit UPassServer;
 
interface
 
uses
  SysUtils,
  Windows,
  Messages,
  winsock,
  Usend,
  SharedMemory;
 
const
  Port: DWORD = 6666;
 
type
  PWhiteList = ^TWhiteList;
  TWhiteList = array [0..1023] of TIPData;
 
var
  Memory: TSharedMemory;
  MemorySend: TSharedMemory;
  WhiteList: PWhiteList;
  IPCount: integer = 0;
  Terminated: BOOL = false;
  hThread: THANDLE = 0;
  ThreadId: DWORD = 0;
  Mutex: THANDLE;
 
procedure Server;
procedure StopServer;
procedure StartThServer;
 
implementation
 
 
// Obtener la IP desde el Socket
function GetIPFromSoket(Sock: TSOCKET): DWORD;
var
  addr: WinSock.sockaddr_in;
  addr_size: integer;
begin
  addr_size:= sizeof(sockaddr_in);
  getpeername(Sock, addr, addr_size);
  Result:= addr.sin_addr.S_addr;
end;
 
function Recv_(Sock: TSOCKET; var Buffer; Size, flags, TimeOut: integer): integer;
var
  FDSet: WinSock.TFDSET;
  TimeVal: WinSock.TTIMEVAL;
begin
  TimeVal.tv_sec:= TimeOut div 1000;
  TimeVal.tv_usec:= TimeOut mod 1000;
  FD_ZERO(FDSet);
  FD_SET(Sock, FDSet);
 
  Result:= 0;
  // Comprobamos si ha recibido algun mensaje
  if Winsock.select(0, @FDSet, nil, nil, @TimeVal) > 0 then
    Result:= recv(Sock, Buffer, Size, flags)
  else
    WSASetLastError(WSAETIMEDOUT);
end;
 
function Send_(Sock: TSOCKET; var Buffer; Size, flags, TimeOut: integer): integer;
var
  FDSet: WinSock.TFDSET;
  TimeVal: WinSock.TTIMEVAL;
begin
  TimeVal.tv_sec:= TimeOut div 1000;
  TimeVal.tv_usec:= TimeOut mod 1000;
  FD_ZERO(FDSet);
  FD_SET(Sock, FDSet);
 
  Result:= 0;
  // Comprobamos si se puede enviar el mensaje
  if select(0, nil, @FDSet, nil, @TimeVal) > 0 then
    Result:= send(Sock, Buffer, Size, flags)
  else
    WSASetLastError(WSAETIMEDOUT);
end;
 
procedure AddIP(IP: DWORD);
var
  n: integer;
begin
  if IPCount < (sizeof(TWhiteList) div sizeof(TIPData))-1 then
  begin
    for n:= 0 to IPCount-1 do if  WhiteList[n].IP = IP then break;
    if n >= IPCount then
    begin
      WhiteList[IPCount].IP:= IP;
      WhiteList[IPCount].Time:= Now;
      inc(IPCount);
    end
    else WhiteList[n].Time:= Now;
  end;
end;
 
function login(Buffer: PCHAR): BOOL;
begin
  result:= true;
end;
 
procedure SendProcessNames(Socket: TSOCKET);
var
  i: DWORD;
  Name: PCHAR;
begin
  if WaitForSingleObject(Mutex, INFINITE) = WAIT_OBJECT_0 then
  begin
    Name:= NamesToProtect;
    i:= 0;
    while  (Name^ <> #0) and (i < MAX_PID) do
    begin
      Send_(Socket, Name^, lstrlen(Name)+1, 0, 1000);
      inc(i);
      inc(Name, lstrlen(Name)+1);
    end;
  end;
  ReleaseMutex(Mutex);
end;
 
procedure Server;
var
  Wsa: WSADATA;
  Sock_e, Sock_c: TSOCKET; // Sock de escucha y comunicación
  Addr_s, Addr_c: sockaddr_in;
  Len: integer;
  Buffer: array [0..123] of CHAR;
  hLib: HMODULE;
  API: Pointer;
begin
  IPCount:= 0;
  Terminated:= false;
 
  Len:= 0;
  Memory:= TSharedMemory.Create('_WhiteList_', sizeof(TWhiteList));
  MemorySend:= TSharedMemory.Create('_AntiInjector_', MemSize);
  WhiteList:= Memory.Buffer;
 
  // Inicializamos
  if WSAStartup(MAKEWORD(2, 0), Wsa) <> 0 then exit;
  //Creamos el socket
  Sock_e:= socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
  if Sock_e <> INVALID_SOCKET then
  begin
    // Dirección IP y puerto
    Addr_s.sin_family:= AF_INET;
    Addr_s.sin_addr.s_addr:= INADDR_ANY;
    Addr_s.sin_port:= htons(Port);
 
    // Asociamos el socket al puerto
    if bind(Sock_e, Addr_s, sizeof(sockaddr_in)) <> -1 then
    begin
      // Bucle principal del servidor
      while not Terminated do
      begin
        // Escuchando puerto
        if listen(Sock_e, 1) <> -1 then
        begin
          //hay una conexión entrante y la aceptamos
          Len:= sizeof(sockaddr_in);
          Sock_c:= accept(Sock_e, @Addr_c, @Len);
          if Sock_c <> INVALID_SOCKET then
          begin
            //Len:= recv(Sock_c, Buffer, sizeof(Buffer)-1, 0);
            Len:= Recv_(Sock_c, Buffer, sizeof(Buffer)-1, 0, 1000);
            if Len>0 then
            begin
              Buffer[Len]:= #0;
              if login(Buffer) then
              begin
                AddIP(GetIPFromSoket(Sock_c));
                SendProcessNames(Sock_c);
              end;
            end;
            closesocket(Sock_c);
          end;
        end;
      end; // listen
    end; // if(bind)
    closesocket(Sock_e);
  end; // if(Sock_e)
  WSACleanup;
end;
 
function ThServer(Param: Pointer): DWORD; stdcall;
begin
  Server;
  Result:= 0;
end;
 
procedure StopServer;
begin
  Terminated:= true;
  WSACleanup;
  WaitForSingleObject(hThread, INFINITE);
  CloseHandle(hThread);
end;
 
procedure StartThServer;
begin
  hThread:= CreateThread(nil, 0, @ThServer, nil, 0, ThreadId);
end;
 
end.

El de la parte visual es más largo, solo decir que para arrancar el servidor hace esto:

delphi

procedure TForm1.FormCreate(Sender: TObject);
//.......................
  // Creamos un Mutex para sincronización de hilos
  Mutex:= CreateMutex(nil, false, '_AntiInjectorProtect_');
 
  // Ponemos en marcha el servidor
  StartThServer;
 
  // Enviamos los archivos a la dll
  Send;
end;

Al cerrarse hace esto:

delphi

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  SortIcon.Free;
  StopServer;
  CloseHandle(Mutex);
  UnInyectServer(Edit2.Text);
end;

 

Subo el código funcional.

 

 

Saludos.

Attached Files

•  AntiInject.rar   286.85KB   24 downloads
•  Server.jpg   42.64KB   0 downloads

[Dante]

nunca dejas de sorprenderme

[Dante]

Quiero ponerle una bd embebida q complemento puedo usar en delphi7 para esto

[escafandra]

Para una app tan pequeña quizás mejor que una bd, es una tabla plana cómo la que ya usa, aunque en el ejemplo está encriptada. Además te aporta la ventaja de no depender de motores externos.

 

Saludos.

[escafandra]

Como complemento a todo lo anterior el sistema puede usarse para inyectar desde el cliente una dll similar a la expuesta aquí. Para esconderla, la hardcodeamos previamente. Al ejecutar el cliente, éste la libera y provoca la inyección.

 

Este sería el código del truco:

delphi

program PassClient;
 
uses
  Windows,
  UPassClient in 'UPassClient.pas',
  Hookdll_ in 'Hookdll_.pas';
 
const
 DllName: PCHAR = 'Hookdll.dll';
 
procedure GlobalHook; stdcall external 'HookDll';
procedure GlobalUnHook; stdcall external 'HookDll';
 
 
procedure ExtractHookdll;
var
  hFile: THANDLE;
begin
  hFile:= CreateFile(DllName, GENERIC_WRITE, 0, nil, CREATE_ALWAYS, FILE_FLAG_WRITE_THROUGH, 0);
  if hFile <> INVALID_HANDLE_VALUE then
  begin
    _lwrite(hFile, @Hookdll_Bytes[0], Hookdll_Size);
    CloseHandle(hFile);
  end;  
end;
 
begin
  ExtractHookdll;
  GlobalHook;
  Client;
end.

Con esto tenemos un sistema completo de vigilancia Cliente-Servidor con apoyo de anti-inyecciones en el cliente

 

Subo el código funcional y en armas.

 

 

Saludos.

[escafandra]

Demos un poco de seguridad al sistema cliente:

 

1.- La dll irá hardcodeada con su Hash MD5, el Hash se comprobará tras crear la dll y si coincide arrancará el cliente.

2.- El nombre de la dll estará encriptado en el código fuente y se desencriptará cuando haga falta.

3.- Dado que la dll puede no estar presente, a la hora de arrancar la app cliente, las funciones usadas de la dll se importan dinámicamente, si falla, no arranca el cliente

delphi

program PassClient;
 
uses
  Windows,
  UPassClient in 'UPassClient.pas',
  Hookdll_ in 'Hookdll_.pas',
  UMD5 in 'UMD5.pas';
 
type
  PGlobalHook   = procedure; stdcall;
  PGlobalUnHook = procedure; stdcall;
 
 
var
 Clave: PCHAR  = '76349714';
 DllName: array [0..11] of CHAR = (#127, #89, #92, #95, #93, #91, #93, #26, #83, #90, #95, #0);
 
//procedure GlobalHook; stdcall external 'HookDll';
//procedure GlobalUnHook; stdcall external 'HookDll';
 
procedure Crypt(Source: Pointer; Size: Cardinal; Password: PCHAR; _Mod: integer);
var
  S: PCHAR;
  len, n: integer;
begin
   S:= Source;
   len:= lstrlen(Password);
   for n:=0 to Size-1 do
   begin
     S[n]:= CHAR(integer(S[n]) xor integer(Password[_Mod mod len]));
     inc(_Mod);
   end;
end;
 
function ExtractHookdll: BOOL;
var
  hFile: THANDLE;
  MD5: TMD5;
begin
  Result:= FALSE;
  hFile:= CreateFile(DllName, GENERIC_WRITE, 0, nil, CREATE_ALWAYS, FILE_FLAG_WRITE_THROUGH, 0);
  if hFile <> INVALID_HANDLE_VALUE then
  begin
    _lwrite(hFile, @Hookdll_Bytes[0], Hookdll_Size);
    CloseHandle(hFile);
    GetMD5FromFile(DllName, MD5);
    Result:= lstrcmpi(Hookdll_MD5, MD5) = 0;
  end;
end;
 
 
 
var
  hLib: HMODULE;
  GlobalHook: PGlobalHook;
begin
  Crypt(@DllName[0], sizeof(DllName)-1, Clave, 0);
  if ExtractHookdll then
  begin
    hLib:= LoadLibrary(DllName);
    if hLib <> 0 then
    begin
      GlobalHook:= GetProcAddress(hLib, 'GlobalHook');
      if @GlobalHook <> nil then
      begin
        GlobalHook;
        Client;
      end;
    end;
  end;
end.

4.- Si queremos añadir otro punto más de seguridad, podemos incluir en la dll una función o procedimiento vital para el cliente que no podrá ejecutarse sin ella presente he íntegra, de esta forma prescindimos de condicionales, Al tener por un lado condicionales y por otro, dependencias, confundimos al cracker y complicamos su trabajo.

 

 

Saludos.

Attached Files

•  Client+Hook.rar   75.06KB   44 downloads