Delphi класс SSL сокетов

Discussion in 'С/С++, C#, Rust, Swift, Go, Java, Perl, Ruby' started by slesh, 3 Oct 2009.

  1. slesh

    slesh Elder - Старейшина

    Joined:
    5 Mar 2007
    Messages:
    2,702
    Likes Received:
    1,223
    Reputations:
    455
    Вот убирал с компа многое что лишнее и нашел один свой исходник для работы с SSL по-быстрому всё оформил в виде класса. Судя по всему довольно актуальная тема сейчас. Класс реализует простейшие функции - коннект, чтение данных, запись данных и дисконнект. Мож чуть еще он и сыроват, но всё таки работает.
    А теперь обовсём по порядку.

    И так, собственно говоря сам файл SSLSocket.pas

    Code:
    // (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.
    
    
    Теперь можно продолжать дальше.
    Создаем тестовую программку.
    В uses прописываем SSLSocket
    на корму кидаем memo1 и memo2. А также кнопку
    и далее простой код обработчика клика на кнопку:
    Code:
    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;
    
    ну и главное: кидаем в папку с прогой саму либу ssl.
    Это файлы:
    libeay32.dll
    ssleay32.dll
    тем кому влом искать их, могут взять файлы из QIP Infium:
    openlibeay32.dll
    openssleay32.dll

    только в модуле SSLSocket заменить
    const SSL_LIB_NAME = 'ssleay32.dll';
    на
    const SSL_LIB_NAME = 'openssleay32.dll';

    И вот запускаем прожку, жмем на кнопку. и через некоторое время появляется в первом memo текст от яндекса:
    а во втором мемо - страница ачата.
    Ну вот и всё
    (С) SLESH
     
    #1 slesh, 3 Oct 2009
    Last edited: 3 Oct 2009
    4 people like this.
  2. seregahowe

    seregahowe Elder - Старейшина

    Joined:
    25 Jun 2011
    Messages:
    148
    Likes Received:
    36
    Reputations:
    15
    Не работает, кто может подсказать в чем дело? И возможно ли как-то оживить данный модуль? Спасибо!
     
Loading...