?? uwebdataaccess.pas
字號:
var
strURL: string;
begin
strURL := Format('%s%s?' + GeneratorIDURL, [WebURL, OperateBaseURL, TableName]);
Result := RequestRemoteGet(strURL);
end;
function TWebDataAccess.GetIdHTTP: TIdHTTP;
begin
if not Assigned(FIdHTTP) then
begin
FIdHTTP := TIdHTTP.Create(self);
FIdHTTP.HTTPOptions := [];
end;
Result := FIdHTTP;
end;
function TWebDataAccess.RequestRemoteGet(URL: string): string;
begin
//application/x-www-form-urlencoded
Result := '';
try
if IdHTTP.Connected then
IdHTTP.Disconnect;
Result := IdHTTP.Get(URL);
except
on e: Exception do
begin
if IdHTTP.Connected then
IdHTTP.Disconnect;
raise Exception.CreateFmt('請求服務器失敗.'#13#10'地址: %s'#13#10'錯誤信息: %s',
[URL, e.Message]);
end;
end;
end;
procedure TWebDataAccess.RequestRemoteGet(URL: string; ResponseContent: TStream);
begin
try
if IdHTTP.Connected then
IdHTTP.Disconnect;
IdHTTP.Get(URL, ResponseContent);
except
on e: Exception do
begin
if IdHTTP.Connected then
IdHTTP.Disconnect;
raise Exception.CreateFmt('請求服務器失敗.'#13#10'地址: %s'#13#10'錯誤信息: %s',
[URL, e.Message]);
end;
end;
end;
function TWebDataAccess.RequestRemotePost(URL: string; Source: TStream): string;
begin
Result := '';
try
if IdHTTP.Connected then
IdHTTP.Disconnect;
Result := IdHTTP.Post(URL, Source);
except
on e: Exception do
begin
if IdHTTP.Connected then
IdHTTP.Disconnect;
raise Exception.CreateFmt('請求服務器失敗.'#13#10'地址: %s'#13#10'錯誤信息: %s',
[URL, e.Message]);
end;
end;
end;
procedure TWebDataAccess.RequestRemotePost(URL: string; Source: TStrings;
ResponseContent: TStream);
var
strURL: string;
begin
try
if IdHTTP.Connected then
IdHTTP.Disconnect;
IdHTTP.Post(URL, Source, ResponseContent);
except
on e: Exception do
begin
if IdHTTP.Connected then
IdHTTP.Disconnect;
strURL := URL;
if Source.Count > 0 then
begin
Source.Delimiter := '&';
strURL := Format('%s?%s', [strURL, Source.DelimitedText]);
end;
raise Exception.CreateFmt('請求服務器失敗.'
+ #13#10'地址: %s'
+ #13#10'錯誤信息: %s',
[strURL, e.Message]);
end;
end;
end;
function TWebDataAccess.RequestRemotePost(URL, Params: string): string;
var
tmpRequest: TStringList;
begin
Result := '';
tmpRequest := TStringList.Create;
try
tmpRequest.Text := Params;
Result := RequestRemotePost(URL, tmpRequest);
finally
tmpRequest.Free;
end;
end;
procedure TWebDataAccess.RequestRemotePost(URL, Params: string;
ResponseContent: TStream);
var
tmpRequest: TStringList;
begin
tmpRequest := TStringList.Create;
try
tmpRequest.Text := Params;
RequestRemotePost(URL, tmpRequest, ResponseContent);
finally
tmpRequest.Free;
end;
end;
function TWebDataAccess.RequestRemotePost(URL: string;
Source: TStrings): string;
var
strURL, strURLParams: string;
begin
Result := '';
try
if IdHTTP.Connected then
IdHTTP.Disconnect;
Result := IdHTTP.Post(URL, Source);
except
on e: Exception do
begin
if IdHTTP.Connected then
IdHTTP.Disconnect;
strURL := URL;
if Source.Count > 0 then
begin
Source.Delimiter := '&';
strURLParams := Source.DelimitedText;
if strURLParams <> '' then
begin
if strURLParams[1] = '"' then
Delete(strURLParams, 1, 1);
if strURLParams[Length(strURLParams)] = '"' then
Delete(strURLParams, Length(strURLParams), 1);
end;
strURL := Format('%s?%s', [strURL, strURLParams]);
end;
raise Exception.CreateFmt('請求服務器失敗.'
+ #13#10'地址: %s'
+ #13#10'錯誤信息: %s',
[strURL, e.Message]);
end;
end;
end;
procedure TWebDataAccess.RequestRemotePost(URL: string; Source,
ResponseContent: TStream);
begin
try
if IdHTTP.Connected then
IdHTTP.Disconnect;
IdHTTP.Post(URL, Source, ResponseContent);
except
on e: Exception do
begin
if IdHTTP.Connected then
IdHTTP.Disconnect;
raise Exception.CreateFmt('請求服務器失敗.'#13#10'地址: %s'#13#10'錯誤信息: %s',
[URL, e.Message]);
end;
end;
end;
function TWebDataAccess.UpdateBatchData(BatchDataList: TList): Boolean;
var
strURL, strURLParams, strResponse: string;
begin
strURL := Format('%s%s', [WebURL, OperateBaseURL]);
// ShowMessage('begin batch data to xml');
strURLParams := Format(UpdateDataURL, [ParamsEncode(DataAsXML(BatchDataList))]);
// ShowMessage('begin request update');
strResponse := RequestRemotePost(strURL, strURLParams);
// ShowMessage('end request update');
Result := StrToBoolDef(strResponse, False);
end;
function TWebDataAccess.UpdateBlobContent(const TableName, KeyFieldName,
KeyFieldValue, BlobFieldName: string;
BlobFieldContent: TStream): boolean;
var
strURL, strResponse: string;
begin
strURL := Format('%s%s?' + UpdateBlobContentURL, [WebURL, OperateBaseURL,
TableName, ParamsEncode(KeyFieldName), ParamsEncode(FillKeyValues(KeyFieldName,
KeyFieldValue)), BlobFieldName]);
strResponse := RequestRemotePost(strURL, BlobFieldContent);
Result := StrToBoolDef(strResponse, False);
end;
function TWebDataAccess.UpdateData(Data: OleVariant; const TableNameOrSQL,
KeyFields: string): Boolean;
var
strURL, strURLParams, strResponse: string;
begin
strURL := Format('%s%s', [WebURL, OperateBaseURL]);
strURLParams := Format(UpdateDataURL, [ParamsEncode(DataAsXML(Data, TableNameOrSQL, KeyFields))]);
strResponse := RequestRemotePost(strURL, strURLParams);
Result := StrToBoolDef(strResponse, False);
end;
function TWebDataAccess.URLEncode(URL: string): string;
begin
Result := TIdURI.URLEncode(URL);
end;
function TWebDataAccess.ParamsEncode(Params: string): string;
begin
Result := TIdURI.ParamsEncode(Params);
end;
function TWebDataAccess.XMLAsData(XML: string; TableNameOrIndex: Variant): OleVariant;
var
XMLDocument: IXMLDocument;
XMLChildNode: IXMLNode;
i, intTableIndex: integer;
strTableName: string;
blnIndex: boolean;
begin
blnIndex := VarType(TableNameOrIndex) in [varByte, varSmallint, varInteger,
varShortInt, varWord, varLongWord, varInt64];
if blnIndex then
intTableIndex := TableNameOrIndex
else
strTableName := TableNameOrIndex;
XMLDocument := LoadXMLData(XML);
try
for i := 0 to XMLDocument.DocumentElement.ChildNodes.Count - 1 do
begin
XMLChildNode := XMLDocument.DocumentElement.ChildNodes[i];
if TXMLHelper.NodeNameEqual(XMLChildNode, 'TABLE')
and ((blnIndex and (i = intTableIndex))
or ((not blnIndex) and TXMLHelper.AttributeEqual(XMLChildNode, 'NAME', strTableName))) then
begin
Result := XMLAsData(XMLChildNode);
break;
end;
end;
finally
XMLDocument := nil;
end;
end;
function TWebDataAccess.XMLAsData(XML: string): OleVariant;
var
XMLDocument: IXMLDocument;
XMLChildNode: IXMLNode;
i: integer;
DataArray: TDataArray;
begin
XMLDocument := LoadXMLData(XML);
try
for i := 0 to XMLDocument.DocumentElement.ChildNodes.Count - 1 do
begin
XMLChildNode := XMLDocument.DocumentElement.ChildNodes[i];
if TXMLHelper.NodeNameEqual(XMLChildNode, 'TABLE') then
begin
SetLength(DataArray, High(DataArray) + 2);
DataArray[High(DataArray)] := XMLAsData(XMLChildNode);
end;
end;
Result := DataArray;
finally
XMLDocument := nil;
end;
end;
function TWebDataAccess.XMLAsData(AXMLNode: IXMLNode): OleVariant;
var
XMLDocument: IXMLDocument;
XMLChildNode: IXMLNode;
XMLMetaDataNode, XMLKeyFieldsNode, XMLFieldsNode: IXMLNode;
tmpCDS: TClientDataSet;
tmpStream: TMemoryStream;
i: integer;
strFieldType: string;
const
FieldTypeR8 = 'TINYINT;SMALLINT;INTEGER;BIGINT;FLOAT;REAL;DOUBLE;NUMERIC;DECIMAL';
FieldTypeDate = 'DATETIME;DATE;TIME;TIMESTAMP';
begin
//AXMLNode: XML中的"Table"節點
tmpCDS := TClientDataSet.Create(Self);
tmpStream := TMemoryStream.Create;
XMLDocument := TXMLHelper.NewXMLDocument('1.0', 'GBK', 'DATAPACKET');
try
XMLDocument.Options := XMLDocument.Options + [doNodeAutoIndent];
TXMLHelper.AddAttributes(XMLDocument.DocumentElement, 'Version=2.0');
//按TClientDataSet的XML格式復制節點
for i := 0 to AXMLNode.ChildNodes.Count - 1 do
begin
XMLChildNode := AXMLNode.ChildNodes[i].CloneNode(true);
XMLDocument.DocumentElement.ChildNodes.Add(XMLChildNode);
end;
XMLMetaDataNode := TXMLHelper.GetChildNode(XMLDocument.DocumentElement, 'METADATA');
XMLKeyFieldsNode := TXMLHelper.GetChildNode(XMLMetaDataNode, 'KEYFIELDS');
XMLFieldsNode := TXMLHelper.GetChildNode(XMLMetaDataNode, 'FIELDS');
//刪除"KEYFIELDS"節點
if XMLKeyFieldsNode <> nil then
XMLMetaDataNode.ChildNodes.Delete(XMLMetaDataNode.ChildNodes.IndexOf(XMLKeyFieldsNode));
//修改傳回來的數據類型"FIELDS"
if XMLFieldsNode <> nil then
for i := 0 to XMLFieldsNode.ChildNodes.Count - 1 do
begin
XMLChildNode := XMLFieldsNode.ChildNodes[i];
if TXMLHelper.NodeNameEqual(XMLChildNode, 'FIELD') then
begin
strFieldType := TXMLHelper.GetNodeAttributeValue(XMLChildNode, 'fieldtype');
if ParamExists(FieldTypeR8, strFieldType, true) then
strFieldType := 'r8'
else if ParamExists(FieldTypeDate, strFieldType, true) then
strFieldType := 'dateTime'
else
strFieldType := 'string';
TXMLHelper.AddAttributes(XMLChildNode, 'fieldtype=' + strFieldType);
end;
end;
XMLDocument.SaveToStream(tmpStream);
tmpStream.Position := 0;
tmpCDS.LoadFromStream(tmpStream);
if tmpCDS.ChangeCount > 0 then
tmpCDS.MergeChangeLog;
Result := tmpCDS.Data;
finally
XMLDocument := nil;
tmpStream.Free;
tmpCDS.Free;
end;
end;
function TWebDataAccess.FillKeyValues(KeyFields,
KeyValues: string): string;
var
i: integer;
strKeyValue: string;
begin
if Pos(';', KeyValues) = 0 then
Result := CopySubStr(KeyValues)
else
begin
Result := '';
for i := 0 to SubStrCount(KeyFields) do
begin
strKeyValue := CopySubStr(KeyValues, i);
if strKeyValue = '' then
Result := Result + '<null>;'
else
Result := Result + strKeyValue + ';';
end;
if Result <> '' then
Delete(Result, Length(Result), 1);
end;
end;
function TWebDataAccess.GetFileContent(const AFileName: string;
FileContent: TStream): boolean;
var
strURL, strFileName: string;
begin
strFileName := AFileName;
if strFileName = '' then
raise Exception.Create('遠程文件路徑為空');
if strFileName[1] = '/' then
Delete(strFileName, 1, 1);
strURL := Format('%s%s', [WebURL, strFileName]);
RequestRemoteGet(strURL, FileContent);
Result := True;
end;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -