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<><32>
|
|||
|
|
ResponseTimeout := 10000; // 10<31><30>
|
|||
|
|
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) <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ʱ.
|
|||
|
|
// Error receiving data: (12002) <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ʱ
|
|||
|
|
if Copy(E.Message, 1, Pos(':', E.Message) - 1) = 'Error sending data' then
|
|||
|
|
Result := '{"RtErr":"<22>ӿ<EFBFBD><D3BF><EFBFBD><EFBFBD><EFBFBD>ʧ<EFBFBD>ܣ<EFBFBD>"}'
|
|||
|
|
else if Copy(E.Message, 1, Pos(':', E.Message) - 1) = 'Error receiving data' then
|
|||
|
|
Result := '{"RtErr":"<22>ӿڴ<D3BF><DAB4><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ʧ<EFBFBD>ܣ<EFBFBD><DCA3><EFBFBD><EFBFBD>ӳ<EFBFBD><D3B3><EFBFBD><EFBFBD>ճ<EFBFBD>ʱʱ<CAB1><CAB1>"}'
|
|||
|
|
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<4F><4E>
|
|||
|
|
JSONPair: TJSONPair;
|
|||
|
|
i, j, k: Integer; // ѭ<><D1AD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
|||
|
|
Cloint: Integer; // ѭ<><D1AD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
|||
|
|
temp: string; // <20><>ʱʹ<CAB1>ñ<EFBFBD><C3B1><EFBFBD>
|
|||
|
|
jsonArray: TJSONArray; // JSON<4F><4E><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
|||
|
|
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;
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
{ <20><><EFBFBD>ַ<EFBFBD><D6B7><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>JSON }
|
|||
|
|
JSONObject := TJSONObject.ParseJSONValue(JSONStr) as TJSONObject;
|
|||
|
|
if JSONObject.Count > 0 then
|
|||
|
|
begin
|
|||
|
|
// json<6F><6E><EFBFBD><EFBFBD>
|
|||
|
|
jsonArray := TJSONArray(JSONObject.GetValue(ArrName));
|
|||
|
|
if jsonArray.Count > 0 then
|
|||
|
|
begin
|
|||
|
|
// ѭ<><D1AD>ȡ<EFBFBD><C8A1>JSON<4F><4E><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ÿ<EFBFBD><C3BF>Ԫ<EFBFBD><D4AA>
|
|||
|
|
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 := 'û<><C3BB><EFBFBD><EFBFBD><EFBFBD>ݣ<EFBFBD>';
|
|||
|
|
end;
|
|||
|
|
finally
|
|||
|
|
CDS_1.First;
|
|||
|
|
CDS_1.EnableControls;
|
|||
|
|
JSONObject.Free;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function YongYouGettoken(): string;
|
|||
|
|
var
|
|||
|
|
JsonStr: string;
|
|||
|
|
JSONObject: TJSONObject; // JSON<4F><4E>
|
|||
|
|
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<><32>
|
|||
|
|
ResponseTimeout := 10000; // 10<31><30>
|
|||
|
|
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) <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ʱ.
|
|||
|
|
// Error receiving data: (12002) <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ʱ
|
|||
|
|
if Copy(E.Message, 1, Pos(':', E.Message) - 1) = 'Error sending data' then
|
|||
|
|
Result := '{"RtErr":"<22>ӿ<EFBFBD><D3BF><EFBFBD><EFBFBD><EFBFBD>ʧ<EFBFBD>ܣ<EFBFBD>"}'
|
|||
|
|
else if Copy(E.Message, 1, Pos(':', E.Message) - 1) = 'Error receiving data' then
|
|||
|
|
Result := '{"RtErr":"<22>ӿڴ<D3BF><DAB4><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ʧ<EFBFBD>ܣ<EFBFBD><DCA3><EFBFBD><EFBFBD>ӳ<EFBFBD><D3B3><EFBFBD><EFBFBD>ճ<EFBFBD>ʱʱ<CAB1><CAB1>"}'
|
|||
|
|
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<4F><4E>
|
|||
|
|
JSONPair: TJSONPair;
|
|||
|
|
i, j, k: Integer; // ѭ<><D1AD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
|||
|
|
Cloint: Integer; // ѭ<><D1AD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
|||
|
|
temp: string; // <20><>ʱʹ<CAB1>ñ<EFBFBD><C3B1><EFBFBD>
|
|||
|
|
jsonArray: TJSONArray; // JSON<4F><4E><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
|||
|
|
mfieldName: string;
|
|||
|
|
mSize: Integer;
|
|||
|
|
begin
|
|||
|
|
JSONObject := nil;
|
|||
|
|
try
|
|||
|
|
CDS_1.DisableControls;
|
|||
|
|
{ <20><><EFBFBD>ַ<EFBFBD><D6B7><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>JSON }
|
|||
|
|
JSONObject := TJSONObject.ParseJSONValue(JSONStr) as TJSONObject;
|
|||
|
|
if JSONObject.Count > 0 then
|
|||
|
|
begin
|
|||
|
|
// json<6F><6E><EFBFBD><EFBFBD>
|
|||
|
|
jsonArray := TJSONArray(JSONObject.GetValue(ArrName));
|
|||
|
|
if jsonArray.Count > 0 then
|
|||
|
|
begin
|
|||
|
|
// ѭ<><D1AD>ȡ<EFBFBD><C8A1>JSON<4F><4E><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ÿ<EFBFBD><C3BF>Ԫ<EFBFBD><D4AA>
|
|||
|
|
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 := 'û<><C3BB><EFBFBD><EFBFBD><EFBFBD>ݣ<EFBFBD>';
|
|||
|
|
end;
|
|||
|
|
finally
|
|||
|
|
CDS_1.First;
|
|||
|
|
CDS_1.EnableControls;
|
|||
|
|
JSONObject.Free;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function JsonErr(JsonStr, Success: string): string;
|
|||
|
|
var
|
|||
|
|
JSONObject: TJSONObject; // JSON<4F><4E>
|
|||
|
|
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<4F><4E>
|
|||
|
|
begin
|
|||
|
|
Result := '';
|
|||
|
|
JSONObject := TJSONObject.ParseJSONValue(JsonStr) as TJSONObject;
|
|||
|
|
Result := JSONObject.GetValue(KeyName).ToString;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function JsonGetChildValue(JsonStr, KeyName: string): string;
|
|||
|
|
var
|
|||
|
|
JSONObject: TJSONObject; // JSON<4F><4E>
|
|||
|
|
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.
|
|||
|
|
|