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.