uwebdataaccess.pas

抽象三层访问数据库示例

{*******************************************************}
{       软件名称: --通用--                              }
{       单元名称: uWebDataAccess.pas                    }
{       中文名称: Web数据访问类                         }
{       单元描述: Web方式访问数据，本地不进行任何数据访 }
{                 问操作                                }
{       创    建: SamonHua                              }
{       创建日期: 2007-12-18                            }
{       修    改: 参见VSS记录                           }
{       版权所有 (C)2002-2007 深圳壹平台信息技术有限公司}
{*******************************************************}
unit uWebDataAccess;

interface

uses
  SysUtils, Classes, Variants, IdBaseComponent, IdComponent, IdTCPConnection,
  IdTCPClient, IdHTTP, DB, DBClient, XMLIntf, XMLDoc, uCommon, uIDataAccess,
  uDataAccess, uDataAccessCommon, uXMLCommon, IdURI;

type
  TWebDataAccess = class(TDataAccess)
  private
    FIdHTTP: TIdHTTP;
    function GetIdHTTP: TIdHTTP;
    property IdHTTP: TIdHTTP read GetIdHTTP;
    function URLEncode(URL: string): string;
    function ParamsEncode(Params: string): string;

    function RequestRemoteGet(URL: string): string; overload;
    procedure RequestRemoteGet(URL: string; ResponseContent: TStream); overload;
    function RequestRemotePost(URL: string; Source: TStream): string; overload;
    function RequestRemotePost(URL: string; Source: TStrings): string; overload;
    function RequestRemotePost(URL, Params: string): string; overload;
    procedure RequestRemotePost(URL: string; Source: TStrings; ResponseContent: TStream); overload;
    procedure RequestRemotePost(URL: string; Source, ResponseContent: TStream); overload;
    procedure RequestRemotePost(URL, Params: string; ResponseContent: TStream); overload;

    function XMLAsData(AXMLNode: IXMLNode): OleVariant; overload;
    function XMLAsData(XML: string; TableNameOrIndex: Variant): OleVariant; overload;
    function XMLAsData(XML: string): OleVariant; overload;
    function DataAsXML(Data: OleVariant; const TableNameOrSQL, KeyFields: string): string; overload;
    function DataAsXML(Data: TBatchDataSet): string; overload;
    function DataAsXML(DataList: TList): string; overload;
    //填充关键字段值列表，空的补<null>
    function FillKeyValues(KeyFields, KeyValues: string): string;
  protected
  public
    function GetData(const TableNameOrSQL: string): OleVariant; override;
    function GetID(const TableName: string): string; override;
    function UpdateData(Data: OleVariant; const TableNameOrSQL, KeyFields: string): Boolean; override;
    function UpdateBatchData(BatchDataList: TList): Boolean; override;
    function ExcuteSQL(const ASQL: string): Boolean; override;
    function GetBlobContent(const TableName, KeyFieldName, KeyFieldValue, BlobFieldName: string;
      BlobFieldContent: TStream): boolean; override;
    function GetFileContent(const AFileName: string; FileContent: TStream): boolean; override;
    function UpdateBlobContent(const TableName, KeyFieldName, KeyFieldValue, BlobFieldName: string;
      BlobFieldContent: TStream): boolean; override;
  end;

implementation

const
  {QueryDataURL = 'operateDataAction.do?method=queryData&strSql=%s';
  GeneratorIDURL = 'operateDataAction.do?method=generatorID&tableName=%s';
  UpdateDataURL = 'operateDataAction.do?method=updateData&strXMLData=%s';
  ExcuteSQLURL = 'operateDataAction.do?method=excuteSQL&strSql=%s';
  QueryBlobContentURL = 'operateDataAction.do?method=queryBlobContent&tableName=%s&keyFieldName=%s&keyFieldValue=%s&blobFieldName=%s';
  UpdateBlobContentURL = 'operateDataAction.do?method=updateBlobContent&tableName=%s&keyFieldName=%s&keyFieldValue=%s&blobFieldName=%s';}
  OperateBaseURL = 'operateDataAction.do';
  QueryDataURL = 'method=queryData&strSql=%s';
  GeneratorIDURL = 'method=generatorID&tableName=%s';
  UpdateDataURL = 'method=updateData&strXMLData=%s';
  ExcuteSQLURL = 'method=excuteSQL&strSql=%s';
  QueryBlobContentURL = 'method=queryBlobContent&tableName=%s&keyFieldName=%s&keyFieldValue=%s&blobFieldName=%s';
  UpdateBlobContentURL = 'method=updateBlobContent&tableName=%s&keyFieldName=%s&keyFieldValue=%s&blobFieldName=%s';

{ TWebDataAccess }

function TWebDataAccess.DataAsXML(Data: TBatchDataSet): string;
begin
  //ShowMessage('xxx: ' + booltostr(Assigned(Data), True));
  Result := DataAsXML(Data.Data, Data.TableName, Data.KeyFields);
end;

function TWebDataAccess.DataAsXML(Data: OleVariant; const TableNameOrSQL,
  KeyFields: string): string;
var
  tmpCDS, tmpCDSDelta: TClientDataSet;
  XMLDocument, XMLNewDocument: IXMLDocument;
  XMLChildNode: IXMLNode;
  XMLTableNode, XMLMetaDataNode, XMLKeyFieldsNode, XMLFieldsNode,
    XMLParamsNode, XMLRowDataNode, XMLDeleteRowDataNode: IXMLNode;
  tmpStream: TMemoryStream;
  strFieldName, strFieldType: string;
  i: integer;

  function LocateUpdateStatus: boolean;
  var
    varKeyValues: Variant;
    i: Integer;
  begin
    Result := False;
    varKeyValues := VarArrayCreate([0, SubStrCount(KeyFields)], varVariant);
    for i := 0 to SubStrCount(KeyFields) do
      varKeyValues[i] := tmpCDS.FieldByName(CopySubStr(KeyFields, i)).Value;
    Result := tmpCDSDelta.Locate(KeyFields, varKeyValues, [loCaseInsensitive]);
  end;

  function KeyFieldName(FieldName: string): string;
  var
    tmpXMLNode: IXMLNode;
  begin
    //此方法主要是通过用户调用的关键字段名找到原始的字段名，避免字段名大小写不一致
    Result := FieldName;
    if XMLFieldsNode = nil then
      exit;
    tmpXMLNode := TXMLHelper.GetChildNode(XMLFieldsNode, 'FIELD', '', 'attrname=' + FieldName);
    if tmpXMLNode <> nil then
      Result := TXMLHelper.GetNodeAttributeValue(tmpXMLNode, 'attrname');
  end;

  function GetAttribute: string;
  var
    i: Integer;
  begin
    Result := '';
    for i := 0 to SubStrCount(KeyFields) do
    begin
      strFieldName := CopySubStr(KeyFields, i);
      Result := Result + Format('%s=%s;', [KeyFieldName(strFieldName), tmpCDSDelta.FieldByName(strFieldName).AsString]);
    end;
    if Result <> '' then
      Delete(Result, Length(Result), 1);
  end;

  procedure FormatDateFieldValue;
  var
    i, j: integer;
    tmpFieldList: TStringList;
    strFieldValues, strFieldValue: string;
    tmpDate: TDateTime;
    recFormat: TFormatSettings;
  begin
    if XMLRowDataNode = nil then
      exit;
    tmpFieldList := TStringList.Create;
    try
      for i := 0 to tmpCDS.FieldCount - 1 do
        if tmpCDS.Fields[i].DataType in [ftDate, ftTime, ftDateTime] then
        tmpFieldList.Add(tmpCDS.Fields[i].FieldName);
      if tmpFieldList.Count = 0 then
        exit;
      for i := 0 to XMLRowDataNode.ChildNodes.Count - 1 do
        if TXMLHelper.NodeNameEqual(XMLRowDataNode.ChildNodes[i], 'ROW') then
        begin
          strFieldValues := '';
          for j := 0 to tmpFieldList.Count - 1 do
          begin
            strFieldValue := TXMLHelper.GetNodeAttributeValue(XMLRowDataNode.ChildNodes[i], tmpFieldList[j]);
            if strFieldValue = ''then
              Continue;
            recFormat.DateSeparator := #0;
            recFormat.ShortDateFormat := 'yyyymmdd';
            if TryStrToDateTime(strFieldValue, tmpDate, recFormat) then
              strFieldValues := strFieldValues + Format('%s=%s;', [tmpFieldList[j],
                FormatDateTime('yyyy-mm-dd hh:nn:ss', tmpDate)])
            else
              if Length(strFieldValue) = 8 then
              begin
                strFieldValue := Format('%s-%s-%s', [Copy(strFieldValue, 1, 4),
                  Copy(strFieldValue, 5, 2), Copy(strFieldValue, 7, 2)]);
                strFieldValues := strFieldValues + Format('%s=%s;', [tmpFieldList[j], strFieldValue]);
              end
              else
                strFieldValues := strFieldValues + Format('%s=%s;', [tmpFieldList[j], '']);
          end;
          if strFieldValues = '' then
            Continue
          else
            Delete(strFieldValues, Length(strFieldValues), 1);
          TXMLHelper.AddAttributes(XMLRowDataNode.ChildNodes[i], strFieldValues);
        end;
    finally
      tmpFieldList.Free;
    end;
  end;
begin
//Data必须传的是TClientDataSet.Data，而不能是TClientDataSet.Delta。否则此处生成XML文件有异常
  tmpCDS := TClientDataSet.Create(self);
  tmpCDSDelta := TClientDataSet.Create(self);
  tmpStream := TMemoryStream.Create;
//  ShowMessage('begin to xml');
  XMLDocument := NewXMLDocument;
  XMLNewDocument := TXMLHelper.NewXMLDocument('1.0', 'GBK', 'DATAPACKET');
  try
    //初始化XML
    XMLNewDocument.Options := XMLNewDocument.Options + [doNodeAutoIndent];
    TXMLHelper.AddAttributes(XMLNewDocument.DocumentElement, 'Version=2.0');
    XMLTableNode := TXMLHelper.CreateNode(XMLNewDocument.DocumentElement, 'TABLE', '', 'NAME=' + TableNameOrSQL);
    //加载数据
//    ShowMessage('assign cds data');
    tmpCDS.Data := Data;
    if tmpCDS.ChangeCount > 0 then
    begin
      tmpCDSDelta.Data := tmpCDS.Delta;
      tmpCDS.MergeChangeLog;
      //删除未修改的数据
      tmpCDS.First;
      while not tmpCDS.Eof do
        if LocateUpdateStatus then
          tmpCDS.Next
        else
          tmpCDS.Delete;
      i := tmpCDS.RecordCount;
      if tmpCDS.ChangeCount > 0 then
        tmpCDS.MergeChangeLog;
    end;
    tmpCDS.SaveToStream(tmpStream, dfXMLUTF8);
//    ShowMessage('save cds data to xml file');
//    tmpCDS.SaveToFile('c:\cds_data.xml', dfXMLUTF8);
    tmpStream.Position := 0;
    //复制XML节点
    XMLDocument.LoadFromStream(tmpStream);
    for i := 0 to XMLDocument.DocumentElement.ChildNodes.Count - 1 do
    begin
      XMLChildNode := XMLDocument.DocumentElement.ChildNodes[i].CloneNode(true);
      XMLTableNode.ChildNodes.Add(XMLChildNode);
    end;
    XMLMetaDataNode := TXMLHelper.GetChildNode(XMLTableNode, 'METADATA');
    XMLFieldsNode := TXMLHelper.GetChildNode(XMLMetaDataNode, 'FIELDS');
    XMLParamsNode := TXMLHelper.GetChildNode(XMLMetaDataNode, 'PARAMS');
    XMLRowDataNode := TXMLHelper.GetChildNode(XMLTableNode, 'ROWDATA');
    //修改字段数据类型
    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 CompareText(strFieldType, 'r8') = 0 then
              strFieldType := 'NUMERIC'
            else if CompareText(strFieldType, 'dateTime') = 0 then
              strFieldType := 'DATE'
            else
              strFieldType := 'VARCHAR';
            TXMLHelper.AddAttributes(XMLChildNode, 'fieldtype=' + strFieldType);
          end;
        end;
    //添加关键字段列表节点"KEYFIELDS"
    if (KeyFields <> '') and (XMLMetaDataNode <> nil) then
    begin
      XMLKeyFieldsNode := XMLNewDocument.CreateNode('KEYFIELDS');
      XMLMetaDataNode.ChildNodes.Insert(0, XMLKeyFieldsNode);
      for i := 0 to SubStrCount(KeyFields) do
      begin
        strFieldName := CopySubStr(KeyFields, i);
        if strFieldName = '' then
          Continue;
        TXMLHelper.CreateNode(XMLKeyFieldsNode, 'KEYFIELD', KeyFieldName(strFieldName));
      end;
    end;
    //删除多余的"PARAMS"节点
    if (XMLMetaDataNode <> nil) and (XMLParamsNode <> nil) then
      XMLMetaDataNode.ChildNodes.Delete(XMLMetaDataNode.ChildNodes.IndexOf(XMLParamsNode));
    //添加删除的记录
    if (KeyFields <> '') and tmpCDSDelta.Active and (not tmpCDSDelta.IsEmpty) then
    begin
      XMLDeleteRowDataNode := TXMLHelper.CreateNode(XMLTableNode, 'DELETEROWDATA', '');
      tmpCDSDelta.First;
      while not tmpCDSDelta.Eof do
      begin
        case tmpCDSDelta.UpdateStatus of
          usDeleted:
            TXMLHelper.CreateNode(XMLDeleteRowDataNode, 'ROW', '', GetAttribute);
        end;
        tmpCDSDelta.Next;
      end;           
    end;
    //FormatDateFieldValue;
    Result := XMLNewDocument.XML.Text;
    //XMLNewDocument.SaveToFile('c:\data.xml');
  finally
    XMLNewDocument := nil;
    XMLDocument := nil;
    tmpStream.Free;
    tmpCDSDelta.Free;
    tmpCDS.Free;
  end;
end;

function TWebDataAccess.DataAsXML(DataList: TList): string;
var
  tmpBatchDataSet: TBatchDataSet;
  i: integer;
  XMLDocument, XMLSubDocument: IXMLDocument;
  XMLNewNode, XMLChildNode: IXMLNode;
begin
  Result := '';
  if DataList.Count = 0 then
    exit;
  XMLDocument := TXMLHelper.NewXMLDocument('1.0', 'GBK', 'DATAPACKET');
  try
    XMLDocument.Options := XMLDocument.Options + [doNodeAutoIndent];
    TXMLHelper.AddAttributes(XMLDocument.DocumentElement, 'Version=2.0');
    for i := 0 to DataList.Count - 1 do
    begin
      tmpBatchDataSet := TBatchDataSet(DataList.Items[i]);
      if tmpBatchDataSet = nil then
        raise Exception.Create('空数据集引用,不能正常转换为XML数据文件');
//      ShowMessage('begin data to xml');
      XMLSubDocument := LoadXMLData(DataAsXML(tmpBatchDataSet));
//      ShowMessage('end data to xml');
      try
        XMLNewNode := TXMLHelper.GetChildNode(XMLSubDocument.DocumentElement, 'TABLE');
        XMLNewNode := XMLNewNode.CloneNode(true);
        XMLDocument.DocumentElement.ChildNodes.Add(XMLNewNode);
      finally
        XMLSubDocument := nil;
      end;
    end;
    Result := XMLDocument.XML.Text;
//    XMLDocument.SaveToFile('c:\batch_data.xml');
  finally
    XMLDocument := nil;
  end;
end;

function TWebDataAccess.ExcuteSQL(const ASQL: string): Boolean;
var
  strURL, strResponse: string;
begin
  strURL := Format('%s%s?' + ExcuteSQLURL, [WebURL, OperateBaseURL, ParamsEncode(ASQL)]);
  strResponse := RequestRemoteGet(strURL);
  Result := StrToBoolDef(strResponse, False);
end;

function TWebDataAccess.GetBlobContent(const TableName, KeyFieldName,
  KeyFieldValue, BlobFieldName: string;
  BlobFieldContent: TStream): boolean;
var
  strURL: string;
begin
  strURL := Format('%s%s?' + QueryBlobContentURL, [WebURL, OperateBaseURL,
    TableName, ParamsEncode(KeyFieldName), ParamsEncode(FillKeyValues(KeyFieldName,
      KeyFieldValue)), BlobFieldName]);
  RequestRemoteGet(strURL, BlobFieldContent);
  Result := True;
end;

function TWebDataAccess.GetData(const TableNameOrSQL: string): OleVariant;
var
  strURL, strURLParams: string;

  function GetSQL(ASQL: string): string;
  begin
    Result := trim(ASQL);
    if Pos(' ', Result) = 0 then//仅表名
      Result := Format('select * from %s', [Result]);
  end;
  
  function ConvertTableNameToSQL(ASQL: string): string;
  var
    i: Integer;
  begin
    Result := '';
    for i := 0 to SubStrCount(ASQL) do
      Result := Result + GetSQL(CopySubStr(ASQL, i)) + ';';
    if Result <> '' then
      Delete(Result, Length(Result), 1);
  end;
begin
  try
    strURL := Format('%s%s', [WebURL, OperateBaseURL]);
    strURLParams := Format(QueryDataURL, [ParamsEncode(ConvertTableNameToSQL(TableNameOrSQL))]);
    if Pos(';', TableNameOrSQL) > 0 then//检查是否多条语句
      Result := XMLAsData(RequestRemotePost(strURL, strURLParams))
    else
      Result := XMLAsData(RequestRemotePost(strURL, strURLParams), 0);
  except
    on e: Exception do
      raise Exception.CreateFmt('不能查询数据数据。'
        + #13#10'SQL:'#13#10'%s'
        + #13#10'错误:'#13#10'%s', [TableNameOrSQL, e.Message]);
  end;
end;

function TWebDataAccess.GetID(const TableName: string): string;