zupdatesql.pas

控件名称：WINZEOS.ZIP 2002年08月03日 作者：CapellaDevelopment Zeos系列构件套件包含一组可直接存取Linux知名的免费数据库MySQL、Postgre

{********************************************************}
{                                                        }
{                 Zeos Database Objects                  }
{             Unidatabase UpdateSql component            }
{                                                        }
{       Copyright (c) 1999-2001 Sergey Seroukhov         }
{    Copyright (c) 1999-2001 Zeos Development Group      }
{                                                        }
{********************************************************}

unit ZUpdateSql;

interface

{$R *.dcr}

{$IFNDEF LINUX}
{$INCLUDE ..\ZeosDef.inc}
{$ELSE}
{$INCLUDE ../ZeosDef.inc}
{$ENDIF}

uses
  SysUtils, Variants, Classes, DB, ZExtra, ZToken, ZSqlTypes,
  ZSqlItems, ZSqlBuffer;

{$IFNDEF LINUX}
{$INCLUDE ..\Zeos.inc}
{$ELSE}
{$INCLUDE ../Zeos.inc}
{$ENDIF}

type
  { TZUpdateSql }
  TZUpdateSql = class(TComponent)
  private
    FDeleteSql, FInsertSql, FModifySql: TStrings;
    FDeleteQuery, FInsertQuery, FModifyQuery: string;
    FDataset: TDataset;

    procedure SetSql(UpdateKind: TUpdateKind; Value: TStrings);
    function GetSql(UpdateKind: TUpdateKind): TStrings;
    function GetParamValue(Name: string): string;

    procedure SetDeleteSql(Value: TStrings);
    procedure SetInsertSql(Value: TStrings);
    procedure SetModifySql(Value: TStrings);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure Apply(UpdateKind: TUpdateKind);
    procedure ExecSql(UpdateKind: TUpdateKind);
    procedure SetParams(UpdateKind: TUpdateKind);

    property DataSet: TDataset read FDataset write FDataset;
    property Sql[UpdateKind: TUpdateKind]: TStrings read GetSql write SetSql;
  published
    property DeleteSql: TStrings read FDeleteSql write SetDeleteSql;
    property InsertSql: TStrings read FInsertSql write SetInsertSql;
    property ModifySql: TStrings read FModifySql write SetModifySql;
  end;

implementation

uses ZQuery, ZDBaseConst;

{****************** TZUpdateSql implementation *************}

{ Class constructor }
constructor TZUpdateSql.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDeleteSql := TStringList.Create;
  FInsertSql := TStringList.Create;
  FModifySql := TStringList.Create;
end;

{ Class destructor }
destructor TZUpdateSql.Destroy;
begin
  FDeleteSql.Free;
  FInsertSql.Free;
  FModifySql.Free;
  inherited Destroy;
end;

{ Internal method to set XXXSql property }
procedure TZUpdateSql.SetSql(UpdateKind: TUpdateKind; Value: TStrings);
begin
  case UpdateKind of
    ukModify: FModifySql.Assign(Value);
    ukInsert: FInsertSql.Assign(Value);
    ukDelete: FDeleteSql.Assign(Value);
  end;
end;

{ Internal method to get XXXSql property }
function TZUpdateSql.GetSql(UpdateKind: TUpdateKind): TStrings;
begin
  case UpdateKind of
    ukModify: Result := FModifySql;
    ukInsert: Result := FInsertSql;
    else Result := FDeleteSql;
  end;
end;

{ Get field value by parameter name }
function TZUpdateSql.GetParamValue(Name: string): string;
var
  FieldDesc: PFieldDesc;
  Dataset: TZDataset;
  IsNew: Boolean;
  Field: TField;
  FieldValue: Variant;
begin
  if Name = ':' then
  begin
    Result := ':';
    Exit;
  end;

  if StrCmpBegin('OLD_', UpperCase(Name)) then
  begin
    IsNew := False;
    Name := Copy(Name, 5, Length(Name)-4);
  end
  else
  begin
    IsNew := True;
    if StrCmpBegin('NEW_', UpperCase(Name)) then
      Name := Copy(Name, 5, Length(Name) - 4);
  end;

  if not Assigned(Self.Dataset) then
    DatabaseError(SDatasetNotDefined);

  Dataset := TZDataset(Self.Dataset);
  Field := Dataset.FieldByName(Name);
  FieldDesc := Dataset.SqlBuffer.SqlFields.FindByAlias(Name);

  if not Assigned(Field) or not Assigned(FieldDesc) then
    DatabaseError('Parameters can not be defined');

  if IsNew then
    FieldValue := Field.NewValue
  else FieldValue := Field.OldValue;

  if FieldValue = Null then
    Result := 'NULL'
  else
    Result := Dataset.FieldValueToSql(FieldValue, FieldDesc);
end;

{ Set value of Delete Sql statement }
procedure TZUpdateSql.SetDeleteSql(Value: TStrings);
begin
  FDeleteSql.Assign(Value);
end;

{ Set value of Insert Sql statement }
procedure TZUpdateSql.SetInsertSql(Value: TStrings);
begin
  FInsertSql.Assign(Value);
end;

{ Set value of Modify Sql statement }
procedure TZUpdateSql.SetModifySql(Value: TStrings);
begin
  FModifySql.Assign(Value);
end;

{ Replace parameters and execute a query }
procedure TZUpdateSql.Apply(UpdateKind: TUpdateKind);
begin
  SetParams(UpdateKind);
  ExecSql(UpdateKind);
end;

{ Execute a query }
procedure TZUpdateSql.ExecSql(UpdateKind: TUpdateKind);
var
  Text: string;
begin
  if not Assigned(Dataset) then
    DatabaseError(SDatasetNotDefined);
  if not Assigned((Dataset as TZDataset).Transaction) then
    DatabaseError(STransactNotDefined);

  case UpdateKind of
    ukModify: Text := FModifyQuery;
    ukInsert: Text := FInsertQuery;
    ukDelete: Text := FDeleteQuery;
  end;

  if Text = '' then
    DatabaseError(SUpdateSqlIsEmpty);

  (Dataset as TZDataset).Transaction.BatchExecSql(Text);
end;

{ Replace parameters }
procedure TZUpdateSql.SetParams(UpdateKind: TUpdateKind);
var
  IsWhere: Boolean;
  EqualPos: Integer;
  Buffer, Token, Text: string;
begin
  Buffer := Sql[UpdateKind].Text;
  Text := '';
  EqualPos := 0;
  IsWhere := False;

  while Buffer <> '' do
  begin
    if Buffer[1] in [' ', #9, #10, #13] then
      Text := Text + ' ';
    ExtractToken(Buffer, Token);
    if (Token = ':') and (Buffer[1] <> ':') then
    begin
      ExtractToken(Buffer, Token);
      DeleteQuotes(Token);
      Token := GetParamValue(Token);
      if StrCaseCmp(Token, 'NULL') and IsWhere and (EqualPos > 0) then
      begin
        Delete(Text, EqualPos, Length(Text) - EqualPos + 1);
        Text := Text + ' IS ' + Token;
      end else
        Text := Text + Token;
    end
    else
    begin
      if Token = '=' then EqualPos := Length(Text) + 1
      else EqualPos := 0;

      if StrCaseCmp(Token, 'WHERE') then
        IsWhere := True
      else if StrCaseCmp(Token, 'ORDER') or StrCaseCmp(Token, 'HAVING')
        or StrCaseCmp(Token, 'GROUP') then
        IsWhere := False;

      Text := Text + Token;
    end;
  end;

  FDeleteQuery := '';
  FInsertQuery := '';
  FModifyQuery := '';
  case UpdateKind of
    ukModify: FModifyQuery := Text;
    ukInsert: FInsertQuery := Text;
    ukDelete: FDeleteQuery := Text;
  end;
end;

end.