devbox
在线问答5
这个屌丝很懒，什么也没留下！
关注作者
热门标签
热门文章
当前位置:   article > 正文

Delphi Http Https 最好的解决方法(一)_delphi tls

作者：在线问答5 | 2024-06-26 18:42:20

赞

踩

delphi tls

当前文章主要解决Delphi调用http、https的常见报错。

开发工具: Delphi XE 10.1 Berlin版本

可能所需的控件包： QDAC 请自行下载。

1. 接口描述

  dll_init 接口初始化，程序启动时调用，主要是对工具类实例的创建
  dll_post 发送post请求，支持http、https
  dll_get 发送get请求，支持http、https
  dll_uninit 接口释放，程序关闭时调用，主要是对工具类实例的释放

2. 参数说明

function dll_post(sUrl, sJson, sHeader: PWideChar; var sOut: PWideChar): Byte; stdcall;

function dll_get(sUrl, sJson, sHeader: PWideChar; var sOut: PWideChar): Byte; stdcall;

sUrl: 请求地址

sJson: 请求的入参，JSON格式如下(这个json只是一个例子，也可以是其他复杂json入参):

  1. { 
  2.     "loginName": "*****",
  3.     "loginPass": "*****"
  4. }

sHeader: 请求头，固定格式如下，如果没有请求头，传空值:

  1. {
  2.     "params":[
  3.         {"key":"key1","value":"value1"},
  4.         {"key":"key2","value":"value2"},
  5.     ]
  6. }

sOut: 输出请求返回的数据信息

请求返回值 Byte类型 0 失败 1 成功

3. 完整代码如下

3.1 工具类

工具类实际就是内部创建了indy对象，一个用于http请求，一个用于https请求。

  1. unit unt_objects;
  2.  
  3. interface
  4.  
  5. uses
  6.   Winapi.Windows, Winapi.Messages, IdHTTP, IdSSLOpenSSL, System.SysUtils,
  7.   System.Classes, System.IniFiles, System.StrUtils, System.Variants,
  8.   Winapi.Security.Cryptography, Winapi.WinRT, Winapi.CommonTypes, System.Win.WinRT,
  9.   Contnrs, Vcl.ExtCtrls, System.DateUtils;
  10.  
  11. const
  12.   Err_02= '创建对象失败...';
  13.   GFileName= 'set.ini';
  14.  
  15. type
  16.   //普通Http请求
  17.   TTools= class
  18.   private
  19.     FDebug    : Boolean;            //调试模式
  20.     FHttp     : TIdHTTP;            //HTTP专用
  21.     FHttps    : TIdHTTP;            //HTTPS专用
  22.     FBusy     : Boolean;            //是否忙碌
  23.     FIdSSL    : TIdSSLIOHandlerSocketOpenSSL;
  24.     procedure DisConnect(bHttps: Boolean);
  25.   published
  26.     property _debug: Boolean read FDebug write FDebug;
  27.     property _Https: TIdHTTP read FHttps write FHttps;
  28.     property _Http: TIdHTTP read FHttp write FHttp;
  29.     property _Busy: Boolean read FBusy write FBusy;
  30.   public
  31.     constructor Create();
  32.     destructor Destroy; override;
  33.  
  34.     //发送Post请求
  35.     function SendPost(bHttps: Boolean; sUrl, sJson: PWideChar; var sOut: PWideChar): Byte;
  36.     //发送Get请求
  37.     function SendGet(bHttps: Boolean; sUrl, sJson: PWideChar; var sOut: PWideChar): Byte;
  38.   end;
  39.  
  40. implementation
  41.  
  42. uses uPub;
  43.  
  44. { TTools }
  45.  
  46. constructor TTools.Create;
  47. var
  48.   sIni: TIniFile;
  49. begin
  50.   FHttp  := Tidhttp.Create(nil);
  51.   FHttp.HTTPOptions := [hoKeepOrigProtocol];          //关键参数， 关系到编码自动转换
  52.   FHttp.HandleRedirects:= True;
  53.   FHttp.ProtocolVersion:= pv1_1;
  54.   FHttp.Request.Accept:= '*/*';
  55.   FHttp.Request.ContentType:= 'application/json;charset=UTF-8';
  56.   FHttp.Request.Connection:= 'close';
  57.   FHttp.ReadTimeout:= 30* 1000;
  58.   FHttp.ConnectTimeout:= 30* 1000;
  59.  
  60.   FHttps  := Tidhttp.Create(nil);
  61.   FHttps.HTTPOptions := [hoKeepOrigProtocol];
  62.   FHttps.HandleRedirects:= True;
  63.   FHttps.ProtocolVersion:= pv1_1;
  64.   FHttps.Request.Accept:= '*/*';
  65.   FHttps.Request.ContentType:= 'application/json;charset=UTF-8';
  66.   FHttps.Request.Connection:= 'close';
  67.   FHttps.ReadTimeout:= 30* 1000;
  68.   FHttps.ConnectTimeout:= 30* 1000;
  69.  
  70.   FIdSSL  := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
  71.   FIdSSL.SSLOptions.Method:= sslvSSLv23;
  72.   FIdSSL.SSLOptions.Mode:= sslmClient;
  73.  
  74.   if FileExists(ExtractFilePath(Paramstr(0))+GFileName) then
  75.   begin
  76.     sIni:= TIniFile.Create(ExtractFilePath(Paramstr(0))+GFileName);
  77.     try
  78.       case sIni.ReadInteger('hq','sslver',1) of
  79.         0: FIdSSL.SSLOptions.Method:= sslvSSLv2;
  80.         1: FIdSSL.SSLOptions.Method:= sslvSSLv23;
  81.         2: FIdSSL.SSLOptions.Method:= sslvSSLv3;
  82.         3: FIdSSL.SSLOptions.Method:= sslvTLSv1;
  83.         4: FIdSSL.SSLOptions.Method:= sslvTLSv1_1;
  84.         5: FIdSSL.SSLOptions.Method:= sslvTLSv1_2;
  85.       end;
  86.     finally
  87.       FreeAndNil(sIni);
  88.     end;
  89.   end;
  90.  
  91.   FHttps.IOHandler:= FIdSSL;
  92. end;
  93.  
  94. destructor TTools.Destroy;
  95. begin
  96.   if Assigned(FHttps) then
  97.     FreeAndNil(FHttps);
  98.   if Assigned(FHttp) then
  99.     FreeAndNil(FHttp);
  100.   inherited;
  101. end;
  102.  
  103. procedure TTools.DisConnect(bHttps: Boolean);
  104. begin
  105.   if bHttps then
  106.   begin
  107.     if FHttps.Connected then
  108.       FHttps.Disconnect;
  109.   end
  110.   else
  111.   begin
  112.     if FHttp.Connected then
  113.       FHttp.Disconnect;
  114.   end;
  115. end;
  116.  
  117. function TTools.SendGet(bHttps: Boolean; sUrl, sJson: PWideChar; var sOut: PWideChar): Byte;
  118. var
  119.   ResponseStream: TStringStream;
  120. begin
  121.   Result:= 0;
  122.   sOut:= '';
  123.   DisConnect(bHttps);
  124.   ResponseStream:= TStringStream.Create('', TEncoding.UTF8);
  125.   try
  126.     try
  127.       systemLog('Snd: '+ sJson);
  128.       FHttps.Get(sUrl, ResponseStream);
  129.       sOut:= PWideChar(UTF8Decode(AnsiToUtf8(ResponseStream.DataString)));
  130.       systemLog('Rcv: '+ sOut);
  131.       Result:= 1;
  132.     except
  133.       on e: Exception do
  134.       begin
  135.         systemLog('exp: '+ e.Message);
  136.       end;
  137.     end;
  138.   finally
  139.     DisConnect(bHttps);
  140.   end;
  141. end;
  142.  
  143. function TTools.SendPost(bHttps: Boolean; sUrl, sJson: PWideChar; var sOut: PWideChar): Byte;
  144. var
  145.   ResquestStream,ResponseStream : TStringStream;
  146. begin
  147.   Result:= 0;
  148.   sOut:= '';
  149.   DisConnect(bHttps);
  150.   try
  151.     systemLog('Snd: '+ sJson);
  152.     ResquestStream := TStringStream.Create(UTF8Encode(sJson));
  153.     ResponseStream := TStringStream.Create('', TEncoding.UTF8);
  154.     //ResponseStream := TStringStream.Create('');
  155.     try
  156.       if bHttps then
  157.         FHttps.Post(sUrl, ResquestStream, ResponseStream)
  158.       else
  159.         FHttp.Post(sUrl, ResquestStream, ResponseStream);
  160.       sOut := PWideChar(UTF8Decode(AnsiToUtf8(ResponseStream.DataString)));
  161.       //sOut := PWideChar(UTF8Decode(WideString(ResponseStream.DataString)));
  162.       systemLog('Rcv: '+ sOut);
  163.       Result:= 1;
  164.     except
  165.       on e: Exception do
  166.         systemLog('Exp: '+ e.Message);
  167.     end;
  168.   finally
  169.     DisConnect(bHttps);
  170.   end;
  171. end;
  172.  
  173.  
  174. end.

3.2 公共类

  1. unit uPub;
  2.  
  3. interface
  4.  
  5. uses
  6.   System.SysUtils, System.Classes, qaes, qstring, IdHashMessageDigest, IdHash;
  7.  
  8. type
  9.   TMD5= class(TIdHashMessageDigest5);
  10.  
  11.   TAppPara = class
  12.   public
  13.     class function AppPath: string;
  14.     class function AppName: string;
  15.   end;
  16.  
  17.   TFilePath = class(TAppPara)
  18.   public
  19.     class function IniFile: string;
  20.   end;
  21.  
  22. //写日志
  23. procedure systemLog(Msg: AnsiString);
  24. //AES对象初始化
  25. procedure InitEncrypt(sKey, sIv: PWideChar; aesModel, keyType, paddingmodel: integer; var AES: TQAES);
  26. //字符串转MD5
  27. function StrToMD5(sIn: WideString): WideString;
  28.  
  29. implementation
  30.  
  31. procedure systemLog(Msg: AnsiString);
  32. var
  33.   F: TextFile;
  34.   FileName: string;
  35.   ExeRoad: string;
  36. begin
  37.   try
  38.     ExeRoad := ExtractFilePath(ParamStr(0));
  39.     if ExeRoad[Length(ExeRoad)] = '\' then
  40.       SetLength(ExeRoad, Length(ExeRoad) - 1);
  41.     if not DirectoryExists(ExeRoad + 'log') then
  42.     begin
  43.       CreateDir(ExeRoad + '\log');
  44.     end;
  45.     FileName := ExeRoad + '\log\DLL_Log' + FormatDateTime('YYMMDD', NOW) + '.txt';
  46.     if not FileExists(FileName) then
  47.     begin
  48.       AssignFile(F, FileName);
  49.       ReWrite(F);
  50.     end
  51.     else
  52.       AssignFile(F, FileName);
  53.     Append(F);
  54.     Writeln(F, FormatDateTime('HH:NN:SS.zzz ', Now) + Msg);
  55.     CloseFile(F);
  56.   except
  57.     //可能在事务中调用,避免意外
  58.     Exit;
  59.   end;
  60. end;
  61.  
  62. procedure InitEncrypt(sKey, sIv: PWideChar; aesModel, keyType, paddingmodel: integer; var AES: TQAES);
  63. var
  64.   AInitVector: TQAESBuffer;
  65.   AKeyType: TQAESKeyType;
  66.   I: Integer;
  67. begin
  68.   case keyType of
  69.     0:
  70.       AKeyType := kt128;
  71.     1:
  72.       AKeyType := kt192;
  73.     2:
  74.       AKeyType := kt256;
  75.   end;
  76.   if aesModel= 0 then
  77.     AES.AsECB(sKey, AKeyType)
  78.   else
  79.   begin
  80.     for I := 1 to Length(sIv) do
  81.       AInitVector[I-1]:= byte(sIv[I-1]);
  82.     AES.AsCBC(AInitVector, sKey, AKeyType);
  83.   end;
  84.   //AES.PaddingMode在AES.AsECB  AES.AsCBC中是默认值的 所以在以下进行单独设置
  85.   case paddingmodel of
  86.     0:
  87.       AES.PaddingMode:= pmZero;
  88.     1:
  89.       AES.PaddingMode:= pmPKCS5;
  90.     2:
  91.       AES.PaddingMode:= pmPKCS7;
  92.   end;
  93. end;
  94.  
  95. //字符串转MD5
  96. function StrToMD5(sIn: WideString): WideString;
  97. var
  98.   Md5Encode: TMD5;
  99. begin
  100.   Md5Encode:= TMD5.Create;
  101.   result:= Md5Encode.HashToHex(Md5Encode.HashString(UTF8Encode(sIn)));
  102.   Md5Encode.Free;
  103. end;
  104.  
  105. { TAppPara }
  106.  
  107. class function TAppPara.AppName: string;
  108. begin
  109.   Result := ExtractFileName(ParamStr(0));
  110. end;
  111.  
  112. class function TAppPara.AppPath: string;
  113. begin
  114.   Result := ExtractFilePath(ParamStr(0));
  115. end;
  116.  
  117. { TFilePath }
  118.  
  119. class function TFilePath.IniFile: string;
  120. begin
  121.   Result := AppPath + 'set.ini';
  122. end;
  123.  
  124. end.

3.3 接口类

  1. unit InterfaceDll;
  2.  
  3. interface
  4.  
  5. uses
  6.   unt_objects, Winapi.Windows, System.SysUtils, System.Classes, EncdDecd, Qjson;
  7.  
  8. var
  9.   tool: TTools;
  10.   pools: THttpConnectopnPool;
  11.  
  12. //----------------------------------测试部分------------------------------------
  13. //>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  14.  
  15. //测试
  16. function dll_test: Byte; stdcall;
  17.  
  18. //<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  19.  
  20. //-------------------------普通 网络请求部分------------------------------------
  21. //>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  22.  
  23. //初始化
  24. function dll_init: Byte; stdcall;
  25. //Post
  26. function dll_post(sUrl, sJson, sHeader: PWideChar; var sOut: PWideChar): Byte; stdcall;
  27. //Get
  28. function dll_get(sUrl, sJson, sHeader: PWideChar; var sOut: PWideChar): Byte; stdcall;
  29. //释放
  30. function dll_uninit: Byte; stdcall;
  31.  
  32. //<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  33.  
  34. implementation
  35.  
  36. uses uPub, uSuperObject, qaes;
  37.  
  38. //测试
  39. function dll_test: Byte; stdcall;
  40. begin
  41.   Result:= 1;
  42. end;
  43.  
  44. //-------------------------普通 网络请求部分------------------------------------
  45. //>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  46.  
  47. //初始化
  48. function dll_init: Byte;
  49. begin
  50.   Result:= 0;
  51.   if not Assigned(tool) then
  52.     tool:= TTools.Create;
  53.   Result:= 1;
  54. end;
  55.  
  56. /// <summary>
  57. ///   POST请求
  58. /// </summary>
  59. function dll_post(sUrl, sJson, sHeader: PWideChar; var sOut: PWideChar): Byte;
  60. var
  61.   json, jsArr: TQjson;
  62.   I:integer;
  63.   bHttps: Boolean;
  64. begin
  65.   Result:= 0;
  66.   bHttps:= (Pos('https:', sUrl)>0);
  67.   if Assigned(tool) then
  68.   begin
  69.     if tool._debug then
  70.       systemLog('[dll_post]: '+ AnsiString(sJson));
  71.     json:= TQJson.Create;
  72.     try
  73.       json.Parse(sHeader);
  74.       tool._Https.Request.CustomHeaders.Clear;
  75.       jsArr:= json.ItemByName('params');
  76.       if jsArr<> nil then
  77.       begin
  78.         for I := 0 to jsArr.Count- 1 do
  79.           tool._Https.Request.CustomHeaders.Values[jsArr.Items[I].ValueByName('key','')]:= jsArr.Items[I].ValueByName('value','')
  80.       end;
  81.     finally
  82.       FreeAndNil(json);
  83.     end;
  84.     Result:= tool.SendPost(bHttps, sUrl, sJson, sOut);
  85.   end
  86.   else
  87.   begin
  88.     systemLog('[dll_post]: '+ Err_02);
  89.     Exit;
  90.   end;
  91. end;
  92.  
  93. //Get
  94. function dll_get(sUrl, sJson, sHeader: PWideChar; var sOut: PWideChar): Byte;
  95. var
  96.   json: ISuperObject;
  97.   jsArr: TSuperArray;
  98.   I:integer;
  99.   bHttps: Boolean;
  100. begin
  101.   Result:= 0;
  102.   sOut:= '';
  103.   bHttps:= (Pos('https:', sUrl)>0);
  104.   if Assigned(tool) then
  105.   begin
  106.     if tool._debug then
  107.       systemLog('[dll_post]: '+ AnsiString(sJson));
  108.     if sHeader<>'' then
  109.       json:= SO(sHeader);
  110.     if json<>nil then
  111.     begin
  112.       tool._Https.Request.CustomHeaders.Clear;
  113.       jsArr:= json.O['headers'].AsArray;
  114.       for I := 0 to jsArr.Length- 1 do
  115.       begin
  116.         if bHttps then
  117.           tool._Https.Request.CustomHeaders.Values[jsArr.O[I].S['key']]:= jsArr.O[I].S['value']
  118.         else
  119.           tool._Https.Request.CustomHeaders.Values[jsArr.O[I].S['key']]:= jsArr.O[I].S['value'];
  120.       end;
  121.     end;
  122.     Result:= tool.SendGet(bHttps, sUrl, sJson, sOut);
  123.   end
  124.   else
  125.   begin
  126.     systemLog('[dll_get]: '+ Err_02);
  127.     Exit;
  128.   end;
  129. end;
  130.  
  131. //释放
  132. function dll_uninit: Byte;
  133. begin
  134.   result:= 0;
  135.   if Assigned(tool) then
  136.     FreeAndNil(tool);
  137.   result:= 1;
  138. end;
  139.  
  140. //<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  141.  
  142.  
  143. end.

3.4 工程文件

  1. uses
  2.   System.SysUtils,
  3.   System.Classes,
  4.   unt_objects in 'unt_objects.pas',
  5.   uPub in 'uPub.pas',
  6.   InterfaceDll in 'InterfaceDll.pas' {$R *.res},
  7.   uSuperObject in '..\public\uSuperObject.pas';
  8.  
  9. {$R *.res}
  10.  
  11. exports
  12.  
  13.   dll_init,
  14.   dll_post,
  15.   dll_get,
  16.   dll_uninit;
  17.  
  18. begin
  19. end.

4. Demo引用

  1. const
  2.   dllName= 'HelpTool.dll';
  3.  
  4.   //普通网络请求部分
  5.  
  6.   function dll_init: Byte; stdcall; external dllName;
  7.  
  8.   function dll_post(sUrl, sJson, sHeader: PWideChar; var sOut: PWideChar): Byte; stdcall; external dllName;
  9.  
  10.   function dll_get(sUrl, sJson, sHeader: PWideChar; var sOut: PWideChar): Byte; stdcall; external dllName;
  11.  
  12.   function dll_uninit: Byte; stdcall; external dllName;

当前运用于实际项目中，跑了2个月了，运行正常，检查日志无报错。

有需要的朋友可以自行修改设计成自己需要的。

代码虽然贴出来了，但是还是希望能够自己敲下，加深理解。

如果有好的建议，或发现问题，请留言，我也好改进、学习.

本文内容由网友自发贡献，转载请注明出处：【wpsshop博客】
推荐阅读
相关标签

Copyright © 2003-2013 www.wpsshop.cn 版权所有，并保留所有权利。

  

闽ICP备14008679号