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

news/2024/4/25 22:06:59/文章来源:https://blog.csdn.net/ceaningking/article/details/129134306

当前文章主要解决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个月了,运行正常,检查日志无报错。

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

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

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

本文来自互联网用户投稿,该文观点仅代表作者本人,不代表本站立场。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如若转载,请注明出处:http://www.luyixian.cn/news_show_72115.aspx

如若内容造成侵权/违法违规/事实不符,请联系dt猫网进行投诉反馈email:809451989@qq.com,一经查实,立即删除!

相关文章

python实现快速排序算法

文章目录1. 快速排序2. 步骤3. 详细代码4. 性能5. 相关链接1. 快速排序 快速排序&#xff08;英语&#xff1a;Quicksort&#xff09;&#xff0c;又称划分交换排序&#xff08;partition-exchange sort&#xff09;&#xff0c;通过一趟排序将要排序的数据分割成独立的两部分…

小公司“混”的3年,我认真做了5件事,真的受益终生

小公司“混”的3年&#xff0c;我认真做了5件事&#xff0c;真的受益终生 目录&#xff1a;导读 功能测试很重要但不值钱 自动化测试在小公司没市场&#xff0c;但是你得会 给自己的一些忠告 第一件事&#xff1a;分清阶段&#xff0c;制定计划 第二件事&#xff1a;梳理…

HTTP安全与HTTPS协议

目录 Http协议的安全问题 常见的加密方式 防止窃听 单向散列函数 单向散列值的特点 加密与解密 对称加密与非对称加密 对称加密的密钥配送问题 密钥配送问题的解决 非对称加密 前言&#xff1a; 公钥与私钥 非对称加密过程 混合密码系统 前言&#xff1a; 混合…

央行罚单!金融机构被罚原因揭秘

近日&#xff0c;人民银行公布了2023年首批行政处罚罚单&#xff0c;引发业内广泛关注。 顶象防御云业务安全情报中心统计了人民银行官网&#xff0c;2020年1月至2023年2月10日期间&#xff0c;公布的101份行政处罚。 统计显示&#xff0c;16家金融机构被罚27066.9万元&#…

易点天下基于 StarRocks 全面构建实时离线一体的湖仓方案

作者&#xff1a;易点天下数据平台团队易点天下是一家技术驱动发展的企业国际化智能营销服务公司&#xff0c;致力于为客户提供全球营销推广服务&#xff0c;通过效果营销、品牌塑造、垂直行业解决方案等一体化服务&#xff0c;帮助企业在全球范围内高效地获取用户、提升品牌知…

【Linux】vim拒绝服务安全漏洞修复

根据国家信息安全漏洞共享平台于2023年2月19日发布的安全漏洞通知&#xff0c;Linux系统自带的vim编辑器存在两个高危安全漏洞&#xff08;CNVD-2023-09166、CNVD-2023-09647&#xff09;&#xff0c;攻击者可以利用该漏洞发起拒绝服务攻击&#xff0c;并可能运行&#xff08;恶…

CAS 和 synchronized 优化过程

CAS: CAS相对于计算器&#xff08;count&#xff09;来说&#xff0c;count在多线程的环境下是线程不安全的&#xff0c;那么就必须得加锁&#xff0c;而加了锁性能就会大打折扣&#xff0c;所以就有了CAS而CAS的操作是原子的&#xff0c;从而会保证线程的安全。本质操作是将线…

列表推导式_Python教程

内容摘要 Python中存在一种特殊的表达式&#xff0c;名为推导式&#xff0c;它的作用是将一种数据结构作为输入&#xff0c;再经过过滤计算等处理&#xff0c;最后输出另一种数据结构。根据数据结构的不同会被分为列表推导式、 文章正文 Python中存在一种特殊的表达式&#x…

2022年网络安全政策态势分析与2023年立法趋势

近日&#xff0c;公安部第三研究所网络安全法律研究中心与 360 集团法务中心联合共同发布了《全球网络安全政策法律发展年度报告&#xff08;2022&#xff09;》。《报告》概览2022年全球网络安全形势与政策法律态势&#xff0c;并对2023年及后续短期内网络安全政策、立法趋势进…

TCP状态详解

TCP Tcp wrappers : Transmission Control Protocol (TCP) Wrappers 为由 inetd 生成的服务提供了增强的安全性。TCP Wrappers 是一种对使用 /etc/inetd.sec 的替换方法。TCP Wrappers 提供防止主机名和主机地址欺骗的保护。欺骗是一种伪装成有效用户或主机以获得对系统进行未…

linux集群技术(二)--keepalived(高可用集群)(二)

案例1--keepalived案例2--keepalived Lvs集群1.案例1--keepalived 1.1 环境 初识keepalived&#xff0c;实现web服务器的高可用集群。 Server1: 192.168.26.144 Server2: 192.168.26.169 VIP: 192.168.26.190 1.2 server1 创建etc下的…

网上插画教学哪家质量好,汇总5大插画培训班

网上插画教学哪家质量好&#xff1f;给大家梳理了国内5家专业的插画师培训班&#xff0c;最新五大插画班排行榜&#xff0c;各有优势和特色&#xff01; 一&#xff1a;国内知名插画培训机构排名 1、轻微课&#xff08;五颗星&#xff09; 主打课程有日系插画、游戏原画、古风插…

2023年测试人跳槽新功略,涨薪10K+

软件测试是如何实现涨薪的呢&#xff1f;很多人眼中的软件测试岗位可能是简单的&#xff0c;技术含量不是那么高&#xff0c;就是看看需求、看业务、设计文档、然后点一点功能是否实现&#xff0c;再稍微深入一点就是测试下安装部署时会不会出现兼容性问题&#xff0c;以及易用…

技术学习-消息队列

什么是消息队列 可以简单理解为存放消息的队列&#xff0c;数据结构模型和队列一样&#xff0c;都是先进先出。主要用不同线程(Thread)/进程(Process) 为什么需要消息队列 (1)不同进程之间传递消息是&#xff0c;因为进程的耦合度高&#xff0c;改动一个进程&#xff0c;引发…

npm 上传自己的包

mkdir demo 创建一个新的文件夹 npm init 初始化项目 生成一个package.json文件 name version description等等touch index.js 创建一个node 可执行脚本新的js 文件 #!/usr/bin/env node // 必须在文件头加如上内容指定运行环境为node console.log(hello cli)在package.json 中…

【教程】GitStats代码统计工具(附GitLab API相关)

使用GitStats进行代码统计 官方文档&#xff1a;GitStats - git history statistics generator GitStats是基于Git的数据统计生成器&#xff0c;输出格式为HTML&#xff0c;可直接在浏览器打开查看&#xff0c;展现为图表形式的可视化数据&#xff0c;内容包括&#xff1a; 常…

图像识别技术解析:手写数字识别(一)

本文通过构建一个手写数字识别的程序来解析来自机器学习与深度学习的不同算法的特点&#xff0c;以及如何对识别效果进行改进。 一、如何构建一个手写数字识别程序 首先可以考虑构建一个简单的页面用于用户输入&#xff0c;也就是前端&#xff1b;接下来需要准备一个后端用于…

mac 好用的类似Xshell工具

下载royal TSX 5.1.1 http://share.uleshi.com/f/9490615-685692355-33bf1e修改mac的etc/hosts文件权限访达(鼠标右键) -> 前往文件夹 ->输入/private --> 打开etc/hosts --> 显示简洁(鼠标右键) --> 权限改成读和写hosts文件写入如下内容&#xff1a;# Royal T…

空间直线方程及其与面线的夹角

一、空间直线的方程 1.1 空间直线的一般方程 空间直线 LLL 可以看做是两个平面 Π1\Pi_1Π1​ 和 Π2\Pi_2Π2​ 的交线&#xff0c;那么就可以用两个平面方程来表示这个直线&#xff1a; {A1xB1yC1zD10A2xB2yC2zD20(1)\left\{ \begin{aligned} A_1xB_1yC_1zD_10\\ A_2xB_2yC…

卷起来了,2023金三银四自动化测试面试题精选【字节二面】

面试一般分为技术面和hr面&#xff0c;形式的话很少有群面&#xff0c;少部分企业可能会有一个交叉面&#xff0c;不过总的来说&#xff0c;技术面基本就是考察你的专业技术水平的&#xff0c;hr面的话主要是看这个人的综合素质以及家庭情况符不符合公司要求&#xff0c;一般来…