360 lines
9.5 KiB
ObjectPascal
360 lines
9.5 KiB
ObjectPascal
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.
|
|
|