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;

 

缺点：每次都新建，一定程度上浪费了系统资源，但是由于服务端返回并不可控，且调用进来后，每一个返回的处理也无法通过分析返回结果的方式实现，若哪位老师有更好的异步方案（几乎等同于要求同步处理，而实际同步了业务又不允许等待），请指点下，感谢！