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.