unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, superobject, IdHTTP, IdSSLOpenSSL, StdCtrls;

const
  //几个常量
  CONTENT_TYPE_XML = 'application/xml';
  CONTENT_TYPE_JSON = 'application/json';

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    /// <summary>
    /// 把JSON转换为ULR的参数
    /// </summary>
    /// <param name="aJsonParam"></param>
    /// <returns></returns>
    function TranferJsonAsUrlParam(aJsonParam: ISuperObject): string;
    { Private declarations }
    /// <summary>
    /// get请求
    /// </summary>
    /// <param name="aUrl">接口地址</param>
    /// <param name="aJsonParam">接口请求的参数</param>
    /// <param name="aResponse">接口返回值</param>
    /// <returns></returns>
    function HttpRequestByGet(aUrl: string; aJsonParam: ISuperObject; var aResponse: string): Boolean;
    /// <summary>
    /// post请求
    /// </summary>
    /// <param name="aUrl">接口地址</param>
    /// <param name="aJsonParam">接口请求的参数</param>
    /// <param name="aResponse">接口返回值</param>
    /// <param name="aUserName">基本验证的用户名，可选</param>
    /// <param name="aPassword">基本验证的密码，可选</param>
    /// <returns></returns>
    function HttpRequestByPost(aUrl: string; aJsonParam: ISuperObject; var aResponse: string;
      aUserName: string = ''; aPassword: string = ''): Boolean;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

function TForm1.HttpRequestByGet(aUrl: string; aJsonParam: ISuperObject; var aResponse: string): Boolean;
var
  tmpHttp: TIdHTTP;
  ResponseStream: TStringStream;
  soResult: ISuperObject;
  sUrl, sUrlParam: string;
begin
  Result := False;
  aResponse := '';
  tmpHttp := TIdHTTP.Create(nil);
  tmpHttp.Request.ContentType := CONTENT_TYPE_JSON;
  //以流的方式发起请求
  sUrlParam := TranferJsonAsUrlParam(aJsonParam);
  sUrl := aUrl + '?' + sUrlParam;
  ResponseStream := TStringStream.Create('');
  try
    try
      tmpHttp.Get(sUrl, ResponseStream);
      soResult := SO(UTF8Decode(ResponseStream.DataString));
      //返回的标准JSON格式  如果成功，固定返回ecode = 1000 ，如果失败，则错误信息记录在msg中
      //{
      //  "ecode": "1000",
      //  "msg": "操作成功",
      //  "data": {
      //    "age": 18
      //  }
      //}

      if soResult.S['ecode'] = '1000' then
      begin
        aResponse := soResult.S['data'];
        Result := True;
      end
      else
      begin
        aResponse := soResult.S['msg'];
      end;
    except
      on e: Exception do
      begin
        aResponse := e.Message;
        Result := False;
      end;
    end;
  finally
    FreeAndNil(tmpHttp);
    FreeAndNil(ResponseStream);
  end;
end;

function TForm1.HttpRequestByPost(aUrl: string; aJsonParam: ISuperObject;
  var aResponse: string; aUserName, aPassword: string): Boolean;
var
  tmpHttp: TIdHTTP;
  RequestStream: TStringStream;  //请求信息
  ResponseStream: TStringStream; //返回信息
  soResult: ISuperObject;
  io: TIdSSLIOHandlerSocketOpenSSL;
begin
  {
  400错误原则上应该是传上去的数据不符合平台的要求导致的，目前总结有以下几种可能性：
  1、启用基础验证，如TOKEN，没有传验证参数
  2、PostData传入的XML不符合上游接口的规则
  解决方案最简单，与接口方联机调试。很重要！！！
  }
  Result := False;
  aResponse := '';

  tmpHttp := TIdHTTP.Create(nil);
  tmpHttp.ReadTimeout := 5000; //请求超时设置
  tmpHttp.HandleRedirects := True;
  if UpperCase(Copy(aUrl, 1, 5)) = 'HTTPS' then
  begin
    io := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
    tmpHttp.HandleRedirects := False;
    tmpHttp.IOHandler := io;
  end;
  tmpHttp.Request.ContentType := CONTENT_TYPE_JSON;
  tmpHttp.Request.Accept := CONTENT_TYPE_JSON;

  //如果请求需要做基本验证，验证失败会返回http 400错误
  if aUserName <> '' then
  begin
    tmpHttp.Request.Username := aUserName;
    tmpHttp.Request.Password := aPassword;
    tmpHttp.Request.BasicAuthentication := True;
  end;

  RequestStream := TStringStream.Create('');
  ResponseStream := TStringStream.Create('');
  try
    try
      //平台以JSON方式接收参数
      RequestStream.WriteString(UTF8Encode(AnsiToUtf8(aJsonParam.AsJSon())));
      tmpHttp.Post(AUrl, RequestStream, ResponseStream);
      soResult := SO(UTF8Decode(ResponseStream.DataString));
      //返回的标准JSON格式  如果成功，固定返回ecode = 1000 ，如果失败，则错误信息记录在msg中
      //{
      //  "ecode": "1000",
      //  "msg": "操作成功",
      //  "data": {
      //    "age": 18
      //  }
      //}
      if soResult.S['ecode'] = '1000' then
      begin
        aResponse := soResult.S['data'];
        Result := True;
      end
      else
      begin
        aResponse := soResult.S['msg'];
      end;

    except
      on e: Exception do
      begin
        Result := False;
      end;
    end;
  finally
    FreeAndNil(tmpHttp);
    FreeAndNil(ResponseStream);
    FreeAndNil(RequestStream);
  end;
end;

function TForm1.TranferJsonAsUrlParam(aJsonParam: ISuperObject): string;
var
  sSource, sUrlParams, sParam: string;
  sltTemp: TStringList;
  i: Integer;
begin
  Result := '';
  //只能做一层转换，如果里面还包含有JSON子集，待扩展
  sSource := UTF8Encode(AnsiToUtf8(aJsonParam.AsJSon()));;
  sSource := StringReplace(sSource, '"', '', [rfReplaceAll]);
  sSource := Copy(sSource, 2, Length(sSource) - 2);
  sltTemp := TStringList.Create;
  sUrlParams := '';
  try
    sltTemp.DelimitedText := sSource;
    sltTemp.Delimiter := ',';
    for i := 0 to sltTemp.Count - 1 do
    begin
      sParam := StringReplace(sltTemp[i], ':', '=', []);
      if sUrlParams <> '' then sUrlParams := sUrlParams + '&';
      sUrlParams := sUrlParams + sParam;
    end;
    Result := sUrlParams;
  finally
    sltTemp.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  sUrl: string;
  soParam, soResponse: ISuperObject;
  sResponse: string;
begin
  sUrl := 'http://localhost/index.php';
  soParam := SO();
  soParam.S['userName'] := 'aaa';
  soParam.S['password'] := '123456';

  if not HttpRequestByGet(sUrl, soParam, sResponse) then
  begin
    ShowMessage('接口请求失败');
    Exit;
  end;

  soResponse := SO(sResponse);
  ShowMessage(IntToStr(soResponse.I['age']));

end;

procedure TForm1.Button2Click(Sender: TObject);
var
  sUrl: string;
  soParam, soResponse: ISuperObject;
  sResponse: string;
begin
  sUrl := 'http://localhost/index.php';
  soParam := SO();
  soParam.S['userName'] := 'aaa';
  soParam.S['password'] := '123456';

  if not HttpRequestByPost(sUrl, soParam, sResponse) then
  begin
    ShowMessage('接口请求失败');
    Exit;
  end;

  soResponse := SO(sResponse);
  ShowMessage(IntToStr(soResponse.I['age']));

end;

end.