Delphi класс SSL сокетов
Вот убирал с компа многое что лишнее и нашел один свой исходник для работы с SSL по-быстрому всё оформил в виде класса. Судя по всему довольно актуальная тема сейчас. Класс реализует простейшие функции - коннект, чтение данных, запись данных и дисконнект. Мож чуть еще он и сыроват, но всё таки работает.
А теперь обовсём по порядку.
И так, собственно говоря сам файл SSLSocket.pas
Код:
// (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. А также кнопку
и далее простой код обработчика клика на кнопку:
Код:
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 текст от яндекса:
Цитата:
HTTP/1.0 301 Moved Permanently
Connection: close
Location: http://yandex.ru
Content-Length: 0
Date: Sat, 03 Oct 2009 19:25:33 GMT
Server: lighttpd/1.4.20
|
а во втором мемо - страница ачата.
Ну вот и всё
(С) SLESH |
