updatesqlediteh.pas

最新的 DBGRIDEH4.0

      end;
    '-', '0'..'9':
      begin
        TokenStart := P;
        Inc(P);
        while FText[P] in ['0'..'9', '.', 'e', 'E', '+', '-'] do Inc(P);
        FTokenString := Copy(FText, TokenStart, P - TokenStart);
//        SetString(FTokenString, TokenStart, P - TokenStart);
        FToken := stNumber;
      end;
    ',':
      begin
        Inc(P);
        FToken := stComma;
      end;
    '=':
      begin
        Inc(P);
        FToken := stEQ;
      end;
    '(':
      begin
        Inc(P);
        FToken := stLParen;
      end;
    ')':
      begin
        Inc(P);
        FToken := stRParen;
      end;
    #0:
      FToken := stEnd;
  else
    begin
      FToken := stOther;
      Inc(P);
    end;
  end;
  FSourcePtr := P;
  if (FToken = stSymbol) and
    (FTokenString[Length(FTokenString)] = '.') then FToken := stAlias;
  Result := FToken;
end;

procedure TSQLParser.Reset;
begin
//  FSourcePtr := PChar(FText);
  FSourcePtr := 1;
  FToken := stSymbol;
  NextToken;
end;

function TSQLParser.TokenSymbolIs(const S: string): Boolean;
begin
  Result := (FToken = stSymbol) and (CompareText(FTokenString, S) = 0);
end;

procedure TSQLParser.GetSelectTableNames(List: TStrings);
begin
  List.BeginUpdate;
  try
    List.Clear;
    if TokenSymbolIs('SELECT') then { Do not localize }
    try
      while not TokenSymbolIs('FROM') do NextToken; { Do not localize }
      NextToken;
      while FToken = stSymbol do
      begin
{$IFDEF CIL}
        List.AddObject(FTokenString, TObject(FSymbolQuoted));
{$ELSE}
        List.AddObject(FTokenString, Pointer(Integer(FSymbolQuoted)));
{$ENDIF}
        if NextToken = stSymbol then NextToken;
        if FToken = stComma
          then NextToken
          else break;
      end;
    except
    end;
  finally
    List.EndUpdate;
  end;
end;

procedure TSQLParser.GetUpdateTableName(var TableName: string);
begin
  if TokenSymbolIs('UPDATE') and (NextToken = stSymbol) then { Do not localize }
    TableName := FTokenString else
    TableName := '';
end;

procedure TSQLParser.GetUpdateFields(List: TStrings);
begin
  List.BeginUpdate;
  try
    List.Clear;
    if TokenSymbolIs('UPDATE') then { Do not localize }
    try
      while not TokenSymbolIs('SET') do NextToken; { Do not localize }
      NextToken;
      while True do
      begin
        if FToken = stAlias then NextToken;
        if FToken <> stSymbol then Break;
        List.Add(FTokenString);
        if NextToken <> stEQ then Break;
        while NextToken <> stComma do
          if TokenSymbolIs('WHERE') then Exit;{ Do not localize }
        NextToken;
      end;
    except
    end;
  finally
    List.EndUpdate;
  end;
end;

procedure TSQLParser.GetWhereFields(List: TStrings);
begin
  List.BeginUpdate;
  try
    List.Clear;
    if TokenSymbolIs('UPDATE') then { Do not localize }
    try
      while not TokenSymbolIs('WHERE') do NextToken; { Do not localize }
      NextToken;
      while True do
      begin
        while FToken in [stLParen, stAlias] do NextToken;
        if FToken <> stSymbol then Break;
        List.Add(FTokenString);
        if NextToken <> stEQ then Break;
        while true do
        begin
          NextToken;
          if FToken = stEnd then Exit;
          if TokenSymbolIs('AND') then Break; { Do not localize }
        end;
        NextToken;
      end;
    except
    end;
  finally
    List.EndUpdate;
  end;
end;

function TUpdateSQLEditFormEh.Edit: Boolean;
var
  DataSetName: string;
begin
  Result := False;
{  if Assigned(UpdateSQL.DataSet) and (UpdateSQL.DataSet is TDBDataSet) then
  begin
    DataSet := TDBDataSet(UpdateSQL.DataSet);
//    FTempTable.SessionName := DataSet.SessionName;
//    FTempTable.DatabaseName := DataSet.DatabaseName;
    DataSetName := Format('%s%s%s', [DataSet.Owner.Name, DotSep, DataSet.Name]);
  end else
    DataSetName := SNoDataSet;}
  cbIncrementObject.Enabled := TDesignDataBaseEh(DataDriver.DesignDataBase).GetIncrementObjectsList <> nil;
  if cbIncrementObject.Enabled
    then labelUpdateObjects.Font.Color := clWindowText
    else labelUpdateObjects.Font.Color := clGrayText;

  Caption := Format('%s%s%s (%s)', ['DataDriver.Owner.Name', DotSep, DataDriver.Name, DataSetName]);

  MemoModify.Lines := DataDriver.UpdateSQL;
  MemoInsert.Lines := DataDriver.InsertSQL;
  MemoDelete.Lines := DataDriver.DeleteSQL;
  MemoGetRec.Lines := DataDriver.GetrecSQL;
  mSpecParams.Lines := TBaseSQLDataDriverEh(DataDriver).SpecParams;
  MemoUpdateFields.Lines.CommaText := TBaseSQLDataDriverEh(DataDriver).DynaSQLParams.UpdateFields;
  MemoKeyFields.Lines.CommaText := TBaseSQLDataDriverEh(DataDriver).DynaSQLParams.KeyFields;
  dbeTableName.Text := TBaseSQLDataDriverEh(DataDriver).DynaSQLParams.UpdateTable;
  if TBaseSQLDataDriverEh(DataDriver).DynaSQLParams.Options <> [] then
  begin
    cbUpdateFields.Checked := True;
    cbKeyFields.Checked := True;
    cbTableName.Checked := True;
  end else
  begin
    cbUpdateFields.Checked := False;
    cbKeyFields.Checked := False;
    cbTableName.Checked := False;
  end;
//    StatementTypeClick(Self);
  InitUpdateTableNames;
  ShowWait(InitGenerateOptions);
  PageControl.ActivePage := PageControl.Pages[0];
  if ShowModal = mrOk then
  begin
    DataDriver.UpdateSQL := MemoModify.Lines;
    DataDriver.InsertSQL := MemoInsert.Lines;
    DataDriver.DeleteSQL := MemoDelete.Lines;
    DataDriver.GetrecSQL := MemoGetRec.Lines;
    TBaseSQLDataDriverEh(DataDriver).SpecParams := mSpecParams.Lines;
    TBaseSQLDataDriverEh(DataDriver).DynaSQLParams.UpdateFields := MemoUpdateFields.Lines.CommaText;
    TBaseSQLDataDriverEh(DataDriver).DynaSQLParams.KeyFields := MemoKeyFields.Lines.CommaText;
    TBaseSQLDataDriverEh(DataDriver).DynaSQLParams.UpdateTable := dbeTableName.Text;
    Result := True;
  end;
end;

procedure TUpdateSQLEditFormEh.GenWhereClause(const TabAlias, QuoteChar: string;
  KeyFields, SQL: TStrings);
var
  I: Integer;
  BindText: string;
  FieldName: string;
begin
  SQL.Add('where'); { Do not localize }
  for I := 0 to KeyFields.Count - 1 do
  begin
    FieldName := KeyFields[I];
    BindText := Format('  %s%s%s%1:s = :%1:sOLD_%2:s%1:s', { Do not localize }
      [TabAlias, QuoteChar, FieldName]);
    if I < KeyFields.Count - 1 then
      BindText := Format('%s and',[BindText]); { Do not localize }
    SQL.Add(BindText);
  end;
end;

procedure TUpdateSQLEditFormEh.GenDeleteSQL(const TableName, QuoteChar: string;
  KeyFields, SQL: TStrings);
begin
  SQL.Clear;
  SQL.Add(Format('delete from %s', [TableName])); { Do not localize }
  GenWhereClause(GetTableRef(TableName, QuoteChar), QuoteChar, KeyFields, SQL);
end;

procedure TUpdateSQLEditFormEh.GenInsertSQL(const TableName, QuoteChar: string;
  UpdateFields, SQL: TStrings);

  procedure GenFieldList(const TabName, ParamChar, QuoteChar: String);
  var
    L: string;
    I: integer;
    Comma: string;
  begin
    L := '  (';
    Comma := ', ';
    for I := 0 to UpdateFields.Count - 1 do
    begin
      if I = UpdateFields.Count - 1 then Comma := '';
      L := Format('%s%s%s%s%s%3:s%5:s',
        [L, TabName, ParamChar, QuoteChar, UpdateFields[I], Comma]);
      if (Length(L) > 70) and (I <> UpdateFields.Count - 1) then
      begin
        SQL.Add(L);
        L := '   ';
      end;
    end;
    SQL.Add(L+')');
  end;

begin
  SQL.Clear;
  SQL.Add(Format('insert into %s', [TableName])); { Do not localize }
  GenFieldList(GetTableRef(TableName, QuoteChar), '', QuoteChar);
  SQL.Add('values'); { Do not localize }
  GenFieldList('', ':', QuoteChar);
end;

procedure TUpdateSQLEditFormEh.GenModifySQL(const TableName, QuoteChar: string;
  KeyFields, UpdateFields, SQL: TStrings);
var
  I: integer;
  Comma: string;
  TableRef: string;
begin
  SQL.Clear;
  SQL.Add(Format('update %s', [TableName]));  { Do not localize }
  SQL.Add('set');                             { Do not localize }
  Comma := ',';
  TableRef := GetTableRef(TableName, QuoteChar);
  for I := 0 to UpdateFields.Count - 1 do
  begin
    if I = UpdateFields.Count -1 then Comma := '';
    SQL.Add(Format('  %s%s%s%1:s = :%1:s%2:s%1:s%3:s',
      [TableRef, QuoteChar, UpdateFields[I], Comma]));
  end;
  GenWhereClause(TableRef, QuoteChar, KeyFields, SQL);
end;

procedure TUpdateSQLEditFormEh.GenerateSQL;

  function QuotedTableName(const BaseName: string): string;
  begin
    with UpdateTableName do
      if ((ItemIndex <> -1) and (Items.Objects[ItemIndex] <> nil)) or
         ({DatabaseOpen and not Database.IsSQLBased and} (Pos('.', BaseName) > 0)) then
         Result := Format('"%s"', [BaseName]) else
         Result := BaseName;
  end;

var
  KeyFields: TStringList;
  UpdateFields: TStringList;
  QuoteChar, TableName: string;
begin
  if (KeyFieldList.SelCount = 0) or (UpdateFieldList.SelCount = 0) then
    raise Exception.Create('SSQLGenSelect');
  KeyFields := TStringList.Create;
  try
    GetSelectedItems(KeyFieldList, KeyFields);
    UpdateFields := TStringList.Create;
    try
      GetSelectedItems(UpdateFieldList, UpdateFields);
      TableName := QuotedTableName(UpdateTableName.Text);

      if TDesignDataBaseEh(DataDriver.DesignDataBase).GetCustomDBService <> nil then
        GenerateSQLViaDBService
      else
      begin
        if QuoteFields.Checked then
          QuoteChar := '"' else
          QuoteChar := '';
        if cbInsert.Checked then
          GenInsertSQL(TableName, QuoteChar, UpdateFields, MemoInsert.Lines);
        if cbUpdate.Checked then
          GenModifySQL(TableName, QuoteChar, KeyFields, UpdateFields, MemoModify.Lines);
        if cbDelete.Checked then
          GenDeleteSQL(TableName, QuoteChar, KeyFields, MemoDelete.Lines);
        if cbGetRec.Checked then
          GenGetRecSQL(DataDriver.SelectSQL, KeyFields, MemoGetRec.Lines);
        if cbUpdateFields.Checked then
          FillMemoFromList(MemoUpdateFields, UpdateFieldList);
        if cbKeyFields.Checked then
          FillMemoFromList(MemoKeyFields, KeyFieldList);
        if cbTableName.Checked then
          dbeTableName.Text := UpdateTableName.Text;
      end;

      PageControl.SelectNextPage(True);
    finally
      UpdateFields.Free;
    end;
  finally
    KeyFields.Free;
  end;
end;

procedure TUpdateSQLEditFormEh.GetDataSetFieldNames;
begin
{ TODO : realize }
{  if Assigned(DataSet) then
  begin
    GetDataFieldNames(DataSet, DataSet.Name, KeyFieldList.Items);
    UpdateFieldList.Items.Assign(KeyFieldList.Items);
  end;}
end;

function TUpdateSQLEditFormEh.GetTableRef(const TabName, QuoteChar: string): string;
begin
  if QuoteChar <> '' then
    Result :=  TabName + '.' else
    REsult := '';
end;