unit U_HttpFun;

interface

uses
  System.SysUtils, System.Net.HttpClientComponent, System.Classes, System.JSON,
  Datasnap.DBClient, Data.DB;

function UrlDecode(const AStr: AnsiString): AnsiString;

function GetRequest(Url: string): string;

function RTGetRequest(Url: string): string;

procedure JsonToDataset(JsonStr, ArrName: string; CDS_1: TclientDataSet);

function JsonErr(JsonStr, Success: string): string;

function JsonGetChildValue(JsonStr, KeyName: string): string;

function JsonGetChildObject(JsonStr, KeyName: string): string;

function YongYouGettoken(): string;

function YongYouSpliceUrl(BsUrl, ChildUrl, from_account, to_account, app_key, token, arg: string): string;

procedure JsonToCHDA(JSONStr, ArrName: string; CDS_1: TclientDataSet);

implementation

uses
  U_DataLink;

function RTGetRequest(Url: string): string;
var
  vHttp: TNetHTTPClient;
  vUTF8: TStringStream;
begin
  vHttp := TNetHTTPClient.Create(nil);
  vUTF8 := TStringStream.Create('', TEncoding.GetEncoding(65001));
  try
    with vHttp do
    begin
      vUTF8.Clear;
      ConnectionTimeout := 2000; // 2秒
      ResponseTimeout := 10000; // 10秒
      AcceptCharSet := 'utf-8';
      AcceptEncoding := '65001';
      AcceptLanguage := 'zh-CN';
      ContentType := 'text/html';
      UserAgent := 'Embarcadero URI Client/1.0';

      try
        Get(Url, vUTF8);
        Result := vUTF8.DataString; // UrlDecode(vUTF8.DataString);   //TNetEncoding.URL.
      except
        on E: Exception do
          // Error sending data: (12002) 操作超时.
          // Error receiving data: (12002) 操作超时
          if Copy(E.Message, 1, Pos(':', E.Message) - 1) = 'Error sending data' then
            Result := '{"RtErr":"接口连接失败！"}'
          else if Copy(E.Message, 1, Pos(':', E.Message) - 1) = 'Error receiving data' then
            Result := '{"RtErr":"接口传输数据失败，请延长接收超时时间"}'
          else
            Result := '{"RtErr":"' + E.Message + '"}';
      end;
    end;
  finally
    vUTF8.Free;
    vHttp.Free;
  end;
end;

procedure JsonToCHDA(JSONStr, ArrName: string; CDS_1: TclientDataSet);
var
  JSONObject, JSONObject2: TJSONObject; // JSON类
  JSONPair: TJSONPair;
  i, j, k: Integer; // 循环变量
  Cloint: Integer; // 循环变量
  temp: string; // 临时使用变量
  jsonArray: TJSONArray; // JSON数组变量
  mfieldName: string;
  mSize: Integer;
begin
  JSONObject := nil;
  try
    CDS_1.DisableControls;
    CDS_1.FieldDefs.Clear;
    CDS_1.FieldDefs.Add('code', ftString, 255);
    CDS_1.FieldDefs.Add('name', ftString, 255);
    CDS_1.FieldDefs.Add('specs', ftString, 255);
    CDS_1.FieldDefs.Add('SSel', ftBoolean, 0);
    CDS_1.close;
    CDS_1.CreateDataSet;




   { 从字符串生成JSON }
    JSONObject := TJSONObject.ParseJSONValue(JSONStr) as TJSONObject;
    if JSONObject.Count > 0 then
    begin
      // json数组
      jsonArray := TJSONArray(JSONObject.GetValue(ArrName));
      if jsonArray.Count > 0 then
      begin
          // 循环取得JSON数组中每个元素
        for i := 0 to jsonArray.Size - 1 do
        begin

          with CDS_1 do
          begin
            Append;
            Cloint := jsonArray.Items[i].GetValue<TJSONObject>.Count;
            for k := 0 to Cloint - 1 do
            begin
              JSONPair := jsonArray.Items[i].GetValue<TJSONObject>.Pairs[k];
              if Findfield(JSONPair.JsonString.Value) <> nil then
              begin
                FieldByName(JSONPair.JsonString.Value).Value := JSONPair.JSONValue.Value;
              end;

            end;
            Post;
          end;
        end;
      end;
    end
    else
    begin
      temp := '没有数据！';
    end;
  finally
    CDS_1.First;
    CDS_1.EnableControls;
    JSONObject.Free;
  end;
end;

function YongYouGettoken(): string;
var
  JsonStr: string;
  JSONObject: TJSONObject; // JSON类
  JSONPair: TJSONPair;
  i, Cloint: integer;
begin
  Result := '';
  BJ_Url := 'https://api.yonyouup.com/api/';
  BJ_FromAccount := 'hbyl2024';
  BJ_ToAccount := 'hbyl2024:mesapp';
  BJ_appKey := 'opaeaf8afe01e3fe21f';
  JsonStr := GetRequest('https://api.yonyouup.com/system/token?from_account=hbyl2024&app_key=opaeaf8afe01e3fe21f&app_secret=8d699f9b39ac41139941f224d5da154e');
  if JsonErr(JsonStr, '0') = '0' then
  begin
    BJ_token := JsonGetChildValue(JsonGetChildObject(JsonStr, 'token'), 'id');
  end
  else
  begin
    Result := JsonStr;
  end;
end;

function YongYouSpliceUrl(BsUrl, ChildUrl, from_account, to_account, app_key, token, arg: string): string;
begin
  Result := BsUrl + ChildUrl + '?from_account=' + from_account + '&to_account=' + to_account + '&app_key=' + app_key + '&token=' + token + arg;
end;

function UrlDecode(const AStr: AnsiString): AnsiString;
var
  Sp, Rp, Cp: PAnsiChar;
  s: AnsiString;
begin
  SetLength(Result, Length(AStr));
  Sp := PAnsiChar(AStr);
  Rp := PAnsiChar(Result);
  Cp := Sp;
  while Sp^ <> #0 do
  begin
    case Sp^ of
      '+':
        Rp^ := ' ';
      '%':
        begin
          Inc(Sp);
          if Sp^ = '%' then
            Rp^ := '%'
          else
          begin
            Cp := Sp;
            Inc(Sp);
            if (Cp^ <> #0) and (Sp^ <> #0) then
            begin
              s := AnsiChar('$') + Cp^ + Sp^;
              Rp^ := AnsiChar(StrToInt(string(s)));
            end;
          end;
          Cp := Cp;
        end;
    else
      Rp^ := Sp^;
    end;
    Inc(Rp);
    Inc(Sp);
  end;
  SetLength(Result, Rp - PAnsiChar(Result));
end;

function GetRequest(Url: string): string;
var
  vHttp: TNetHTTPClient;
  vUTF8: TStringStream;
begin
  vHttp := TNetHTTPClient.Create(nil);
  vUTF8 := TStringStream.Create('', TEncoding.GetEncoding(65001));
  try
    with vHttp do
    begin
      vUTF8.Clear;
      ConnectionTimeout := 2000; // 2秒
      ResponseTimeout := 10000; // 10秒
      AcceptCharSet := 'utf-8';
      AcceptEncoding := '65001';
      AcceptLanguage := 'zh-CN';
      ContentType := 'text/html';
      UserAgent := 'Embarcadero URI Client/1.0';

      try
        Get(Url, vUTF8);
        Result := vUTF8.DataString; // UrlDecode(vUTF8.DataString);   //TNetEncoding.URL.
      except
        on E: Exception do
          // Error sending data: (12002) 操作超时.
          // Error receiving data: (12002) 操作超时
          if Copy(E.Message, 1, Pos(':', E.Message) - 1) = 'Error sending data' then
            Result := '{"RtErr":"接口连接失败！"}'
          else if Copy(E.Message, 1, Pos(':', E.Message) - 1) = 'Error receiving data' then
            Result := '{"RtErr":"接口传输数据失败，请延长接收超时时间"}'
          else
            Result := '{"RtErr":"' + E.Message + '"}';
      end;
    end;
  finally
    vUTF8.Free;
    vHttp.Free;
  end;
end;

procedure JsonToDataset(JSONStr, ArrName: string; CDS_1: TclientDataSet);
var
  JSONObject, JSONObject2: TJSONObject; // JSON类
  JSONPair: TJSONPair;
  i, j, k: Integer; // 循环变量
  Cloint: Integer; // 循环变量
  temp: string; // 临时使用变量
  jsonArray: TJSONArray; // JSON数组变量
  mfieldName: string;
  mSize: Integer;
begin
  JSONObject := nil;
  try
    CDS_1.DisableControls;
   { 从字符串生成JSON }
    JSONObject := TJSONObject.ParseJSONValue(JSONStr) as TJSONObject;
    if JSONObject.Count > 0 then
    begin
      // json数组
      jsonArray := TJSONArray(JSONObject.GetValue(ArrName));
      if jsonArray.Count > 0 then
      begin
          // 循环取得JSON数组中每个元素
        for i := 0 to jsonArray.Size - 1 do
        begin
          if i = 0 then
          begin
            Cloint := jsonArray.Items[i].GetValue<TJSONObject>.Count;
            CDS_1.FieldDefs.Clear;
            for j := 0 to Cloint - 1 do
            begin
              JSONPair := jsonArray.Items[i].GetValue<TJSONObject>.Pairs[j];
              CDS_1.FieldDefs.Add(JSONPair.JsonString.Value, ftString, 255);
            end;
            CDS_1.FieldDefs.Add('SSel', ftBoolean, 0);
            CDS_1.close;
            CDS_1.CreateDataSet;
          end;
          with CDS_1 do
          begin
            Append;
            for k := 0 to Cloint - 1 do
            begin
              JSONPair := jsonArray.Items[i].GetValue<TJSONObject>.Pairs[k];
              if Findfield(JSONPair.JsonString.Value) <> nil then
                FieldByName(JSONPair.JsonString.Value).Value := JSONPair.JSONValue.Value;
            end;
            Post;
          end;
        end;
      end;
    end
    else
    begin
      temp := '没有数据！';
    end;
  finally
    CDS_1.First;
    CDS_1.EnableControls;
    JSONObject.Free;
  end;
end;

function JsonErr(JsonStr, Success: string): string;
var
  JSONObject: TJSONObject; // JSON类
  JSONPair: TJSONPair;
  i, Cloint: integer;
begin
  Result := Success;

  JSONObject := TJSONObject.ParseJSONValue(JsonStr) as TJSONObject;
  Cloint := JSONObject.Count;
  for i := 0 to Cloint - 1 do
  begin
    JSONPair := JSONObject.Pairs[i];
    if JSONPair.JsonString.Value = 'errcode' then
      Result := JSONPair.JSONValue.Value;
  end;
end;

function JsonGetChildObject(JsonStr, KeyName: string): string;
var
  JSONObject: TJSONObject; // JSON类
begin
  Result := '';
  JSONObject := TJSONObject.ParseJSONValue(JsonStr) as TJSONObject;
  Result := JSONObject.GetValue(KeyName).ToString;
end;

function JsonGetChildValue(JsonStr, KeyName: string): string;
var
  JSONObject: TJSONObject; // JSON类
  JSONPair: TJSONPair;
  i, Cloint: integer;
  Z, X: string;
begin
  Result := '';
  JSONObject := TJSONObject.ParseJSONValue(JsonStr) as TJSONObject;
  Cloint := JSONObject.Count;
  for i := 0 to Cloint - 1 do
  begin
    JSONPair := JSONObject.Pairs[i];
    Z := JSONPair.JsonString.Value;
    X := JSONPair.JSONValue.Value;
    if JSONPair.JsonString.Value = KeyName then
      Result := JSONPair.JSONValue.Value;
  end;
end;

end.