// (C) SLESH
unit SSLSocket;

interface
uses winsock;

type
TSLESH_SSL_Socket = class
  function Connect(ip:string; port:word):boolean;
  function Send(buf:pchar; len:integer):integer;
  function Recv(buf:pchar; len:integer):integer;
  procedure Close;
  constructor Create(InitWinSock:boolean);
  destructor Destroy; override;

 private
  ws:WSAData;
  method:pointer;
  ctx:pointer;
  ssl:pointer;
  caddr:sockaddr_in;
 public
  sock: Tsocket; // сокет. если нужен для какихто других операций
  ErrorFlag:boolean; // если TRUE значит произошла ошибка при создании
  Connected:boolean; // если TRUE значит есть коннект
end;


implementation
 const SSL_LIB_NAME = 'ssleay32.dll';

function SSL_library_init:Integer; cdecl; external SSL_LIB_NAME;
function SSLv2_client_method:Pointer; cdecl; external SSL_LIB_NAME;
function SSL_CTX_new(meth: Pointer):Pointer; cdecl; external SSL_LIB_NAME;
function SSL_new(ctx: Pointer):Pointer; cdecl; external SSL_LIB_NAME;
function SSL_set_fd(s: pointer; fd: tsocket):Integer cdecl; external SSL_LIB_NAME;
function SSL_connect(ssl: pointer):Integer; cdecl; external SSL_LIB_NAME;
procedure SSL_free(ssl: pointer); cdecl; external SSL_LIB_NAME;
function SSL_read(ssl: pointer; buf: PChar; num: Integer):Integer; cdecl; external SSL_LIB_NAME;
function SSL_write(ssl: pointer; buf: PChar; num: Integer):Integer; cdecl; external SSL_LIB_NAME;

// Посылка данных. Указываются:
// адрес буфера и длинна посылаемых данных
function TSLESH_SSL_Socket.Send(buf:pchar; len:integer):integer;
begin
  if Connected then
    result := SSL_write(ssl, buf, len)
  else
    result := 0;
end;

// Прием данных. Указываются:
// адрес буфера и размер буфера
function TSLESH_SSL_Socket.Recv(buf:pchar; len:integer):integer;
begin
  if Connected then
    result := SSL_read(ssl, buf, len)
  else
    result := 0;
end;

// закрытие соединения
procedure TSLESH_SSL_Socket.Close;
begin
  if sock <> INVALID_SOCKET then
  begin
    closesocket(sock);
    sock := INVALID_SOCKET;
  end;

  Connected := false;
end;

// коннект к серваку.Указываются:
// ip адрес или доменное имя
// порт куда коннектится. обычно 443
function TSLESH_SSL_Socket.Connect(ip:string; port:word):boolean;
var
  nip:integer;
  phe:PHostEnt;
begin
  result := false;
  sock := socket(AF_INET, SOCK_STREAM, 0);
  ErrorFlag := sock = INVALID_SOCKET;
  // если сокет создался
  if (ErrorFlag = false) then
  begin
    nip := inet_addr(pansichar(ip));
    if nip = INADDR_NONE then // если указано доменное имя а не IP
    begin
      // резолвим имя
      phe := gethostbyname(pansichar(ip));
      if phe <> nil then
      begin
        nip := integer(pointer(phe^.h_addr^)^);
      end;
    end;

     //  если есть адрес сервера
    if nip <> INADDR_NONE then
    begin
      caddr.sin_family := AF_INET;
      caddr.sin_addr.s_addr := nip;
      caddr.sin_port := htons(port);

      // коннектитмся
      if winsock.connect(sock, caddr, sizeof(caddr)) <> SOCKET_ERROR then
      begin
        // если сконнектились то настраиваем SSL
        SSL_set_fd(ssl, sock);
        SSL_connect(ssl);
        result := true;
      end;
    end;
  end;

  Connected := result;
end;


// конструктор класса
// если  InitWinSock = true то попутно инициализируем winsock
constructor TSLESH_SSL_Socket.Create(InitWinSock:boolean);
begin
  ErrorFlag := true;
  Connected := false;
  if InitWinSock then
  begin
    // инициализируем winsock
    WSAStartUp($101, ws);
  end;

  // инициализируем SSL либу
  SSL_library_init();
  method := SSLv2_client_method();
  if method <> nil then
  begin
    // создаем контексты для использования SSL
    ctx := SSL_CTX_new(method);
    if ctx <> nil then
    begin
      ssl := SSL_new(ctx);
      if ssl <> nil then
      begin
        ErrorFlag := false;
      end;
    end;
  end;
end;

// деструктор
destructor TSLESH_SSL_Socket.Destroy;
begin
  Close; // закроем сокет
  if ssl <> nil then SSL_free(ssl); // закроем либу
end;

end.

var
  buf : string;
  len : integer;
  tmp : array[0..1024] of char; // временный буфер
begin
  ss := TSLESH_SSL_Socket.Create(true); // создаем наш класс
  if not ss.ErrorFlag then // если нет ошибки то продолжаем
  begin
    if ss.Connect('yandex.ru', 443) then // если смогли сконнектится
    begin
      // наш HTTP запрос
      buf := 'GET / HTTP/1.0'#13#10'Host: yandex.ru'#13#10#13#10;
      // посылаем запрос
      ss.Send(pansichar(buf), length(buf));
      buf := '';

      // читаем пришедшие данных
      repeat
        len := ss.Recv(tmp, 1024);
        if len > 0 then buf := buf + copy(tmp, 0, len);
      until len <= 0;
      ss.Close; // закрываем соединение
      // выводим данные в первый мемо
      Memo1.Lines.Text := buf;
    end;

    // теперь будем коннектится к ачата
    if ss.Connect('forum.antichat.ru', 443) then // если смогли сконнектится
    begin
      // наш HTTP запрос
      buf := 'GET / HTTP/1.0'#13#10'Host: forum.antichat.ru'#13#10#13#10;
      // посылаем запрос
      ss.Send(pansichar(buf), length(buf));
      buf := '';

      // читаем пришедшие данных
      repeat
        len := ss.Recv(tmp, 1024);
        if len > 0 then buf := buf + copy(tmp, 0, len);
      until len <= 0;
      ss.Close; // закрываем соединение
      // выводим данные во второй мемо
      Memo2.Lines.Text := buf;
    end;
    ss.Destroy; // завершаем работу
  end;