updatesqlediteh.pas

最新的 DBGRIDEH4.0

{*******************************************************}
{                                                       }
{       Borland Delphi Visual Component Library         }
{       UpdateSQL Component Editor                      }
{                                                       }
{       Copyright (c) 1997,1999 Borland Software Corp.  }
{                                                       }
{       Changed by Dmitry V. Bolshakov                  }
{                                                       }
{*******************************************************}

unit UpdateSQLEditEh;

{$I EHLIB.INC}

interface

uses Forms, DB, ExtCtrls, StdCtrls, Controls, ComCtrls,
  Classes, SysUtils, Windows, Menus, DataDriverEh, MemTableEh, Graphics,
{$IFDEF EH_LIB_6}
  Variants,
{$ENDIF}
  Mask, DBCtrlsEh, MemTableDataEh;

type

  TWaitMethod = procedure of object;

  TUpdateSQLEditFormEh = class(TForm)
    OkButton: TButton;
    CancelButton: TButton;
    HelpButton: TButton;
    GenerateButton: TButton;
    PrimaryKeyButton: TButton;
    DefaultButton: TButton;
    UpdateTableName: TComboBox;
    FieldsPage: TTabSheet;
    SQLPage: TTabSheet;
    PageControl: TPageControl;
    KeyFieldList: TListBox;
    UpdateFieldList: TListBox;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    FTempTable: TMemTableEh;
    QuoteFields: TCheckBox;
    GetTableFieldsButton: TButton;
    FieldListPopup: TPopupMenu;
    miSelectAll: TMenuItem;
    miClearAll: TMenuItem;
    PageControl1: TPageControl;
    tsInsert: TTabSheet;
    tsModify: TTabSheet;
    tsDelete: TTabSheet;
    tsGetrec: TTabSheet;
    MemoInsert: TMemo;
    MemoModify: TMemo;
    MemoDelete: TMemo;
    MemoGetRec: TMemo;
    cbUpdate: TCheckBox;
    cbDelete: TCheckBox;
    cbGetRec: TCheckBox;
    cbInsert: TCheckBox;
    cbIncrementField: TComboBox;
    Label2: TLabel;
    cbIncrementObject: TComboBox;
    labelUpdateObjects: TLabel;
    tsSpecParams: TTabSheet;
    cbSpecParams: TCheckBox;
    Panel11: TPanel;
    Label5: TLabel;
    Label6: TLabel;
    cbUpdateFields: TCheckBox;
    cbKeyFields: TCheckBox;
    cbTableName: TCheckBox;
    Label7: TLabel;
    Panel1: TPanel;
    Panel10: TPanel;
    Label8: TLabel;
    Bevel4: TBevel;
    bLoadSpecString: TButton;
    mSpecParams: TMemo;
    Bevel1: TBevel;
    Bevel2: TBevel;
    Bevel3: TBevel;
    MemoUpdateFields: TMemo;
    MemoKeyFields: TMemo;
    dbeTableName: TDBEditEh;
    procedure FormCreate(Sender: TObject);
    procedure HelpButtonClick(Sender: TObject);
    procedure DefaultButtonClick(Sender: TObject);
    procedure GenerateButtonClick(Sender: TObject);
    procedure PrimaryKeyButtonClick(Sender: TObject);
    procedure PageControlChanging(Sender: TObject;
      var AllowChange: Boolean);
    procedure GetTableFieldsButtonClick(Sender: TObject);
    procedure SettingsChanged(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure UpdateTableNameChange(Sender: TObject);
    procedure UpdateTableNameClick(Sender: TObject);
    procedure SelectAllClick(Sender: TObject);
    procedure ClearAllClick(Sender: TObject);
    procedure cbInsertClick(Sender: TObject);
    procedure MemoModifyKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    DataDriver: TCustomSQLDataDriverEh;
    FSettingsChanged: Boolean;
    FDatasetDefaults: Boolean;
    function GetTableRef(const TabName, QuoteChar: string): string;
    function Edit: Boolean;
    procedure GenWhereClause(const TabAlias, QuoteChar: string; KeyFields, SQL: TStrings);
    procedure GenDeleteSQL(const TableName, QuoteChar: string; KeyFields, SQL: TStrings);
    procedure GenInsertSQL(const TableName, QuoteChar: string; UpdateFields, SQL: TStrings);
    procedure GenModifySQL(const TableName, QuoteChar: string; KeyFields, UpdateFields, SQL: TStrings);
    procedure GenGetRecSQL(SelectSQL, KeyFields, SQL: TStrings);
    procedure GenerateSQL;
    procedure FillMemoFromList(Memo: TMemo; List: TListBox);
    procedure GenerateSQLViaDBService;
    procedure GetDataSetFieldNames;
    procedure GetTableFieldNames;
    procedure InitGenerateOptions;
    procedure InitUpdateTableNames;
    procedure SetButtonStates;
    procedure SelectPrimaryKeyFields;
    procedure SetDefaultSelections;
    procedure ShowWait(WaitMethod: TWaitMethod);
//    function TempTable: TMemTableEh;
  end;

{ TSQLParser }

  TSQLToken = (stSymbol, stAlias, stNumber, stComma, stEQ, stOther, stLParen,
    stRParen, stEnd);

  TSQLParser = class
  private
    FText: string;
    FSourcePtr: Integer;
    FTokenPtr: Integer;
    FTokenString: string;
    FToken: TSQLToken;
    FSymbolQuoted: Boolean;
    function NextToken: TSQLToken;
    function TokenSymbolIs(const S: string): Boolean;
    procedure Reset;
  public
    constructor Create(const Text: string);
    procedure GetSelectTableNames(List: TStrings);
    procedure GetUpdateTableName(var TableName: string);
    procedure GetUpdateFields(List: TStrings);
    procedure GetWhereFields(List: TStrings);
  end;

function EditDataDriverUpdateSQL(ADataDriver: TCustomSQLDataDriverEh): Boolean;

implementation

{$R *.dfm}

uses Dialogs, TypInfo, SQLDriverEditEh;

{ Global Interface functions }

function EditDataDriverUpdateSQL(ADataDriver: TCustomSQLDataDriverEh): Boolean;
begin
  with TUpdateSQLEditFormEh.Create(Application) do
  try
    DataDriver := ADataDriver;
    Result := Edit;
  finally
    Free;
  end;
end;

{ Utility Routines }

procedure GetSelectedItems(ListBox: TListBox; List: TStrings);
var
  I: Integer;
begin
  List.Clear;
  for I := 0 to ListBox.Items.Count - 1 do
    if ListBox.Selected[I] then
      List.Add(ListBox.Items[I]);
end;

function SetSelectedItems(ListBox: TListBox; List: TStrings): Integer;
var
  I: Integer;
begin
  Result := 0;
  ListBox.Items.BeginUpdate;
  try
    for I := 0 to ListBox.Items.Count - 1 do
      if List.IndexOf(ListBox.Items[I]) > -1 then
      begin
        ListBox.Selected[I] := True;
        Inc(Result);
      end
      else
        ListBox.Selected[I] := False;
    if ListBox.Items.Count > 0 then
    begin
      ListBox.ItemIndex := 0;
      ListBox.TopIndex := 0;
    end;
  finally
    ListBox.Items.EndUpdate;
  end;
end;

procedure SelectAll(ListBox: TListBox);
var
  I: Integer;
begin
  ListBox.Items.BeginUpdate;
  try
    with ListBox do
      for I := 0 to Items.Count - 1 do
        Selected[I] := True;
    if ListBox.Items.Count > 0 then
    begin
      ListBox.ItemIndex := 0;
      ListBox.TopIndex := 0;
    end;
  finally
    ListBox.Items.EndUpdate;
  end;
end;

{procedure GetDataFieldNames(Dataset: TDataset; ErrorName: string; List: TStrings);
var
  I: Integer;
begin
  with Dataset do
  try
    FieldDefs.Update;
    List.BeginUpdate;
    try
      List.Clear;
      for I := 0 to FieldDefs.Count - 1 do
        List.Add(FieldDefs[I].Name);
    finally
      List.EndUpdate;
    end;
  except
    if ErrorName <> '' then
      MessageDlg(Format('SSQLDataSetOpen', [ErrorName]), mtError, [mbOK], 0);
  end;
end;
}

procedure GetSQLTableNames(const SQL: string; List: TStrings);
begin
  with TSQLParser.Create(SQL) do
  try
    GetSelectTableNames(List);
  finally
    Free;
  end;
end;

procedure ParseUpdateSQL(const SQL: string; var TableName: string;
  UpdateFields: TStrings; WhereFields: TStrings);
begin
  with TSQLParser.Create(SQL) do
  try
    GetUpdateTableName(TableName);
    if Assigned(UpdateFields) then
    begin
      Reset;
      GetUpdateFields(UpdateFields);
    end;
    if Assigned(WhereFields) then
    begin
      Reset;
      GetWhereFields(WhereFields);
    end;
  finally
    Free;
  end;
end;

{ TSQLParser }

constructor TSQLParser.Create(const Text: string);
begin
  inherited Create;
  FText := Text;
  FText := FText + #0;
  FSourcePtr := 1;
  NextToken;
end;

function TSQLParser.NextToken: TSQLToken;
var
  P, TokenStart: Integer;
  QuoteChar: Char;
  IsParam: Boolean;

{$IFDEF CIL}
{$ELSE}
  function IsKatakana(const Chr: Byte): Boolean;
  begin
    Result := (SysLocale.PriLangID = LANG_JAPANESE) and (Chr in [$A1..$DF]);
  end;
{$ENDIF}

begin
  if FToken = stEnd then SysUtils.Abort;
  FTokenString := '';
  FSymbolQuoted := False;
  P := FSourcePtr;
  while (FText[P] <> #0) and (FText[P] <= ' ') do Inc(P);
  FTokenPtr := P;
  case FText[P] of
    'A'..'Z', 'a'..'z', '_', '$', #127..#255:
      begin
        TokenStart := P;
        if not SysLocale.FarEast then
        begin
          Inc(P);
          while FText[P] in ['A'..'Z', 'a'..'z', '0'..'9', '_', '.', '"', '$', #127..#255] do Inc(P);
        end
        else
          begin
            while TRUE do
            begin
              if (FText[P] in ['A'..'Z', 'a'..'z', '0'..'9', '_', '.', '"', '$'])
{$IFDEF CIL}
{$ELSE}
                 or IsKatakana(Byte(FText[P]))
{$ENDIF}
              then
                Inc(P)
              else
                if FText[P] in LeadBytes then
                  Inc(P, 2)
                else
                  Break;
            end;
          end;
        FTokenString := Copy(FText, TokenStart, P - TokenStart);

//        SetString(FTokenString, TokenStart, P - TokenStart);
        FToken := stSymbol;
      end;
    '''', '"':
      begin
        QuoteChar := FText[P];
        Inc(P);
        IsParam := FText[P] = ':';
        if IsParam then Inc(P);
        TokenStart := P;
        while not (FText[P] in [QuoteChar]) and not (FText[P] = #0) do Inc(P);
        FTokenString := Copy(FText, TokenStart, P - TokenStart);
//        SetString(FTokenString, TokenStart, P - TokenStart);
        Inc(P);
        Trim(FTokenString);
        FToken := stSymbol;
        FSymbolQuoted := True;