delphi 10.3實現TNetHTTPClient 異步 POST 另類實現返回附加標記及Unicode 編碼與解碼 \u

unit HOHttpAsynPost;

interface

Uses System.Classes,Winapi.Windows,System.SysUtils,IHOHttpAsynPost
     ,uLogger,System.Net.URLClient, System.Net.HttpClient, System.Net.HttpClientComponent
     ,strUtils;

 type
   TPostResProc    = procedure(Buff:PWIdeChar;MsgID:PWIdeChar)  of object;//定義回調

  THONetHttp=class(TNetHTTPClient)
   public
    msgid:String;
    PostRes:TPostResProc;
   constructor Create(AOwner: TComponent); // override;
    destructor Destroy; // override;
   procedure  RequestCompleted(const Sender: TObject; const AResponse: IHTTPResponse);
   procedure RequestError(const Sender: TObject; const AError: string);
  end;

procedure HttpAsynPost(Url:widestring;Buff:Pwidechar;PostRes1:TPostResProc;Msgid1:widestring;ConnectionTimeout1: Integer;ResponseTimeout1: Integer); stdcall;

function  GetDllPath: string;
implementation

procedure HttpAsynPost(Url:widestring;Buff:Pwidechar;PostRes1:TPostResProc;Msgid1:widestring;ConnectionTimeout1: Integer;ResponseTimeout1: Integer); stdcall;
var
  Nhttp:THONetHttp;
  Stream:TStringStream;
  Buffer:Widestring;
  function ChineseToUnicode(Inputstr: string): string;
 var //Unicode編碼
  Wide_Str: WideString;
  WideChar_Byte_Array: Array of Byte;
  s2:string;
  i:integer;
begin
  Wide_Str := Inputstr;//轉爲Unicode
  //字節數 = Unicode字數 * Unicode單字的字節數
  SetLength(WideChar_Byte_Array, Length(Wide_Str) * sizeof(WideChar));
  //複製到字節數組當中
  Move(PChar(Wide_Str)^, WideChar_Byte_Array[0], Length(Wide_Str) * sizeof(WideChar));
  i:=0;
  while I<High(WideChar_Byte_Array) do
  begin
    if WideChar_Byte_Array[I+1]=0 then
       S2:=S2+char(WideChar_Byte_Array[I])
    else
    S2:=S2+'\u'+inttohex(WideChar_Byte_Array[I+1])+inttohex(WideChar_Byte_Array[I]);
    I:=I+2;
  end;
  result:=s2;
  //釋放字節數組
  SetLength(WideChar_Byte_Array, 0);
  WideChar_Byte_Array := Nil;
end;
Begin
 try
   Buffer:=Buff;
   Buffer:=ChineseToUnicode(Buffer);
   log.WriteLog('['+Msgid1+']'+Url+ #13#13+Buffer);
   Stream:=TStringStream.Create;
   Stream.WriteString( Buffer);
   Stream.Position:=0;
   Nhttp:=THONetHttp.Create(Nil);//每次調用啓用一個新的THONetHttp

   with Nhttp do
   begin

      AcceptCharSet := 'utf-8';
      AcceptEncoding := '65001';
      AcceptLanguage := 'zh-CN';
      ContentType := 'application/json'; //text/html
      UserAgent := 'CNHIS URI Client/1.0';
      Asynchronous:=True;
     Nhttp.OnRequestCompleted:=RequestCompleted;
     nhttp.OnRequestError:=RequestError;
     ConnectionTimeout :=ConnectionTimeout1;
     ResponseTimeout := ResponseTimeout1;
     msgid:=Msgid1;//附加標記
     PostRes:=PostRes1;//註冊回調
     Post(Url,Stream);

   end;
 EXcept
  ON E:Exception do
  Begin

    log.WriteLog('['+Msgid1+']發送出錯:' + e.Message );

  End;
 end;
end;






 function  GetDllPath: string;
var
  ModuleName: string;
begin
  SetLength(ModuleName, 255);
    //取得Dll自身路徑
  GetModuleFileName(HInstance, PChar(ModuleName), Length(ModuleName));
  Result := ExtractFileDir(PChar(ModuleName));

end;

{ TNetHttp }

constructor THONetHttp.Create(AOwner: TComponent);
begin
   inherited Create(AOwner);
end;

destructor THONetHttp.Destroy;
begin
   inherited;
end;

procedure THONetHttp.RequestCompleted(const Sender: TObject; const AResponse: IHTTPResponse);
Var
 Buff:String;
 Buffer:PwideChar;
 Msgid1:PwideChar;
 i:integer;
begin //異步返回
 try
   Msgid1:=@THONetHttp(sender).msgid[1];
   Buff:=AResponse.ContentAsString(TEncoding.UTF8);
  if Buff='' then
      Buff:='[錯誤信息]服務器返回空';
   Buffer:=@Buff[1];
   log.WriteLog('['+Msgid1+']' +'API返回:'+Buffer);
   if assigned(THONetHttp(sender).PostRes) then
   Begin
    THONetHttp(sender).PostRes(Buffer,Msgid1);//回調時帶上MSGID實現調用方的唯一處理，含同步等待等接口不能返回對等唯一ID時的需求的實現 
   End;
   THONetHttp(sender).Free;//釋放
 EXcept
  ON E:Exception do
  Begin
    log.WriteLog('['+Msgid1+']'+'處理返回值出錯:' + e.Message);
  End;
 end;
end;

procedure THONetHttp.RequestError(const Sender: TObject; const AError: string);
Var
 Buff:String;
 Buffer:PwideChar;
 Msgid1:PwideChar;
 i:integer;
begin
 try
   Msgid1:=@THONetHttp(sender).msgid[1];
   Buff:='[錯誤信息]'+AError;
   log.WriteLog('['+Msgid1+']'+Buff);
   if assigned(THONetHttp(sender).PostRes) then
   Begin
    Buffer:=@Buff[1];
    THONetHttp(sender).PostRes(Buffer,Msgid1);
   End;
   THONetHttp(sender).Free;
 EXcept
  ON E:Exception do
  Begin
    log.WriteLog('['+Msgid1+']'+'處理錯誤信息出錯:' + e.Message);
  End;
 end;
end;

initialization

 Log.SetLogDir(GetDllPath + '\..\Log\', 'Plugin.HttpAsynPost');


finalization
end.

 

 function UnicodeToChinese(Inputstr: string): string;
  var
    I: Integer;
    Index: Integer;
    Temp, Top, Last: string;
  begin//Unicode解碼 
    index := 1;
    while index >= 0 do
    begin
      index := Pos('\u', Inputstr) - 1;
      if index < 0 then
      begin
        Last := Inputstr;
        Result := Result + Last;
        Exit;
      end;
      Top := Copy(Inputstr, 1, index); // 取出 編碼字符前的 非 unic 編碼的字符，如數字
      Temp := Copy(Inputstr, index + 1, 6); // 取出編碼，包括 \u,如\u4e3f
      Delete(Temp, 1, 2);
      Delete(Inputstr, 1, index + 6);
      Result := Result + Top + WideChar(StrToInt('$' + Temp));
    end;
  end;

 

缺點：每次都新建，一定程度上浪費了系統資源，但是由於服務端返回並不可控，且調用進來後，每一個返回的處理也無法通過分析返回結果的方式實現，若哪位老師有更好的異步方案（幾乎等同於要求同步處理，而實際同步了業務又不允許等待），請指點下，感謝！