main.pas

AbsDataBase5.16 最新版

    AddToLog;
    AddToLog('Executing Query: '#13#10 + q);
    StatusBar.SimpleText := ' Executing query, please wait...';
    Application.ProcessMessages;
    qQuery.SQL.Text := q;
    qQuery.ReadOnly := False;
    qQuery.RequestLive := cbRequestLive.Checked;
    dtStart := Time;
    try
     qQuery.Open;
     dtEnd := Time;
     lSQLRecordCount.Caption := IntToStr(qQuery.RecordCount);
     if qQuery.ReadOnly then
      lReadOnly.Caption := 'ReadOnly'
     else
      lReadOnly.Caption := 'LiveResult';
     AddToLog('Ok.');
     q := ' Execution time: '+FormatDateTime('hh:nn:ss.zzz', (dtEnd-dtStart));
		 AddToLog(q);
     SqlHistory.AddQuery(qQuery.SQL.Text);

     if ( qQuery.RowsAffected <> -1 ) then
      begin
       AddToLog(Format('%d rows affected.', [qQuery.RowsAffected]));
       q := Format(' %d rows affected,', [qQuery.RowsAffected])+q;
      end;
     StatusBar.SimpleText := q;
     Application.ProcessMessages;
     
     pcSQL.ActivePage := tsData;
     aExportToExcel.Enabled := True;
    except
     on e: EABSException do
      begin
       if (e.NativeError = 20001) then
        begin
         AddToLog('Ok.');
         if ( qQuery.RowsAffected <> -1 ) then
          begin
           AddToLog(Format(' %d rows affected.', [qQuery.RowsAffected]));
           ShowLog;
          end;
         SqlHistory.AddQuery(qQuery.SQL.Text);
        end
       else
        begin
         qQuery.Close;
         reSQL.CaretPos := Point(ExtractNumber(e.Message,'column')-1,
                                 ExtractNumber(e.Message,'line')-1);
         AddToLog(e.Message);
         ShowLog;
         reSQL.SetFocus;
        end;
      end;
     on e: Exception do
      begin
       qQuery.Close;
       AddToLog(e.Message);
       ShowLog;
      end;
    end;//try-except
  finally
    Screen.Cursor := crDefault;
    aRefreshTableList.Execute;
    if (tCurTable.Exists) then
      tCurTable.Open
    else
      SelectTable;
  end;
end;


procedure TfrmMain.reSQLKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if (ssCtrl in Shift) and (Key = 13) then
   begin
    aExecSQL.Execute;
    FSQLExec := True;
   end
  else if (ssCtrl in Shift) and (Key = ord('T')) then
   pmQueryClick(mCurrentTable)
  else if (ssCtrl in Shift) and (Key = ord('F')) then
   pmQueryClick(mFieldList)
end;

procedure TfrmMain.reSQLKeyPress(Sender: TObject; var Key: Char);
begin
  if FSQLExec and (Key in [#10,#13]) then
   begin
    FSQLExec := False;
    Key := #0;
   end;
end;


procedure TfrmMain.aCompactDatabaseExecute(Sender: TObject);
begin
  if not db.Connected then Exit;
  aCloseDatabase.Execute;
  try
    AddToLog('Compact Database...');
    try
     db.CompactDatabase;
     AddToLog('Ok');
    except
      on e: Exception do
       begin
        AddToLog(e.Message);
        ShowLog;
        raise;
       end;
    end
  finally
   OpenDatabaseFile(db.DatabaseFileName);
  end;
end;

procedure TfrmMain.aRenameTableExecute(Sender: TObject);
var
  OldName, NewName: String;
begin
  OldName := GetCurrentTableName;
  if OldName = '' then Exit;
  frmTableName.Caption := 'Rename table ' + OldName;
  frmTableName.eTableName.Text := OldName;
  if frmTableName.ShowModal = mrOk then
   begin
    NewName := frmTableName.eTableName.Text;
    if (NewName = OldName) then Exit;
    qQuery.Close;
    tCurTable.Close;
    try
      tCurTable.RenameTable(NewName);
    finally
      tCurTable.Open;
      aRefreshTableList.Execute;
    end;
    SelectTable(NewName);
   end;
end;


procedure TfrmMain.RefreshLastOpenedFiles;
var i: Integer;
    a: TAction;
begin
  // Unsafe code, but... :(
  with ActionManager.ActionBars[13].Items[0].Items[2] do
   begin
     for i:=0 to items.Count-1 do
      begin
       Action.Free;
      end;
     items.Clear;     
     if Settings.FileNamesCount = 0 then
       Visible := False
     else
      begin
       Visible := True;
       for i:=0 to Settings.FileNamesCount-1 do
        with items.Add do
         begin
          a:= TAction.Create(self);
          a.Caption := Settings.FileNames[i];
          a.OnExecute := aReopenFileExecute;
          Action := a;
         end;
      end;
   end;
end;


procedure TfrmMain.aReopenFileExecute(Sender: TObject);
begin
 if Sender is TAction then
  begin
   OpenDatabaseFile(TAction(Sender).Caption);
  end;
end;

procedure TfrmMain.OpenDatabaseFile(FileName: String);
begin
  if FileName='' then Exit;
  aCloseDatabase.Execute;
  db.DatabaseFileName := FileName;
  db.Open;

  SetAllDatabaseActionsEnabled(True);
  SetAllTableActionsEnabled(True);

  Settings.AddFileName(FileName);
  aRefreshTableList.Execute;
  RefreshLastOpenedFiles;
  frmMain.Caption := ShortFormCaption + ' {' + FileName + '}';
  aRefreshDatabaseParams.Execute;
  pMainPanel.Visible := True;
end;

procedure TfrmMain.tFieldsAfterPost(DataSet: TDataSet);
begin
  tIndexColumns.Refresh;
end;

procedure TfrmMain.tFieldsBeforeDelete(DataSet: TDataSet);
begin
  while tIndexColumns.Locate('columnid', DataSet.FieldByName('id').AsInteger,[]) do
   tIndexColumns.Delete;
end;


procedure TfrmMain.tIndexColumnsBeforeInsert(DataSet: TDataSet);
begin
  if (tIndexes.State in [dsEdit,dsInsert]) then tIndexes.Post;
end;

procedure TfrmMain.tIndexesBeforeInsert(DataSet: TDataSet);
begin
  if (tFields.State in [dsEdit,dsInsert]) then tFields.Post;
end;

procedure TfrmMain.FillFieldDefsAndIndexDefs(FieldDefs: TABSAdvFieldDefs;
                                             IndexDefs: TABSAdvIndexDefs);
var
  i: Integer;
  s: String;
  FieldList, DescFieldList, CaseInsFieldList, MaxIndexedSizeList: String;
begin

   // Fields
   FieldDefs.Clear;
   tFields.First;
   for i:=0 to tFields.RecordCount-1 do
    begin
     with FieldDefs.AddFieldDef do
      begin
       Name := tFields.FieldByName('Name').AsString;
       ObjectID := tFields.FieldByName('ObjectID').AsInteger;
       DataType := StrToAft(tFields.FieldByName('Type').AsString);
       Size := tFields.FieldByName('Size').AsInteger;
       Required := tFields.FieldByName('Required').AsBoolean;
       DefaultValue.AsString := tFields.FieldByName('Default').AsString;
       MinValue.AsString := tFields.FieldByName('MinValue').AsString;
       MaxValue.AsString := tFields.FieldByName('MaxValue').AsString;
       BLOBCompressionAlgorithm := TCompressionAlgorithm(
                                     GetCompressionAlgorithm(
                                       tFields.FieldByName(
                                         'BLOBCompressionAlgorithm').AsString));
       BLOBCompressionMode := tFields.FieldByName('BLOBCompressionMode').AsInteger;
       BLOBBlockSize := tFields.FieldByName('BLOBBlockSize').AsInteger;
      end;
     tFields.Next;
    end;

   // Indexes
   IndexDefs.Clear;
   tIndexes.First;
   for i:=0 to tIndexes.RecordCount-1 do
    begin
     with IndexDefs.AddIndexDef do
      begin
       Name := tIndexes.FieldByName('Name').AsString;
       
       if UpperCase(Trim(tIndexes.FieldByName('Type').AsString)) = 'PRIMARY' then
         Options := [ixPrimary]
       else
       if UpperCase(Trim(tIndexes.FieldByName('Type').AsString)) = 'UNIQUE' then
         Options := [ixUnique];

       FieldList := '';
       DescFieldList := '';
       CaseInsFieldList := '';
       MaxIndexedSizeList := '';
       tIndexColumns.Filter := 'indexid='+tIndexes.FieldByName('id').AsString;
       tIndexColumns.Filtered := True;
       try
        tIndexColumns.First;
        while not tIndexColumns.Eof do
         begin
          s := tIndexColumns.FieldByName('columnname').AsString;
          FieldList := FieldList + s + ';';
          if not tIndexColumns.FieldByName('Asc').AsBoolean then
            DescFieldList := DescFieldList + s + ';';
          if tIndexColumns.FieldByName('CaseInsensitive').AsBoolean then
            CaseInsFieldList := CaseInsFieldList + s + ';';
          MaxIndexedSizeList := MaxIndexedSizeList + tIndexColumns.FieldByName('MaxIndexedSize').AsString + ';';
          tIndexColumns.Next;
         end;
       finally
        tIndexColumns.Filtered := False;
       end;
       if FieldList <> '' then SetLength(FieldList, Length(FieldList)-1);
       if DescFieldList <> '' then SetLength(DescFieldList, Length(DescFieldList)-1);
       if CaseInsFieldList <> '' then SetLength(CaseInsFieldList, Length(CaseInsFieldList)-1);
       if MaxIndexedSizeList <> '' then SetLength(MaxIndexedSizeList, Length(MaxIndexedSizeList)-1);
       Fields := FieldList;
       CaseInsFields := CaseInsFieldList;
       DescFields := DescFieldList;
       MaxIndexedSizes := MaxIndexedSizeList;
      end;
     tIndexes.Next;
    end;
end;


procedure MoveRow(Dataset: TDataSet; MoveUp: Boolean);
var
  bmSelected, bmOther: TBookmark;
  iSelected, iOther: Integer;
begin
  bmSelected:= Dataset.GetBookmark;
  try
    iSelected:= Dataset.FieldByName('SortOrder').AsInteger;
    if MoveUp then Dataset.Prior
    else Dataset.Next;
    if Dataset.Eof then Exit;
    bmOther:= Dataset.GetBookmark;
    iOther:= Dataset.FieldByName('SortOrder').AsInteger;
    Dataset.GotoBookmark(bmSelected);
    Dataset.Edit;
    Dataset.FieldByName('SortOrder').AsInteger:= -1;
    Dataset.Post;
    Dataset.GotoBookmark(bmOther);
    Dataset.Edit;
    Dataset.FieldByName('SortOrder').AsInteger:= iSelected;
    Dataset.Post;
    Dataset.GotoBookmark(bmSelected);
    Dataset.Edit;
    Dataset.FieldByName('SortOrder').AsInteger:= iOther;
    Dataset.Post;
  finally
    Dataset.GotoBookmark(bmSelected);
  end;
end;

function TfrmMain.GetCurrentTableName: String;
var
  n: TTreeNode;
begin
 Result := '';
 n := tvDatabase.Selected;
 if n = nil then Exit;
 if n.IsFirstNode then Exit;
 Result := n.Text;
end;


procedure TfrmMain.GetSelectedTableNames(List: TStrings);
var
  i: Integer;
begin
  List.Clear;
  for i:=0 to tvDatabase.SelectionCount-1 do
   if not tvDatabase.Selections[i].IsFirstNode then List.Add(tvDatabase.Selections[i].Text);
end;


procedure TfrmMain.tvDatabaseKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 case Key of
   13:    aRestructureTable.Execute;
   VK_F2: aRenameTable.Execute;
 end;
end;

procedure TfrmMain.tvDatabaseCollapsing(Sender: TObject; Node: TTreeNode;
  var AllowCollapse: Boolean);
begin
 AllowCollapse := False;
end;


procedure TfrmMain.tvDatabaseChange(Sender: TObject; Node: TTreeNode);
begin
 if ((FOldActilePage <> nil) and
     (pcTables.ActivePage = tsDatabase) and
     (tvDatabase.Selected.IsFirstNode)) then Exit;

 if tvDatabase.Selected.IsFirstNode then
  begin
   FOldActilePage := pcTables.ActivePage;
   
   tsDatabase.TabVisible := True;
   tsStructure.TabVisible := False;
   tsExportToSql.TabVisible := False;
   tsTableData.TabVisible := False;
   pcTables.ActivePage := tsDatabase;

   aExportAsSqlToScreen.Enabled := False;
   aExportAsSqlToFile.Enabled := False;
   aEmptyTables.Enabled := False;
   aDeleteTables.Enabled := False;
   aRestructureTable.Enabled := False;
   aRenameTable.Enabled := False;
   aRefreshTableData.Enabled := False;
   aRefreshTableStructure.Enabled := False;
   aCopyTables.Enabled := False;
   aBorrowStructure.Enabled := False;
   aPrintStructure.Enabled := False;
   aExportToExcel.Enabled := False;
  end
 else
  begin
    if ((FOldActilePage = nil) or (tsDatabase.TabVisible)) then
      begin
       tsTableData.TabVisible := True;
       pcTables.ActivePage := tsTableData;

       tsDatabase.TabVisible := False;
       tsStructure.TabVisible := True;
       tsExportToSql.TabVisible := True;

       if ((FOldActilePage <> nil) and
           (pcTables.Pages[FOldActilePage.PageIndex].TabVisible)) then
         pcTables.ActivePage := FOldActilePage
       else
         pcTables.ActivePage := tsTableData;

       FOldActilePage := pcTables.ActivePage;
      end;

   SelectTable(tvDatabase.Selected.Text);

   aEmptyTables.Enabled := True;
   aDeleteTables.Enabled := True;
   aCopyTables.Enabled := True;
   aExportAsSqlToScreen.Enabled := True;
   aExportAsSqlToFile.Enabled := True;
   aExportToExcel.Enabled := True;