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

当前文章主要解决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入参):

{ "loginName": "*****","loginPass": "*****"
}

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

{"params":[{"key":"key1","value":"value1"},{"key":"key2","value":"value2"},]
}

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

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

3. 完整代码如下

3.1 工具类

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

unit unt_objects;interfaceusesWinapi.Windows, Winapi.Messages, IdHTTP, IdSSLOpenSSL, System.SysUtils,System.Classes, System.IniFiles, System.StrUtils, System.Variants,Winapi.Security.Cryptography, Winapi.WinRT, Winapi.CommonTypes, System.Win.WinRT,Contnrs, Vcl.ExtCtrls, System.DateUtils;constErr_02= '创建对象失败...';GFileName= 'set.ini';type//普通Http请求TTools= classprivateFDebug    : Boolean;            //调试模式FHttp     : TIdHTTP;            //HTTP专用FHttps    : TIdHTTP;            //HTTPS专用FBusy     : Boolean;            //是否忙碌FIdSSL    : TIdSSLIOHandlerSocketOpenSSL;procedure DisConnect(bHttps: Boolean);publishedproperty _debug: Boolean read FDebug write FDebug;property _Https: TIdHTTP read FHttps write FHttps;property _Http: TIdHTTP read FHttp write FHttp;property _Busy: Boolean read FBusy write FBusy;publicconstructor Create();destructor Destroy; override;//发送Post请求function SendPost(bHttps: Boolean; sUrl, sJson: PWideChar; var sOut: PWideChar): Byte;//发送Get请求function SendGet(bHttps: Boolean; sUrl, sJson: PWideChar; var sOut: PWideChar): Byte;end;implementationuses uPub;{ TTools }constructor TTools.Create;
varsIni: TIniFile;
beginFHttp  := Tidhttp.Create(nil);FHttp.HTTPOptions := [hoKeepOrigProtocol];          //关键参数， 关系到编码自动转换FHttp.HandleRedirects:= True;FHttp.ProtocolVersion:= pv1_1;FHttp.Request.Accept:= '*/*';FHttp.Request.ContentType:= 'application/json;charset=UTF-8';FHttp.Request.Connection:= 'close';FHttp.ReadTimeout:= 30* 1000;FHttp.ConnectTimeout:= 30* 1000;FHttps  := Tidhttp.Create(nil);FHttps.HTTPOptions := [hoKeepOrigProtocol];FHttps.HandleRedirects:= True;FHttps.ProtocolVersion:= pv1_1;FHttps.Request.Accept:= '*/*';FHttps.Request.ContentType:= 'application/json;charset=UTF-8';FHttps.Request.Connection:= 'close';FHttps.ReadTimeout:= 30* 1000;FHttps.ConnectTimeout:= 30* 1000;FIdSSL  := TIdSSLIOHandlerSocketOpenSSL.Create(nil);FIdSSL.SSLOptions.Method:= sslvSSLv23;FIdSSL.SSLOptions.Mode:= sslmClient;if FileExists(ExtractFilePath(Paramstr(0))+GFileName) thenbeginsIni:= TIniFile.Create(ExtractFilePath(Paramstr(0))+GFileName);trycase sIni.ReadInteger('hq','sslver',1) of0: FIdSSL.SSLOptions.Method:= sslvSSLv2;1: FIdSSL.SSLOptions.Method:= sslvSSLv23;2: FIdSSL.SSLOptions.Method:= sslvSSLv3;3: FIdSSL.SSLOptions.Method:= sslvTLSv1;4: FIdSSL.SSLOptions.Method:= sslvTLSv1_1;5: FIdSSL.SSLOptions.Method:= sslvTLSv1_2;end;finallyFreeAndNil(sIni);end;end;FHttps.IOHandler:= FIdSSL;
end;destructor TTools.Destroy;
beginif Assigned(FHttps) thenFreeAndNil(FHttps);if Assigned(FHttp) thenFreeAndNil(FHttp);inherited;
end;procedure TTools.DisConnect(bHttps: Boolean);
beginif bHttps thenbeginif FHttps.Connected thenFHttps.Disconnect;endelsebeginif FHttp.Connected thenFHttp.Disconnect;end;
end;function TTools.SendGet(bHttps: Boolean; sUrl, sJson: PWideChar; var sOut: PWideChar): Byte;
varResponseStream: TStringStream;
beginResult:= 0;sOut:= '';DisConnect(bHttps);ResponseStream:= TStringStream.Create('', TEncoding.UTF8);trytrysystemLog('Snd: '+ sJson);FHttps.Get(sUrl, ResponseStream);sOut:= PWideChar(UTF8Decode(AnsiToUtf8(ResponseStream.DataString)));systemLog('Rcv: '+ sOut);Result:= 1;excepton e: Exception dobeginsystemLog('exp: '+ e.Message);end;end;finallyDisConnect(bHttps);end;
end;function TTools.SendPost(bHttps: Boolean; sUrl, sJson: PWideChar; var sOut: PWideChar): Byte;
varResquestStream,ResponseStream : TStringStream;
beginResult:= 0;sOut:= '';DisConnect(bHttps);trysystemLog('Snd: '+ sJson);ResquestStream := TStringStream.Create(UTF8Encode(sJson));ResponseStream := TStringStream.Create('', TEncoding.UTF8);//ResponseStream := TStringStream.Create('');tryif bHttps thenFHttps.Post(sUrl, ResquestStream, ResponseStream)elseFHttp.Post(sUrl, ResquestStream, ResponseStream);sOut := PWideChar(UTF8Decode(AnsiToUtf8(ResponseStream.DataString)));//sOut := PWideChar(UTF8Decode(WideString(ResponseStream.DataString)));systemLog('Rcv: '+ sOut);Result:= 1;excepton e: Exception dosystemLog('Exp: '+ e.Message);end;finallyDisConnect(bHttps);end;
end;end.

3.2 公共类

unit uPub;interfaceusesSystem.SysUtils, System.Classes, qaes, qstring, IdHashMessageDigest, IdHash;typeTMD5= class(TIdHashMessageDigest5);TAppPara = classpublicclass function AppPath: string;class function AppName: string;end;TFilePath = class(TAppPara)publicclass function IniFile: string;end;//写日志
procedure systemLog(Msg: AnsiString);
//AES对象初始化
procedure InitEncrypt(sKey, sIv: PWideChar; aesModel, keyType, paddingmodel: integer; var AES: TQAES);
//字符串转MD5
function StrToMD5(sIn: WideString): WideString;implementationprocedure systemLog(Msg: AnsiString);
varF: TextFile;FileName: string;ExeRoad: string;
begintryExeRoad := ExtractFilePath(ParamStr(0));if ExeRoad[Length(ExeRoad)] = '\' thenSetLength(ExeRoad, Length(ExeRoad) - 1);if not DirectoryExists(ExeRoad + 'log') thenbeginCreateDir(ExeRoad + '\log');end;FileName := ExeRoad + '\log\DLL_Log' + FormatDateTime('YYMMDD', NOW) + '.txt';if not FileExists(FileName) thenbeginAssignFile(F, FileName);ReWrite(F);endelseAssignFile(F, FileName);Append(F);Writeln(F, FormatDateTime('HH:NN:SS.zzz ', Now) + Msg);CloseFile(F);except//可能在事务中调用,避免意外Exit;end;
end;procedure InitEncrypt(sKey, sIv: PWideChar; aesModel, keyType, paddingmodel: integer; var AES: TQAES);
varAInitVector: TQAESBuffer;AKeyType: TQAESKeyType;I: Integer;
begincase keyType of0:AKeyType := kt128;1:AKeyType := kt192;2:AKeyType := kt256;end;if aesModel= 0 thenAES.AsECB(sKey, AKeyType)elsebeginfor I := 1 to Length(sIv) doAInitVector[I-1]:= byte(sIv[I-1]);AES.AsCBC(AInitVector, sKey, AKeyType);end;//AES.PaddingMode在AES.AsECB  AES.AsCBC中是默认值的 所以在以下进行单独设置case paddingmodel of0:AES.PaddingMode:= pmZero;1:AES.PaddingMode:= pmPKCS5;2:AES.PaddingMode:= pmPKCS7;end;
end;//字符串转MD5
function StrToMD5(sIn: WideString): WideString;
varMd5Encode: TMD5;
beginMd5Encode:= TMD5.Create;result:= Md5Encode.HashToHex(Md5Encode.HashString(UTF8Encode(sIn)));Md5Encode.Free;
end;{ TAppPara }class function TAppPara.AppName: string;
beginResult := ExtractFileName(ParamStr(0));
end;class function TAppPara.AppPath: string;
beginResult := ExtractFilePath(ParamStr(0));
end;{ TFilePath }class function TFilePath.IniFile: string;
beginResult := AppPath + 'set.ini';
end;end.

3.3 接口类

unit InterfaceDll;interfaceusesunt_objects, Winapi.Windows, System.SysUtils, System.Classes, EncdDecd, Qjson;vartool: TTools;pools: THttpConnectopnPool;//----------------------------------测试部分------------------------------------
//>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>//测试
function dll_test: Byte; stdcall;//<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<//-------------------------普通 网络请求部分------------------------------------
//>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>//初始化
function dll_init: Byte; stdcall;
//Post
function dll_post(sUrl, sJson, sHeader: PWideChar; var sOut: PWideChar): Byte; stdcall;
//Get
function dll_get(sUrl, sJson, sHeader: PWideChar; var sOut: PWideChar): Byte; stdcall;
//释放
function dll_uninit: Byte; stdcall;//<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<implementationuses uPub, uSuperObject, qaes;//测试
function dll_test: Byte; stdcall;
beginResult:= 1;
end;//-------------------------普通 网络请求部分------------------------------------
//>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>//初始化
function dll_init: Byte;
beginResult:= 0;if not Assigned(tool) thentool:= TTools.Create;Result:= 1;
end;/// <summary>
///   POST请求
/// </summary>
function dll_post(sUrl, sJson, sHeader: PWideChar; var sOut: PWideChar): Byte;
varjson, jsArr: TQjson;I:integer;bHttps: Boolean;
beginResult:= 0;bHttps:= (Pos('https:', sUrl)>0);if Assigned(tool) thenbeginif tool._debug thensystemLog('[dll_post]: '+ AnsiString(sJson));json:= TQJson.Create;tryjson.Parse(sHeader);tool._Https.Request.CustomHeaders.Clear;jsArr:= json.ItemByName('params');if jsArr<> nil thenbeginfor I := 0 to jsArr.Count- 1 dotool._Https.Request.CustomHeaders.Values[jsArr.Items[I].ValueByName('key','')]:= jsArr.Items[I].ValueByName('value','')end;finallyFreeAndNil(json);end;Result:= tool.SendPost(bHttps, sUrl, sJson, sOut);endelsebeginsystemLog('[dll_post]: '+ Err_02);Exit;end;
end;//Get
function dll_get(sUrl, sJson, sHeader: PWideChar; var sOut: PWideChar): Byte;
varjson: ISuperObject;jsArr: TSuperArray;I:integer;bHttps: Boolean;
beginResult:= 0;sOut:= '';bHttps:= (Pos('https:', sUrl)>0);if Assigned(tool) thenbeginif tool._debug thensystemLog('[dll_post]: '+ AnsiString(sJson));if sHeader<>'' thenjson:= SO(sHeader);if json<>nil thenbegintool._Https.Request.CustomHeaders.Clear;jsArr:= json.O['headers'].AsArray;for I := 0 to jsArr.Length- 1 dobeginif bHttps thentool._Https.Request.CustomHeaders.Values[jsArr.O[I].S['key']]:= jsArr.O[I].S['value']elsetool._Https.Request.CustomHeaders.Values[jsArr.O[I].S['key']]:= jsArr.O[I].S['value'];end;end;Result:= tool.SendGet(bHttps, sUrl, sJson, sOut);endelsebeginsystemLog('[dll_get]: '+ Err_02);Exit;end;
end;//释放
function dll_uninit: Byte;
beginresult:= 0;if Assigned(tool) thenFreeAndNil(tool);result:= 1;
end;//<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<end.

3.4 工程文件

usesSystem.SysUtils,System.Classes,unt_objects in 'unt_objects.pas',uPub in 'uPub.pas',InterfaceDll in 'InterfaceDll.pas' {$R *.res},uSuperObject in '..\public\uSuperObject.pas';{$R *.res}exportsdll_init,dll_post,dll_get,dll_uninit;begin
end.

4. Demo引用

constdllName= 'HelpTool.dll';//普通网络请求部分function dll_init: Byte; stdcall; external dllName;function dll_post(sUrl, sJson, sHeader: PWideChar; var sOut: PWideChar): Byte; stdcall; external dllName;function dll_get(sUrl, sJson, sHeader: PWideChar; var sOut: PWideChar): Byte; stdcall; external dllName;function dll_uninit: Byte; stdcall; external dllName;

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

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

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

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