建设银行给税对账在什么网站,杭州行业网页设计公司,华为外包一般能干多久,美食网站建设策划书范文当前文章主要解决Delphi调用http、https的常见报错。
开发工具: Delphi XE 10.1 Berlin版本
可能所需的控件包#xff1a; QDAC 请自行下载。
1. 接口描述 dll_init 接口初始化#xff0c;程序启动时调用#xff0c;主要是对工具类实例的创建 dll_post 发送post请求 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;charsetUTF-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;charsetUTF-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 jsonnil 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个月了运行正常检查日志无报错。
有需要的朋友可以自行修改设计成自己需要的。
代码虽然贴出来了但是还是希望能够自己敲下加深理解。
如果有好的建议或发现问题请留言我也好改进、学习.
