目录
1. 前言
先看【Delphi Http Https 最好的解决方法(一)】再看这篇文章.
在 【Delphi Http Https 最好的解决方法(一)】，工具类定义了两个TIdHttp对象，一个用于http，另一个用于https请求。
后来我在其他项目中使用该接口的时候，遇到一个问题。
我上传1w条数据记录，我用这个接口来上传数据，碰巧这个请求耗时较长，一个请求要10秒左右，这个耗时太长了，我自己也看不下去了。所以， 【Delphi Http Https 最好的解决方法(一)】的生产使用环境有限，我就搞整了一个类似数据库连接池的工具类，在接口初始化的时候就能够创建多个TIdHttp对象，用于http和https,在上传模块，开启多个线程上传，测试时候开启了10个线程，每个线程处理1000个数据，算是达到要求了。
其实代码和【Delphi Http Https 最好的解决方法(一)】在一起的,在此我简单说明下，分享下。
2.功能代码
2.1. 接口单元 InterfaceDll.pas
unit InterfaceDll;
interface
uses
unt_objects, Winapi.Windows, System.SysUtils, System.Classes, EncdDecd, Qjson;
var
tool: 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;
//<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
//-----------------------连接池 网络请求部分------------------------------------
//>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
//初始化
function dll_Pool_init: Byte; stdcall;
//Post
function dll_Pool_post(sUrl, sJson, sHeader: PWideChar; var sOut: PWideChar): Byte; stdcall;
//Get
function dll_Pool_get(sUrl, sJson, sHeader: PWideChar; var sOut: PWideChar): Byte; stdcall;
//释放
function dll_Pool_uninit: Byte; stdcall;
//<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
implementation
uses uPub, uSuperObject, qaes;
//测试
function dll_test: Byte; stdcall;
begin
Result:= 1;
end;
//-------------------------普通 网络请求部分------------------------------------
//>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
//初始化
function dll_init: Byte;
begin
Result:= 0;
if not Assigned(tool) then
tool:= TTools.Create;
Result:= 1;
end;
/// <summary>
/// POST请求
/// </summary>
function dll_post(sUrl, sJson, sHeader: PWideChar; var sOut: PWideChar): Byte;
var
json, jsArr: TQjson;
I:integer;
bHttps: Boolean;
begin
Result:= 0;
bHttps:= (Pos('https:', sUrl)>0);
if Assigned(tool) then
begin
if tool._debug then
systemLog('[dll_post]: '+ AnsiString(sJson));
json:= TQJson.Create;
try
json.Parse(sHeader);
tool._Https.Request.CustomHeaders.Clear;
jsArr:= json.ItemByName('params');
if jsArr<> nil then
begin
for I := 0 to jsArr.Count- 1 do
tool._Https.Request.CustomHeaders.Values[jsArr.Items[I].ValueByName('key','')]:= jsArr.Items[I].ValueByName('value','')
end;
finally
FreeAndNil(json);
end;
Result:= tool.SendPost(bHttps, sUrl, sJson, sOut);
end
else
begin
systemLog('[dll_post]: '+ Err_02);
Exit;
end;
end;
//Get
function dll_get(sUrl, sJson, sHeader: PWideChar; var sOut: PWideChar): Byte;
var
json: ISuperObject;
jsArr: TSuperArray;
I:integer;
bHttps: Boolean;
begin
Result:= 0;
sOut:= '';
bHttps:= (Pos('https:', sUrl)>0);
if Assigned(tool) then
begin
if tool._debug then
systemLog('[dll_post]: '+ AnsiString(sJson));
if sHeader<>'' then
json:= SO(sHeader);
if json<>nil then
begin
tool._Https.Request.CustomHeaders.Clear;
jsArr:= json.O['headers'].AsArray;
for I := 0 to jsArr.Length- 1 do
begin
if bHttps then
tool._Https.Request.CustomHeaders.Values[jsArr.O[I].S['key']]:= jsArr.O[I].S['value']
else
tool._Https.Request.CustomHeaders.Values[jsArr.O[I].S['key']]:= jsArr.O[I].S['value'];
end;
end;
Result:= tool.SendGet(bHttps, sUrl, sJson, sOut);
end
else
begin
systemLog('[dll_get]: '+ Err_02);
Exit;
end;
end;
//释放
function dll_uninit: Byte;
begin
result:= 0;
if Assigned(tool) then
FreeAndNil(tool);
result:= 1;
end;
//<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
//-----------------------连接池 网络请求部分------------------------------------
//>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
//初始化
function dll_Pool_init: Byte; stdcall;
begin
Result:= 0;
if not Assigned(pools) then
pools:= THttpConnectopnPool.Create(nil);
Result:= 1;
end;
//Post
function dll_Pool_post(sUrl, sJson, sHeader: PWideChar; var sOut: PWideChar): Byte; stdcall;
var
json, jsArr: TQjson;
I:integer;
bHttps: Boolean;
conn: THttpConnection;
begin
Result:= 0;
bHttps:= (Pos('https:', sUrl)>0);
if not Assigned(pools) then
begin
systemLog('[dll_post]: '+ Err_02);
Exit;
end;
conn:= pools.getHttpConnection(bHttps);
try
json:= TQJson.Create;
try
json.Parse(sHeader);
conn.Request.CustomHeaders.Clear;
jsArr:= json.ItemByName('params');
if jsArr<> nil then
begin
for I := 0 to jsArr.Count- 1 do
conn.Request.CustomHeaders.Values[jsArr.Items[I].ValueByName('key','')]:= jsArr.Items[I].ValueByName('value','')
end;
finally
FreeAndNil(json);
end;
Result:= conn.SendPost(bHttps, sUrl, sJson, sOut);
finally
pools.returnHttpConnection(bHttps, conn);
end;
end;
//Get
function dll_Pool_get(sUrl, sJson, sHeader: PWideChar; var sOut: PWideChar): Byte; stdcall;
var
json: ISuperObject;
jsArr: TSuperArray;
I:integer;
bHttps: Boolean;
conn: THttpConnection;
begin
Result:= 0;
sOut:= '';
bHttps:= (Pos('https:', sUrl)>0);
if not Assigned(pools) then
begin
systemLog('[dll_get]: '+ Err_02);
Exit;
end;
conn:= pools.getHttpConnection(bHttps);
try
if sHeader<>'' then
json:= SO(sHeader);
if json<>nil then
begin
tool._Https.Request.CustomHeaders.Clear;
jsArr:= json.O['headers'].AsArray;
for I := 0 to jsArr.Length- 1 do
begin
if bHttps then
tool._Https.Request.CustomHeaders.Values[jsArr.O[I].S['key']]:= jsArr.O[I].S['value']
else
tool._Https.Request.CustomHeaders.Values[jsArr.O[I].S['key']]:= jsArr.O[I].S['value'];
end;
end;
Result:= conn.SendGet(bHttps, sUrl, sJson, sOut);
finally
pools.returnHttpConnection(bHttps, conn);
end;
end;
//释放
function dll_Pool_uninit: Byte; stdcall;
begin
Result:= 0;
if Assigned(pools) then
FreeAndNil(pools);
Result:= 1;
end;
//<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
end.2.2. 工具类 unt_objects.pas
unit unt_objects;
interface
uses
Winapi.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;
const
Err_02= '创建对象失败...';
GFileName= 'set.ini';
type
//普通Http请求
TTools= class
private
FDebug : Boolean; //调试模式
FHttp : TIdHTTP; //HTTP专用
FHttps : TIdHTTP; //HTTPS专用
FBusy : Boolean; //是否忙碌
FIdSSL : TIdSSLIOHandlerSocketOpenSSL;
procedure DisConnect(bHttps: Boolean);
published
property _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;
public
constructor 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;
//Http Https连接池
THttpConnection= class(TIdHTTP)
public
//发送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;
THttpConnectopnPool= class(TComponent)
private
fDefault: Integer; //默认连接池数量
fIdleSec: Integer; //默认连接空闲时间(s)
fReqSec: Integer; //默认请求超时时间(s)
fHttpConnList: TComponentList; //连接池对象容易
fHttpsConnList: TComponentList; //连接池对象容易
fCleanTimer: TTimer; //连接池定时器
procedure fCleanTimerEvent(sender: TObject); //定时器事件
procedure fClean; //清理空闲链接
function fCreateHttpConnection(bHttps: Boolean= False): THttpConnection; //创建新链接
protected
function getConnectionCount: Integer; //获取连接池数量
function getUnixTimeStampSecond: Integer;
public
constructor Create(owner: TComponent);
destructor Destroy; override;
property ConnctionCount: Integer read getConnectionCount;
function getHttpConnection(bHttps: Boolean= false): THttpConnection; //获取连接
function returnHttpConnection(bHttps: Boolean; conn: THttpConnection): Boolean; //归还连接
end;
implementation
uses uPub;
{ TTools }
constructor TTools.Create;
var
sIni: TIniFile;
begin
FHttp := 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) then
begin
sIni:= TIniFile.Create(ExtractFilePath(Paramstr(0))+GFileName);
try
case sIni.ReadInteger('hq','sslver',1) of
0: 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;
finally
FreeAndNil(sIni);
end;
end;
FHttps.IOHandler:= FIdSSL;
end;
destructor TTools.Destroy;
begin
if Assigned(FHttps) then
FreeAndNil(FHttps);
if Assigned(FHttp) then
FreeAndNil(FHttp);
inherited;
end;
procedure TTools.DisConnect(bHttps: Boolean);
begin
if bHttps then
begin
if FHttps.Connected then
FHttps.Disconnect;
end
else
begin
if FHttp.Connected then
FHttp.Disconnect;
end;
end;
function TTools.SendGet(bHttps: Boolean; sUrl, sJson: PWideChar; var sOut: PWideChar): Byte;
var
ResponseStream: TStringStream;
begin
Result:= 0;
sOut:= '';
DisConnect(bHttps);
ResponseStream:= TStringStream.Create('', TEncoding.UTF8);
try
try
systemLog('Snd: '+ sJson);
FHttps.Get(sUrl, ResponseStream);
sOut:= PWideChar(UTF8Decode(AnsiToUtf8(ResponseStream.DataString)));
systemLog('Rcv: '+ sOut);
Result:= 1;
except
on e: Exception do
begin
systemLog('exp: '+ e.Message);
end;
end;
finally
DisConnect(bHttps);
end;
end;
function TTools.SendPost(bHttps: Boolean; sUrl, sJson: PWideChar; var sOut: PWideChar): Byte;
var
ResquestStream,ResponseStream : TStringStream;
begin
Result:= 0;
sOut:= '';
DisConnect(bHttps);
try
systemLog('Snd: '+ sJson);
ResquestStream := TStringStream.Create(UTF8Encode(sJson));
ResponseStream := TStringStream.Create('', TEncoding.UTF8);
//ResponseStream := TStringStream.Create('');
try
if bHttps then
FHttps.Post(sUrl, ResquestStream, ResponseStream)
else
FHttp.Post(sUrl, ResquestStream, ResponseStream);
sOut := PWideChar(UTF8Decode(AnsiToUtf8(ResponseStream.DataString)));
//sOut := PWideChar(UTF8Decode(WideString(ResponseStream.DataString)));
systemLog('Rcv: '+ sOut);
Result:= 1;
except
on e: Exception do
systemLog('Exp: '+ e.Message);
end;
finally
DisConnect(bHttps);
end;
end;
{ THttpConnection }
function THttpConnection.SendGet(bHttps: Boolean; sUrl, sJson: PWideChar;
var sOut: PWideChar): Byte;
var
ResponseStream: TStringStream;
begin
Result:= 0;
sOut:= '';
DisConnect(bHttps);
ResponseStream:= TStringStream.Create('', TEncoding.UTF8);
try
try
systemLog('Snd: '+ sJson);
Get(sUrl, ResponseStream);
sOut:= PWideChar(UTF8Decode(AnsiToUtf8(ResponseStream.DataString)));
systemLog('Rcv: '+ sOut);
Result:= 1;
except
on e: Exception do
begin
systemLog('exp: '+ e.Message);
end;
end;
finally
DisConnect(bHttps);
end;
end;
function THttpConnection.SendPost(bHttps: Boolean; sUrl, sJson: PWideChar;
var sOut: PWideChar): Byte;
var
ResquestStream,ResponseStream : TStringStream;
begin
Result:= 0;
sOut:= '';
DisConnect(bHttps);
try
systemLog('Snd: '+ sJson);
ResquestStream := TStringStream.Create(UTF8Encode(sJson));
ResponseStream := TStringStream.Create('', TEncoding.UTF8);
//ResponseStream := TStringStream.Create('');
try
if bHttps then
Post(sUrl, ResquestStream, ResponseStream)
else
Post(sUrl, ResquestStream, ResponseStream);
sOut := PWideChar(UTF8Decode(AnsiToUtf8(ResponseStream.DataString)));
//sOut := PWideChar(UTF8Decode(WideString(ResponseStream.DataString)));
systemLog('Rcv: '+ sOut);
Result:= 1;
except
on e: Exception do
systemLog('Exp: '+ e.Message);
end;
finally
DisConnect(bHttps);
end;
end;
{ THttpConnectopnPool }
constructor THttpConnectopnPool.Create(owner: TComponent);
begin
inherited Create(owner);
fDefault:= 20;
fIdleSec:= 600;
if not Assigned(fHttpConnList) then
fHttpConnList:= TComponentList.Create;
if not Assigned(fHttpsConnList) then
fHttpsConnList:= TComponentList.Create;
if (fCleanTimer= nil) then
begin
fCleanTimer:= TTimer.Create(Self);
fCleanTimer.Name:= 'CleanTimer';
fCleanTimer.Interval:= 10* 60* 1000;
fCleanTimer.OnTimer:= fCleanTimerEvent;
fCleanTimer.Enabled:= True;
end;
end;
destructor THttpConnectopnPool.Destroy;
var
index: Integer;
http: TIdHttp;
begin
for index := fHttpConnList.Count-1 downto 0 do
begin
http:= TIdHttp(fHttpConnList[index]);
http.Disconnect;
FreeAndNil(http);
end;
for index := fHttpsConnList.Count-1 downto 0 do
begin
http:= TIdHttp(fHttpsConnList[index]);
http.Disconnect;
FreeAndNil(http);
end;
inherited;
end;
procedure THttpConnectopnPool.fClean;
var
index, iNow: Integer;
begin
iNow:= getUnixTimeStampSecond;
for index:= fHttpConnList.Count-1 downto 0 do
begin
if THttpConnection(fHttpConnList[index]).Tag>0 then //未使用得连接
begin
if fHttpConnList.Count> fDefault then
begin
if iNow-THttpConnection(fHttpConnList[index]).Tag> fIdleSec then
fHttpConnList.Delete(index);
end;
end
else
begin
if iNow+ THttpConnection(fHttpConnList[index]).Tag> fReqSec then
begin
fHttpConnList.Delete(index);
if fHttpConnList.Count< fDefault then
fHttpConnList.Add(fCreateHttpConnection);
end;
end;
end;
for index:= fHttpsConnList.Count-1 downto 0 do
begin
if THttpConnection(fHttpsConnList[index]).Tag>0 then //未使用得连接
begin
if fHttpsConnList.Count> fDefault then
begin
if iNow-THttpConnection(fHttpsConnList[index]).Tag> fIdleSec then
fHttpsConnList.Delete(index);
end;
end
else
begin
if iNow+ THttpConnection(fHttpsConnList[index]).Tag> fReqSec then
begin
fHttpsConnList.Delete(index);
if fHttpsConnList.Count< fDefault then
fHttpsConnList.Add(fCreateHttpConnection(True));
end;
end;
end;
end;
procedure THttpConnectopnPool.fCleanTimerEvent(sender: TObject);
begin
TTimer(sender).Enabled:= False;
try
try
fClean;
except
on e: Exception do
systemLog('[fCleanTimerEvent]: '+ e.Message);
end;
finally
TTimer(sender).Enabled:= True;
end;
end;
function THttpConnectopnPool.fCreateHttpConnection(bHttps: Boolean): THttpConnection;
var
FHttp: THttpConnection;
FIdSSL : TIdSSLIOHandlerSocketOpenSSL;
sIni: TIniFile;
begin
Result:= nil;
FHttp:= THttpConnection.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:= 60* 1000;
FHttp.ConnectTimeout:= 60* 1000;
if bHttps then
begin
FIdSSL := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
FIdSSL.SSLOptions.Method:= sslvSSLv23;
FIdSSL.SSLOptions.Mode:= sslmClient;
if FileExists(ExtractFilePath(Paramstr(0))+GFileName) then
begin
sIni:= TIniFile.Create(ExtractFilePath(Paramstr(0))+GFileName);
try
case sIni.ReadInteger('hq','sslver',1) of
0: 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;
finally
FreeAndNil(sIni);
end;
end;
FHttp.IOHandler:= FIdSSL;
end;
Result:= FHttp;
end;
function THttpConnectopnPool.getConnectionCount: Integer;
begin
//
end;
function THttpConnectopnPool.getHttpConnection(bHttps: Boolean): THttpConnection;
var
index: Integer;
begin
Result:= nil;
if bHttps then
begin
for index := 0 to fHttpsConnList.Count- 1 do
begin
if THttpConnection(fHttpsConnList[index]).Tag>0 then
begin
Result:= THttpConnection(fHttpsConnList[index]);
Result.Tag:= - getUnixTimeStampSecond;
end;
end;
if Result= nil then
begin
Result:= fCreateHttpConnection(bHttps);
Result.Tag:= - getUnixTimeStampSecond;
fHttpsConnList.Add(Result);
end;
end
else
begin
for index := 0 to fHttpConnList.Count- 1 do
begin
if THttpConnection(fHttpConnList[index]).Tag>0 then
begin
Result:= THttpConnection(fHttpConnList[index]);
Result.Tag:= - getUnixTimeStampSecond;
end;
end;
if Result= nil then
begin
Result:= fCreateHttpConnection(bHttps);
Result.Tag:= - getUnixTimeStampSecond;
fHttpConnList.Add(Result);
end;
end;
if (Result<> nil) and (Result.Connected) then
Result.Disconnect;
end;
function THttpConnectopnPool.getUnixTimeStampSecond: Integer;
begin
Result:= DateTimeToUnix(Now)-8*60*60;
end;
function THttpConnectopnPool.returnHttpConnection(bHttps: Boolean; conn: THttpConnection): Boolean;
begin
if bHttps then
Result:= fHttpsConnList.IndexOf(conn)>-1
else
Result:= fHttpConnList.IndexOf(conn)>-1;
if Result then
begin
if conn.Connected then
conn.Disconnect;
conn.Tag:= getUnixTimeStampSecond;
end;
end;
end.2.3. 公共单元 uPub.pas
unit uPub;
interface
uses
System.SysUtils, System.Classes, qaes, qstring, IdHashMessageDigest, IdHash;
type
TMD5= class(TIdHashMessageDigest5);
TAppPara = class
public
class function AppPath: string;
class function AppName: string;
end;
TFilePath = class(TAppPara)
public
class 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;
implementation
procedure systemLog(Msg: AnsiString);
var
F: TextFile;
FileName: string;
ExeRoad: string;
begin
try
ExeRoad := ExtractFilePath(ParamStr(0));
if ExeRoad[Length(ExeRoad)] = '\' then
SetLength(ExeRoad, Length(ExeRoad) - 1);
if not DirectoryExists(ExeRoad + 'log') then
begin
CreateDir(ExeRoad + '\log');
end;
FileName := ExeRoad + '\log\DLL_Log' + FormatDateTime('YYMMDD', NOW) + '.txt';
if not FileExists(FileName) then
begin
AssignFile(F, FileName);
ReWrite(F);
end
else
AssignFile(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);
var
AInitVector: TQAESBuffer;
AKeyType: TQAESKeyType;
I: Integer;
begin
case keyType of
0:
AKeyType := kt128;
1:
AKeyType := kt192;
2:
AKeyType := kt256;
end;
if aesModel= 0 then
AES.AsECB(sKey, AKeyType)
else
begin
for I := 1 to Length(sIv) do
AInitVector[I-1]:= byte(sIv[I-1]);
AES.AsCBC(AInitVector, sKey, AKeyType);
end;
//AES.PaddingMode在AES.AsECB AES.AsCBC中是默认值的 所以在以下进行单独设置
case paddingmodel of
0:
AES.PaddingMode:= pmZero;
1:
AES.PaddingMode:= pmPKCS5;
2:
AES.PaddingMode:= pmPKCS7;
end;
end;
//字符串转MD5
function StrToMD5(sIn: WideString): WideString;
var
Md5Encode: TMD5;
begin
Md5Encode:= TMD5.Create;
result:= Md5Encode.HashToHex(Md5Encode.HashString(UTF8Encode(sIn)));
Md5Encode.Free;
end;
{ TAppPara }
class function TAppPara.AppName: string;
begin
Result := ExtractFileName(ParamStr(0));
end;
class function TAppPara.AppPath: string;
begin
Result := ExtractFilePath(ParamStr(0));
end;
{ TFilePath }
class function TFilePath.IniFile: string;
begin
Result := AppPath + 'set.ini';
end;
end.2.4. dll工程导出函数
exports
dll_init,
dll_post,
dll_get,
dll_uninit,
dll_pool_init,
dll_pool_post,
dll_pool_get,
dll_pool_uninit;2.5. 配置文件 set.ini
[hq]
sslver=1---------------------------------------------------------------------------------------------------------------------------------
3. 结语
欢迎大家指教，该dll我用于不同项目中，请求正常。
如果生产环境上传单一，两种请求方式都可以，如果用到请求频繁，直接使用连接池方式。
678
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
