用于多表更新

 

{-----------------------------------------------------------------------------
 单元文件:  ADOXQuery
 作者:     张峰林
 建立日期:  2003-10-23 10:55:30
 作用:
 修改历史:
-----------------------------------------------------------------------------}

unit ADOXQuery;

Interface usesinterface

uses
  SysUtils, StrUtils,Classes,Variants, ADOInt, DB, ADODB;

type
  TADOXQuery = Class (class(TCustomADODataSet)
  private
    FSQL: TStrings;
    FRowsAffected: Integer;
    FSqlUpdateTable:String;
    FSqlKeyField:String;
    FEditCommand: TADOCommand;
    FSqlPost:Boolean;
    FSqlFieldList:TStrings;
    Function GetSQL()function GetSQL: TStrings;
    procedure SetSQL(const Value: TStrings);
    //设置自定义属性
    procedure SetSqlUpdateTable(const value:String);
    procedure SetSqlKeyField(const value:String);
    procedure SetSqlPost(Const Value:Boolean);
    //删除某一数据集的某一行
    Function DelRow()function DelRow():String;
    //编辑某一数据集的某一行
    Function EditRow()function EditRow():String;
    //某一数据集中新增一行
    Function AddRow()function AddRow():String;
    //取得可供SQL使用的字段值
    Function GetSqlFieldValue()function GetSqlFieldValue(Field:TField):String;
    //运行命令语句
    procedure RunCommand(StrSql:String);
    //显示数据操作错误信息
    procedure ShowError;
  protected
    procedure QueryChanged(Sender: TObject);
    procedure InternalDelete; override;
    procedure InternalPost; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    Function ExecSQL()function ExecSQL: Integer; {for TQuery compatibility}
    Property RowsAffected()property RowsAffected: Integer read FRowsAffected;
//    procedure Post;override;
    procedure Requery(Options: TExecuteOptions = []);
  published
    Property CommandTimeout()property CommandTimeout;
//    Property DataSource()property DataSource;
    Property EnableBCD()property EnableBCD;
    Property ParamCheck()property ParamCheck;
    Property Parameters()property Parameters;
    Property Prepared()property Prepared;
    Property SQL()property SQL: TStrings read GetSQL write SetSQL;
    Property SqlUpdateTable()property SqlUpdateTable: String read FSqlUpdateTable write SetSqlUpdateTable;
    Property SqlKeyField()property SqlKeyField: String read FSqlKeyField write SetSqlKeyField;
    Property SqlPost()property SqlPost:Boolean read FSqlPost write SetSqlPost;
  end;

procedure Register;

implementation

uses
  Dialogs;

procedure Register;
begin
  RegisterComponents('ADO', [TADOXQuery]);
end;

{ TADOXQuery }

{-----------------------------------------------------------------------------
  名称:  TADOXQuery.AddRow
  作用:  取得添加一行数据的 SQL语句
  作者:  张峰林
  日期:  2003-10-23 11:02:11
  参数:
  返回:  String
  流程:
-----------------------------------------------------------------------------}
Function TADOXQuery()function TADOXQuery.AddRow(): String;
var
  strSql,strFieldList,strValueList:String;  //SQL语句变量、字段列表变量、值列表变量
  intRecNo :Integer;    //字段序号
  NoFirst:Boolean;      //是否已经不是真正修改的第一个字段
begin
  //初始化
  Result := '';

  if FSqlUpdateTable = '' then
  begin
    MessageDlg(' “SqlUpdateTable” 属性为空，不能用SQL方式新增数据！', mtError, [mbOK], 0);
    exit;
  end;

  //更新目标数据表的字段列表
  if FSqlFieldList.Count = 0 then
    Connection.GetFieldNames(SqlUpdateTable,FSqlFieldList);

  NoFirst := false;
  strSql := 'INSERT INTO ' + FSqlUpdateTable;
  for intRecNo := 0 to FieldCount -1 do
  begin
    //如果字段为只读，则找下一个字段
    if Fields[intRecNo].ReadOnly then Continue;
    //如果字段不属于可更新数据表，则找下一个字段
    if FSqlFieldList.IndexOf(Fields[intRecNo].FieldName) = -1 then Continue;
    case Fields[intRecNo].DataType of   //合适的数据可以处理，否则不能处理
      ftString, ftFixedChar, ftGuid, ftWideString, ftAutoInc, ftInteger,
      ftSmallInt,ftWord,ftBoolean,ftFloat, ftCurrency,ftDate, ftTime,
      ftDateTime,ftBCD,ftLargeInt,ftMemo:
      begin
        if Fields[intRecNo].AsString = '' then Continue;
        if NoFirst then  //如果不是第一个字段，则加逗号
        begin
          strValueList := strValueList + ', ';
          strFieldList := strFieldList + ', ';
        end
        else
          NoFirst := true;

        strFieldList := strFieldList + '[' + Fields[intRecNo].FieldName + ']';
        strValueList := strValueList + GetSqlFieldValue(Fields[intRecNo]);
      end;
    end;
  end;
  strSql := strSql + '(' + strFieldList + ') VALUES(';
  strSql := strSql + strValueList + ')';

  if NoFirst then Result := strSql;

end;

constructor TADOXQuery.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FEditCommand := TADOCommand.Create(Self);
//  FEditCommand.ComponentRef := Self;
  FSqlPost := false;
  FSQL := TStringList.Create;
  FSqlFieldList := TStringList.Create;
  TStringList(FSQL).OnChange := QueryChanged;
//  Command.CommandTextAlias := 'SQL'; { Do not localize }
end;

{-----------------------------------------------------------------------------
  名称:  TADOXQuery.DelRow
  作用: 取得删除一行的SQL语句
  作者:  张峰林
  日期:  2003-10-23 10:56:10
  参数:  无
  返回:  String
  流程:
-----------------------------------------------------------------------------}
Function TADOXQuery()function TADOXQuery.DelRow():String;
begin

  Result := '';
  if FSqlUpdateTable = '' then
  begin
    MessageDlg('“SqlUpdateTable” 属性为空，不能用SQL方式删除数据！', mtError, [mbOK], 0);
    exit;
  end;

  //更新目标数据表的字段列表
  if FSqlFieldList.Count = 0 then
    Connection.GetFieldNames(SqlUpdateTable,FSqlFieldList);

  if FSqlKeyField = '' then
  begin
    MessageDlg(' “SqlKeyField” 属性为空，不能用SQL方式删除数据！', mtError, [mbOK], 0);
    exit;
  end;

  if FSqlFieldList.IndexOf(SqlKeyField) = -1 then
  begin
    MessageDlg('“' + SqlUpdateTable + '”表中找不到“' + SqlKeyField + '”字段，不能用SQL方式更新数据！', mtError, [mbOK], 0);
    exit;
  end;

  Result := 'delete from ' + FSqlUpdateTable + ' where ' + FSqlKeyField;
  Result := Result + ' = ' + GetSqlFieldValue(fieldbyname(FSqlKeyField));
end;

destructor TADOXQuery.Destroy;
begin
  FreeAndNil(FEditCommand);
  FreeAndNil(FSQL);
  FSqlFieldList.Clear;
  FSqlFieldList.Free;
  inherited Destroy;
end;

{-----------------------------------------------------------------------------
  名称:  TADOXQuery.EditRow
  作用:  取得编辑一行数据的 SQL语句
  作者:  张峰林
  日期:  2003-10-23 11:00:43
  参数:  无
  返回:  String
  流程:
-----------------------------------------------------------------------------}
Function TADOXQuery()function TADOXQuery.EditRow(): String;
var
  strSql,OldFieldAsStr,CurFieldAsStr:String;
  intRecNo :Integer;    //字段序号
  NoFirst:Boolean;      //是否已经不是真正修改的第一个字段
begin

  Result := '';
  if FSqlUpdateTable = '' then
  begin
    MessageDlg('“SqlUpdateTable” 属性为空，不能用SQL方式更新数据！', mtError, [mbOK], 0);
    exit;
  end;

  //更新目标数据表的字段列表
  if FSqlFieldList.Count = 0 then
    Connection.GetFieldNames(SqlUpdateTable,FSqlFieldList);

  if FSqlKeyField = '' then
  begin
    MessageDlg(' “SqlKeyField” 属性为空，不能用SQL方式更新数据！', mtError, [mbOK], 0);
    exit;
  end;

  if FSqlFieldList.IndexOf(SqlKeyField) = -1 then
  begin
    MessageDlg('“' + SqlUpdateTable + '”表中找不到“' + SqlKeyField + '”字段，不能用SQL方式更新数据！', mtError, [mbOK], 0);
    exit;
  end;

  NoFirst := false;
  strSql := 'update ' + FSqlUpdateTable + ' set ';

  for intRecNo := 0 to FieldCount -1 do
  begin
    //如果字段为只读，则找下一个字段
//    if Fields[intRecNo].ReadOnly then Continue;
    //如果字段不属于可更新数据表，则找下一个字段
    if FSqlFieldList.IndexOf(Fields[intRecNo].FieldName) = -1 then Continue;
    case Fields[intRecNo].DataType of   //合适的数据可以处理，否则不能处理
      ftString, ftFixedChar, ftGuid, ftWideString, ftAutoInc, ftInteger,
      ftSmallInt,ftWord,ftBoolean,ftFloat, ftCurrency,ftDate, ftTime,
      ftDateTime,ftBCD,ftLargeInt,ftMemo:
      begin
        CurFieldAsStr := Fields[intRecNo].AsString;
        if VarIsNull(Fields[intRecNo].OldValue) then
          OldFieldAsStr := ''
        else
          OldFieldAsStr := Fields[intRecNo].OldValue;
        if CurFieldAsStr = OldFieldAsStr then Continue;
    //      if Fields[intRecNo].OldValue = Fields[intRecNo].NewValue then Continue;
        if NoFirst then strSql := strSql + ', ' else NoFirst := true;
        strSql := strSql + Fields[intRecNo].FieldName + ' = ';
        strSql := strSql + GetSqlFieldValue(Fields[intRecNo]);
      end;
    end;

  end;

  strSql := strSql + ' where ' + FSqlKeyField + ' = ';
  strSql := strSql + GetSqlFieldValue(fieldbyname(FSqlKeyField));

  if NoFirst then Result := strSql;

end;

Function TADOXQuery()function TADOXQuery.ExecSQL: Integer;
begin
//  InitializeMasterFields(Self);
  Command.Execute(FRowsAffected, EmptyParam);
  Result := FRowsAffected;
end;

Function TADOXQuery()function TADOXQuery.GetSQL: TStrings;
begin
  Result := FSQL;
end;

{-----------------------------------------------------------------------------
  名称:  TADOXQuery.GetSqlFieldValue
  作用:  取得可供SQL使用的字段值
  作者:  张峰林
  日期:  2003-10-23 11:05:48
  参数:  Field: TField
  返回:  String
  流程:
-----------------------------------------------------------------------------}
Function TADOXQuery()function TADOXQuery.GetSqlFieldValue(Field: TField): String;
begin
  //如果为空，则直接返回null
  if VarIsNull(Field.Value) then
  begin
    Result := 'Null';
    exit;
  end;

  case Field.DataType of     //布尔类型，则用1、0来替代
    ftBoolean:
    begin
      if Field.Value then
        Result := '1'
      else
        Result := '0';
    end;
    ftString,ftDateTime,ftWideString,ftDate, ftTime:        //布尔类型，则用1、0来替代
    begin
      Result := Field.AsString;
      Result := AnsiReplaceText(Result,'''','''''');
      Result := '''' + Result + '''';
    end;
    else
      Result := Field.AsString;
  end;
end;

procedure TADOXQuery.InternalDelete;
begin
  if SqlPost then
    RunCommand(DelRow())
  else
    inherited InternalDelete;
end;

procedure TADOXQuery.InternalPost;
begin

  if not SqlPost then
  begin
     inherited InternalPost;
     exit;
  end;

  if State = dsInsert then
  begin
    RunCommand(AddRow());   //新增数据
    Last;
  end
  else if State = dsEdit then
    RunCommand(EditRow());  //编辑数据

end;

procedure TADOXQuery.QueryChanged(Sender: TObject);
begin
  if not (csLoading in ComponentState) then
    Close;
  CommandText := FSQL.Text;
end;

procedure TADOXQuery.Requery(Options: TExecuteOptions);
var
  intNo:Integer;
begin
  CheckBrowseMode;
  InternalRequery(Options);
  intNo := RecNo;
  IF intNo < 1 THEN intNo := RecordCount;
//  ShowMessage(IntToStr(intNo));
  First;
  if not SqlPost THEN exit;
  IF NOT Eof THEN RecNo := intNo;
end;

procedure TADOXQuery.RunCommand(StrSql: String);
var
  intRowsAffected:Integer;
begin
  if StrSql = '' then exit;
  try
    DisableControls;
    Cancel;
//    MessageDlg(StrSql, mtInformation, [mbOK], 0);
    with FEditCommand do
    begin
      Connection := Command.Connection;
      CommandText := strSql;
      try
        Execute(intRowsAffected, adExecuteNoRecords);
        Requery();
      except
        ShowError;
      end;
    end;
  finally
    EnableControls;
  end;
end;

procedure TADOXQuery.SetSqlPost(const Value: Boolean);
begin
  FSqlPost := Value;
end;

procedure TADOXQuery.SetSqlKeyField(const value: String);
begin
  FSqlKeyField := value;
end;

procedure TADOXQuery.SetSQL(const Value: TStrings);
begin
  FSQL.Assign(Value);
end;

{
procedure InitializeMasterFields(Dataset: TCustomADODataset);
var
  I: Integer;
  MasterFieldList: string;
begin
  with DataSet do
   // Assign MasterFields from parameters as needed by the MasterDataLink
    if (Parameters.Count > 0) and Assigned(MasterDataLink.DataSource) and
      Assigned(MasterDataLink.DataSource.DataSet) then
    begin
      for I := 0 to Parameters.Count - 1 do
        if (Parameters[I].Direction in [pdInput, pdInputOutput]) and
          (MasterDataLink.DataSource.DataSet.FindField(Parameters[I].Name) <> nil) then
          MasterFieldList := MasterFieldList + Parameters[I].Name + ';';
      MasterFields := Copy(MasterFieldList, 1, Length(MasterFieldList)-1);
      SetParamsFromCursor;
    end;
end;
  }
procedure TADOXQuery.SetSqlUpdateTable(const value: String);
//var
//  TableList:TStrings;
begin
{  TableList := TStringList.Create;
  Connection.GetTableNames(TableList,False);
  if TableList.IndexOf(SqlUpdateTable) = -1 then
    MessageDlg('“' + value + '”表不存在，请重新设置！', mtError, [mbOK], 0)
  else
    FSqlUpdateTable := value;
  TableList.Clear;
  TableList.Free;}
  FSqlUpdateTable := value;
end;

{-----------------------------------------------------------------------------
  名称:  TADOXQuery.ShowError
  作用:  显示数据操作错误
  作者:  谢宏智
  日期:  2003-12-01 9:26:17
  参数:  None
  返回:  None
  流程:
-----------------------------------------------------------------------------}
procedure TADOXQuery.ShowError;
var
  AdoErrors: Errors;
  AdoError: Error;
  i: Integer;
  ErrorStr,AllErrStr: String;
begin
  AdoErrors := FEditCommand.Connection.Errors;
  AllErrStr := '操作失败，共发生' + IntToStr(AdoErrors.Count - 1) + '个错误：' + #10#13#10#13;
  for i := 0 to AdoErrors.Count - 2 do
  begin
    AdoError := AdoErrors.Item[i];
    ErrorStr := AdoError.Description;
    ErrorStr := AnsiReplaceStr(ErrorStr,'NULL','空');
    ErrorStr := AnsiReplaceStr(ErrorStr,'INSERT','插入');
    ErrorStr := AnsiReplaceStr(ErrorStr,'PRIMARY KEY','主键');
    ErrorStr := AnsiReplaceStr(ErrorStr,'UPDATE','修改');
    ErrorStr := AnsiReplaceStr(ErrorStr,'COLUMN','列');
    ErrorStr := AnsiReplaceStr(ErrorStr,'DELETE','删除');

    AllErrStr := AllErrStr + '第 ' + IntToStr(i + 1) + '个错误：' + #10#13;
    AllErrStr := AllErrStr +  '错误号：' +  IntToStr(AdoError.NativeError) + '；' + #10#13;
    AllErrStr := AllErrStr + '错误描述：' + ErrorStr + '；' + #10#13 + #10#13
  end;
  AllErrStr := AllErrStr + '操作已被取消!';
  MessageDlg(AllErrStr, mtError, [mbOK], 0);
end;

end.