library dyAuth; { Important note about DLL memory management: ShareMem must be the first unit in your library's USES clause AND your project's (select Project-View Source) USES clause if your DLL exports any procedures or functions that pass strings as parameters or function results. This applies to all strings passed to and from your DLL--even those that are nested in records and classes. ShareMem is the interface unit to the BORLNDMM.DLL shared memory manager, which must be deployed along with your DLL. To avoid using BORLNDMM.DLL, pass string information using PChar or ShortString parameters. Important note about VCL usage: when this DLL will be implicitly loaded and this DLL uses TWicImage / TImageCollection created in any unit initialization section, then Vcl.WicImageInit must be included into your library's USES clause. } uses System.SysUtils, System.Classes, IdHTTP, IdSSLOpenSSL, DateUtils, Neon.Core.Attributes in 'Neon.Core.Attributes.pas', Neon.Core.DynamicTypes in 'Neon.Core.DynamicTypes.pas', Neon.Core.Nullables in 'Neon.Core.Nullables.pas', Neon.Core.Persistence.JSON in 'Neon.Core.Persistence.JSON.pas', Neon.Core.Persistence in 'Neon.Core.Persistence.pas', Neon.Core.Persistence.Swagger in 'Neon.Core.Persistence.Swagger.pas', Neon.Core.Serializers.DB in 'Neon.Core.Serializers.DB.pas', Neon.Core.Serializers.RTL in 'Neon.Core.Serializers.RTL.pas', Neon.Core.Serializers.VCL in 'Neon.Core.Serializers.VCL.pas', Neon.Core.TypeInfo in 'Neon.Core.TypeInfo.pas', Neon.Core.Types in 'Neon.Core.Types.pas', Neon.Core.Utils in 'Neon.Core.Utils.pas', U_CommonData in 'U_CommonData.pas'; {$R *.res} function UnixMillisecondsToTDateTime(UnixTimeStampMS: Int64): TDateTime; begin // 将毫秒转换为秒,然后使用标准转换函数 Result := UnixToDateTime(UnixTimeStampMS div 1000); // 添加剩余的毫秒部分 // TDateTime中1天=86400秒,1秒=1000毫秒 // 所以1毫秒 = 1/86400000 天 Result := Result + (UnixTimeStampMS mod 1000) / 86400000.0; // 备注:也可以使用完整公式直接转换 // Result := UnixTimeStampMS / 86400000.0 + 25569.0; end; function InternalPerformHttpPost(const AUrl: string; const printerUniqueCode: string; out AResponse: string): Boolean; var HTTP: TIdHTTP; RequestList: TStringList; // 请求信息 begin Result := False; AResponse := ''; HTTP := TIdHTTP.Create(nil); RequestList := TStringList.Create; try // 配置HTTP组件 HTTP.HTTPOptions := HTTP.HTTPOptions + [hoForceEncodeParams]; HTTP.Request.UserAgent := 'Delphi HTTP Client DLL'; RequestList.Add('printerUniqueCode=' + printerUniqueCode); try AResponse := HTTP.Post(AUrl, RequestList); Result := True; except on E: Exception do AResponse := 'HTTP POST Error: ' + E.Message; end; finally HTTP.Free; RequestList.Free; end; end; function CheckPrinterAuth(const printerUniqueCode: PWideChar; out AResponse: TCheckResult): Boolean; stdcall; var UrlStr, ResponseStr: string; ResByteArray: TByteArray; Response: THttpResponse; printerClient: TPrinterClient; ch: String; index: Integer; begin Result := False; UrlStr := 'http://192.168.1.44:18652/apis0/authorize/checkPrinterPerms'; if InternalPerformHttpPost(UrlStr, string(printerUniqueCode), ResponseStr) then begin Response := TNeon.JSONToObject(ResponseStr); try if Response.httpCode = 200 then begin printerClient := TNeon.JSONToObject(Response.data); try AResponse.expireDate := printerClient.authorizeDateLong; AResponse.remainDays := DaysBetween(Now, UnixMillisecondsToTDateTime(AResponse.expireDate)); index := 0; for ch in printerClient.permissions do begin AResponse.permissions[index] := StrToInt(ch); Inc(index); end; finally printerClient.Free; end; end else begin Result := False; Exit; end; Result := True; finally Response.Free; end; end else begin Result := False; end; end; function TestExport(const i: Integer): TCheckResult; stdcall; begin Result.remainDays := i; Result.expireDate := 1000; Result.permissions[0] := 0; Result.permissions[1] := 1; Result.permissions[2] := 2; Result.permissions[3] := 3; Result.permissions[4] := 4; end; // 导出函数列表 exports CheckPrinterAuth, TestExport; begin WriteLn('Testing HTTP Client DLL...'); // 测试URL,可替换为其他有效地址 var Url := 'http://192.168.1.44:18652/apis0/authorize/checkPrinterPerms'; var uniqueCode := 'aaa'; var Response: string; if InternalPerformHttpPost(Url, uniqueCode, Response) then begin WriteLn('Success:'); WriteLn(Response); end else begin WriteLn('Failed:'); WriteLn(Response); end; WriteLn('Press Enter to exit...'); ReadLn; // 等待用户按键,以便查看输出 end.