SoftHub关联区 - delphi7 中indy9 自带的 openssl ，怎么支持最新版本的openssl？

您的位置：首页 >> SoftHub关联区 >> 主题: delphi7 中indy9 自带的 openssl ，怎么支持最新版本的openssl？ [回主站] [分站链接]

您的位置：首页 >> SoftHub关联区 >> 主题: delphi7 中indy9 自带的 openssl ，怎么支持最新版本的openssl？ [最新] [回主站]

delphi7 中indy9 自带的 openssl ，怎么支持最新版本的openssl？

guest

浏览(649) - 2018-05-18 10:53:01 发表编辑

给本帖添加超大文件下载链接

关键字: delphi

[2022-06-23 22:01:50 最后更新]
delphi 7 indy9 中的OPENSSL dll，不能支持最新的openssl，导致很多https站不能正确访问，要修改项目又不可能，斑竹大虾可提供下解决方案？

:) :)

clq 2018-05-18 23:05:52 发表编辑

来了：）

先传一个临时链接，等有空再放到 github 维护吧。

http://newbt.net/down/IdSSLOpenSSLHeaders.zip

注意 openssl 的版本很多，这个文件要和

http://newbt.net/ms/vdisk/show_bbs.php?id={420943C8-066B-F923-9B3B-E24D3252EA9F}&pid=160

或者

http://newbt.net/ms/vdisk/show_bbs.php?id=6D794CF6CD414A2811BE50B2F09D57D7&pid=159

的文件配合使用。

clq 2018-05-18 23:07:10 发表编辑

unit gmail_pub2;

//代替原来的 gmail_pub1.pas 因为原来的 c++ dll 代码丢失了

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
IdSSLOpenSSLHeaders, openssl_h,
IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient,
Dialogs, StdCtrls, WinSock;

//接口函数
type

//Tcreate_ssl_struct = function():pchar; stdcall;
Tcreate_ssl_struct = function():integer; stdcall;
Tfree_ssl_struct = procedure(p:integer); stdcall;
//Tssl_send_buf = function(ssl:pchar; buf:pchar; len:integer):integer; stdcall;
Tssl_send_buf = function(ssl:integer; buf:pchar; len:integer):integer; stdcall;
//Tssl_recv_buf = function(ssl:pchar; buf:pchar; len:integer):integer; stdcall;
Tssl_recv_buf = function(ssl:integer; buf:pchar; len:integer):integer; stdcall;
//Tconnect_ssl = function(ssl:pchar):integer; stdcall;
//Tconnect_ssl = function(ssl:integer):integer; stdcall;
Tconnect_ssl_pop = function(ssl:integer):integer; stdcall;
Tconnect_ssl_smtp = function(ssl:integer):integer; stdcall;
Tdisconnect_ssl = procedure(ssl:integer); stdcall;

(*
char * __stdcall create_ssl_struct();//生成结构
void __stdcall free_ssl_struct(char * p);//删除结构
int __stdcall ssl_send_buf(s_ssl * ssl, const char * buf, int len);//发送数据
int __stdcall ssl_recv_buf(s_ssl * ssl, char * buf, int len);//接收数据
void __stdcall disconnect_ssl(s_ssl * ssl);//关闭连接ssl的服务器
int __stdcall connect_ssl(s_ssl * ssl);//连接ssl的服务器//返回值:0 - 失败,1 - 成功
*)

type
PSSL_Struct = ^SSL_Struct;
SSL_Struct = record
    IdTCPClient1:TIdTCPClient;
    ssl_ctx:PSSL_CTX;
    ssl:PSSL;
    fd:TSocket;
end;

function create_ssl_struct():integer;
procedure free_ssl_struct(p:integer);
function connect_ssl(_ssl:integer; host:string; port:Integer; timeout:Integer = 10*1000):integer;
procedure disconnect_ssl(ssl:integer);
function ssl_send_buf(ssl:integer; buf:pchar; len:integer):integer;
function ssl_recv_buf(ssl:integer; buf:pchar; len:integer):integer;

//var

// connect_ssl_pop:Tconnect_ssl_pop;
// connect_ssl_smtp:Tconnect_ssl_smtp;
//
//
// dll_handle1:integer;

procedure ssl_init;
procedure ssl_exit;


implementation

function create_ssl_struct():integer;
var
pssl:PSSL_Struct;
begin
New(pssl);
Result := Integer(pssl);
end;

procedure free_ssl_struct(p:integer);
var
pssl:PSSL_Struct;
begin
pssl := PSSL_Struct(p);

Dispose(pssl);
end;

function ssl_send_buf(ssl:integer; buf:pchar; len:integer):integer;
var
pssl:PSSL_Struct;
begin
pssl := PSSL_Struct(ssl);

//SSL_write(ssl,"hello world",strlen("hello world!"));
Result := SSL_write(pssl.ssl, buf, len);

//Dispose(pssl);
end;

function ssl_recv_buf(ssl:integer; buf:pchar; len:integer):integer;
var
pssl:PSSL_Struct;
begin
pssl := PSSL_Struct(ssl);

//SSL_write(ssl,"hello world",strlen("hello world!"));
//Result := SSL_write(pssl.ssl, buf, len);
Result := SSL_read(pssl.ssl, buf, len);

//Dispose(pssl);
end;

procedure disconnect_ssl(ssl:integer);
var
pssl:PSSL_Struct;
begin
pssl := PSSL_Struct(ssl);

//SSL_write(ssl,"hello world",strlen("hello world!"));
//Result := SSL_write(pssl.ssl, buf, len);
//Result := SSL_read(pssl.ssl, buf, len);

//断开SSL链接
SSL_shutdown(pssl.ssl);
//释放当前SSL链接结构体
SSL_free(pssl.ssl);
//断开TCP链接
//closesocket(sClient);
try
pssl.IdTCPClient1.Disconnect();
except end;
//释放SSL上下文
SSL_CTX_free(pssl.ssl_ctx);

end;

function connect_ssl(_ssl:integer; host:string; port:Integer; timeout:Integer = 10*1000):integer;
var
IdTCPClient1:TIdTCPClient;

meth:PSSL_METHOD;
ctx:PSSL_CTX;
ssl:PSSL;
fd:TSocket;
err:Integer;
buf:array[0..1023] of AnsiChar;

//--------------------------------------------------
pssl:PSSL_Struct;
begin
pssl := PSSL_Struct(_ssl);
fd := 0;
//--------------------------------------------------

IdTCPClient1 := TIdTCPClient.Create(Application);
//--------------------------------------------------
//"pop.gmail.com", 995
//Socket = HttpConnect ("smtp.gmail.com", 465);

//IdTCPClient1.Host := 'smtp.163.com';
//IdTCPClient1.Port := 465;
IdTCPClient1.Host := host;
IdTCPClient1.Port := port;

try
//IdTCPClient1.Connect(10*1000); //单位是毫秒吗
IdTCPClient1.Connect(timeout); //单位是毫秒吗

fd := IdTCPClient1.Socket.Binding.Handle;
IdTCPClient1.ReadTimeout := timeout;
except
Result := 0; //失败
end;

//--------------------------------------------------
    //建立SSL
    //SSL * ssl = SSL_new(ctx);

    //OpenSSL_add_ssl_algorithms(); /*初始化*/

    SSLeay_add_ssl_algorithms();             //这两个函数在最新的 openssl 头文件中都是宏定义的，所以要自己再写一个
////    OpenSSL_add_all_algorithms();        //这两个函数在最新的 openssl 头文件中都是宏定义的，所以要自己再写一个

    ///*生成一个ssl结构*/
////    meth = SSLv23_client_method(); //尝试 ssl3 不行就用 ssl2
    //meth = SSLv3_client_method();
    //TLSv1_client_method
    ////meth = DTLSv1_2_client_method(); //这个是 udp 的协议，不能用在 163 邮箱
    ////meth = TLSv1_2_client_method(); //选择具体的 tls 1.2 协议
    ////meth = TLSv1_2_client_method();
    meth := TLS_client_method(); //用这个最好，据说可以自动选择最高版本的 tls ，如果没有 tls 的话还会向下选择 ssl

    ctx := SSL_CTX_new(meth);
    ssl := SSL_new(ctx);

    ///*下面是正常的socket过程*/
    //fd = socket();
    //connect();

    ///*把建立好的socket和ssl结构联系起来*/
    SSL_set_fd(ssl,fd);

    ///*ssl的握手过程*/
    SSL_connect(ssl);

//--------------------------------------------------
pssl.ssl_ctx := ctx;
pssl.ssl := ssl;
pssl.IdTCPClient1 := IdTCPClient1;

Result := 1;//Integer(ssl); //对吗?
end;

procedure ssl_init;
var
WSAData1: TWSAData;
begin

WSAStartup(MAKEWORD(2, 2), WSAData1);//记得一定要有这个

IdSSLOpenSSLHeaders.Load(); //d7 中已经加入的函数
LoadOpenSSL_DLL_add(); //一些新的函数

end;

procedure ssl_exit;
begin
//FreeLibrary(dll_handle1);
end;

procedure TForm1_Button1Click(Sender: TObject);
var
//p1:pchar;
p1:integer;
buf1:array[0..4096] of char;
r1:integer;
s1:string;
begin
    {
    if (@create_ssl_struct <> nil) and (@free_ssl_struct<> nil) then
    begin
      p1:=0;
      memo1.Lines.Add(inttostr(p1));
      p1:=create_ssl_struct();
      memo1.Lines.Add(inttostr(p1));
      r1:=connect_ssl_pop(p1);
      memo1.Lines.Add(inttostr(r1));

      r1:=ssl_recv_buf(p1, buf1, sizeof(buf1));
      buf1[r1]:=#0;
      memo1.Lines.Add(inttostr(r1));
      memo1.Lines.Add(buf1);

      //对话
      s1:='USER clq.mail@gmail.com'#13#10;
      r1:=ssl_send_buf(p1, pchar(s1), length(s1));
      memo1.Lines.Add('s:'+inttostr(r1));

      r1:=ssl_recv_buf(p1, buf1, sizeof(buf1));
      buf1[r1]:=#0;
      memo1.Lines.Add(inttostr(r1));
      memo1.Lines.Add(buf1);

      s1:='PASS '+edit1.text+#13#10;
      r1:=ssl_send_buf(p1, pchar(s1), length(s1));
      memo1.Lines.Add('s:'+inttostr(r1));

      r1:=ssl_recv_buf(p1, buf1, sizeof(buf1));
      buf1[r1]:=#0;
      memo1.Lines.Add(inttostr(r1));
      memo1.Lines.Add(buf1);

      s1:='LIST'#13#10;
      r1:=ssl_send_buf(p1, pchar(s1), length(s1));
      memo1.Lines.Add(inttostr(r1));

      r1:=ssl_recv_buf(p1, buf1, sizeof(buf1));
      buf1[r1]:=#0;
      memo1.Lines.Add(inttostr(r1));
      memo1.Lines.Add(buf1);

      //MessageDlg('Registry success',mtInformation, [mbOk], 0);
    end;
    }
end;

end.

dphlover 2018-05-19 12:04:20 发表编辑

谢谢了!

我刚测试访问站点 https://www.paypal.com/ 提示 0000000错误，我跟踪调试了下，看到好些函数都没有load ，是nil。

我目前看到以下函数

@IdSslLoadErrorStrings

@IdSslMethodV2
@IdSslMethodServerV2
@IdSslMethodClientV2

@IdSslMethodV3
@IdSslMethodServerV3
@IdSslMethodClientV3
@IdSslMethodV23
@IdSslMethodServerV23
@IdSslMethodClientV23

@IdSslAddSslAlgorithms
@IdSslCtxSetInfoCallback
@IdSslX509StoreCtxGetAppData

@IdSslSessionGetId
@IdSslSessionGetIdCtx
@IdSslCtxGetVersion

@IdSslCtxSetOptions

@IdSslX509GetNotBefore
@IdSslX509GetNotAfter

@iddes_set_odd_parity
@iddes_set_key

@iddes_ecb_encrypt

后面我导出 LIBSSL-1_1.DLL 的函数名称，上边很多函数不存在。该怎么处理呢？

dphlover 2018-05-19 12:05:24 发表编辑

我采用的indy 的 TidHTTP 组件

clq 2018-05-19 21:21:31 发表编辑

不用全部。就算导出全部也没用。要看我上面的例子，那就是完整的 ssl/tls 连接支持了，在上面加一层 http 协议就行了。直接套用 TidHTTP这样的组件应该是不行的，我们只是利用 indy 的函数声明而已，不是修正 indy 组件让它支持某个 openssl 版本。具体可以看我在百家号关于 ssl 的几篇文章。不过不了解决 http 协议的话也是没用。具体来说我实现的是宝剑连接，要在上面再自己做 http 或者别的，例如我另外一项目用来实现 smtp 和 pop3 的安全连接版本。其实这和 openssl 无关，关键还是其他的编程能力和经验。这此要靠你自己积累了，一时半会我也不可能在这里把 http 和你说清。这些协议是很多的，所以不会去封装成直接可用的安全版本的 http/smtp/pop3 这样的，因为时间也不允许而且也没有必要，如果暂时不了解 http 怎么实现，那么建议还是直接用别人封装好的 https 实现吧 -- 例如用 dll 直接调用 curl 就好了。

总数：5　页次：1/1　首页尾页　　

所在合集/目录

发表评论:

本帖子属于以下条目(delphi)

delphi收集目录

Delphi 10.3 Community Edition[免费社区版]

NEWBT官方QQ群1: 276678893
可求档连环画,漫画;询问文本处理大师等软件使用技巧;求档softhub软件下载及使用技巧.
但不可"开车",严禁国家敏感话题,不可求档涉及版权的文档软件.
验证问题说明申请入群原因即可.