main.pas

AbsDataBase5.16 最新版

   if tvDatabase.SelectionCount = 1 then
    begin
     aRestructureTable.Enabled := True;
     aRenameTable.Enabled := True;
     aRefreshTableData.Enabled := True;
     aRefreshTableStructure.Enabled := True;
     aBorrowStructure.Enabled := True;
     aPrintStructure.Enabled := True;
    end
   else
    begin
     aRestructureTable.Enabled := False;
     aRenameTable.Enabled := False;
     aRefreshTableData.Enabled := False;
     aRefreshTableStructure.Enabled := False;
     aBorrowStructure.Enabled := False;
     aPrintStructure.Enabled := True;
    end;
  end;
end;

procedure TfrmMain.aRefreshDatabaseParamsExecute(Sender: TObject);
var
  fs: TFileStream;
begin
 if db.Connected then
  begin
    eDatabaseFileName.Text := db.DatabaseFileName;
    try
      fs := TFileStream.Create(db.DatabaseFileName, fmOpenRead + fmShareDenyNone);
      eDatabaseFileSize.Text := Format('%.3f Mb',[fs.Size / (1024*1000)]);
      fs.Free;
    except
    end;
    ePageSize.Text := IntToStr(db.PageSize);
    ePageCountInExtent.Text := IntToStr(db.PageCountInExtent);
    eMaxConnections.Text := IntToStr(db.MaxConnections);
    cbEncrypted.Checked := (db.Password <> '');
    eCryproAlgorithm.Text := CryptoAlgorithmNames[Integer(db.CryptoAlgorithm)];
  end;
end;

procedure TfrmMain.aChangeDatabaseParamsExecute(Sender: TObject);
var
 Log: String;
 pwd: String;
begin
  if frmDatabase.ShowModal = mrOk then
    begin
     Log := '';
     aCloseDatabase.Execute;
     if frmDatabase.cbEncrypted.Checked then
       pwd := frmDatabase.ePassword1.Text
     else
       pwd := '';
     db.ChangeDatabaseSettings(Log, False, pwd,
                               TABSCryptoAlgorithm(frmDatabase.cbCryptoAgorithm.ItemIndex),
                               StrToInt(frmDatabase.cbPageSize.Text),
                               StrToInt(frmDatabase.cbPageCountInExtent.Text),
                               StrToInt(frmDatabase.eMaxConnections.Text),);
     OpenDatabaseFile(db.DatabaseFileName);
    end;
end;

procedure TfrmMain.aRepairDatabaseExecute(Sender: TObject);
var
  log: String;
begin
  aCloseDatabase.Execute;
  try
   AddToLog('Repair Database...');
   log := db.RepairDatabase;
   if (log <> '') then
    begin
     MessageDlg(log, mtError, [mbOK], 0);
     AddToLog(log);
     ShowLog;
    end
   else
    AddToLog('Ok.');
  finally
   OpenDatabaseFile(db.DatabaseFileName);
  end;
end;


procedure TfrmMain.aBorrowStructureExecute(Sender: TObject);
begin
 frmTable.eTableName.text := '';
 if frmTable.ShowModal = mrOk then
  begin
   tCurTable.Close;
   tCurTable.TableName := frmTable.eTableName.text;
   FillFieldDefsAndIndexDefs(tCurTable.AdvFieldDefs,
                             tCurTable.AdvIndexDefs);
   tCurTable.CreateTable;
   aRefreshTableList.Execute;
   SelectTable(name);
  end
 else
  SelectTable;
end;

procedure TfrmMain.dbgTableDataDblClick(Sender: TObject);
begin
if Sender is TDBGrid then
 case TDBGrid(Sender).SelectedField.DataType of
  ftMemo :
           begin
             fMemo.CurrentGrid := TDBGrid(Sender);
             fMemo.ShowModal;
           end;
  ftFmtMemo :
           begin
             fFmtMemo.CurrentGrid := TDBGrid(Sender);
             fFmtMemo.ShowModal;
           end;
  ftGraphic :
           begin
             fGraphic.CurrentGrid := TDBGrid(Sender);
             fGraphic.ShowModal;
           end;
  ftBlob : begin
             fBlob.CurrentGrid := TDBGrid(Sender);
             fBlob.ShowModal;
           end;
 end;
end;

procedure TfrmMain.aAboutExecute(Sender: TObject);
begin
  frmAbout.ShowModal;
end;

procedure TfrmMain.aPrintStructureExecute(Sender: TObject);
var
  TableNames: TStringList;
  i,j: Integer;
  curTable: TABSTable;
begin
  if (fTableStructureRpt = nil) then
    begin
      MessageDlg('Sorry, this function does not work as the default printer is offline',mtWarning,[mbOK],0);
      exit;
    end;
  TableNames := TStringList.Create;
  curTable := TABSTable.Create(nil);
  curTable.DatabaseName := tCurTable.DatabaseName;
  try
    with fTableStructureRpt do
      begin
        tblTableList.CreateTable;
        tblTableList.Open;
        tblTableStruct.CreateTable;
        tblTableStruct.Open;

        GetSelectedTableNames(TableNames);
        for i := 0 to TableNames.Count-1 do
          begin
            tblTableList.AppendRecord([TableNames.Strings[i]]);
            curTable.TableName := TableNames.Strings[i];
            curTable.Open;
            for j:=0 to curTable.AdvFieldDefs.Count-1 do
             with tblTableStruct do
              begin
               Insert;
               FieldByName('TableName').AsString := TableNames.Strings[i];
               FieldByName('FieldName').AsString := CurTable.AdvFieldDefs[j].Name;
               FieldByName('Type').AsString := AftToStr(CurTable.AdvFieldDefs[j].DataType);
               FieldByName('Size').AsInteger := CurTable.AdvFieldDefs[j].Size;
               FieldByName('Required').AsBoolean := CurTable.AdvFieldDefs[j].Required;
               FieldByName('Default').AsVariant := CurTable.AdvFieldDefs[j].DefaultValue.AsVariant;
               FieldByName('Min').AsVariant := CurTable.AdvFieldDefs[j].MinValue.AsVariant;
               FieldByName('Max').AsVariant := CurTable.AdvFieldDefs[j].MaxValue.AsVariant;
               FieldByName('BLOBCompressionAlgorithm').AsString := ABSCompressionAlgorithmNames[Integer(CurTable.AdvFieldDefs[j].BLOBCompressionAlgorithm)];
{               FieldByName('BLOBCompressionMode').AsInteger := CurTable.AdvFieldDefs[j].BLOBCompressionMode;
               FieldByName('BLOBBlockSize').AsInteger := CurTable.AdvFieldDefs[j].BLOBBlockSize;}
               Post;
              end;
            curTable.Close;
          end;

        QuickRep1.PreviewModal;
        tblTableList.Close;
        tblTableStruct.Close;
        tblTableList.DeleteTable;
        tblTableStruct.DeleteTable;
      end;
  finally
    TableNames.Free;
    curTable.Free;
  end;
end;

procedure TfrmMain.tCurTableEditError(DataSet: TDataSet; E: EDatabaseError;
  var Action: TDataAction);
begin
   Action:=daAbort;
   if (E is EABSEngineError) then
        case (EABSEngineError(E).ErrorCode) of
          ABS_ERR_RECORD_LOCKED:
           begin
             if MessageDlg('The record you are trying to edit is locked. '+
                           'Do you want to try again?',
                           mtWarning,[mbYes,mbNo],0)=mrYes then
                Action:=daRetry;
           end;
          ABS_ERR_TABLE_LOCKED:
           begin
             if MessageDlg('The table you are trying to edit is locked. '+
                           'Do you want to try again?',
                           mtWarning,[mbYes,mbNo],0)=mrYes then
                Action:=daRetry;
           end;
          ABS_ERR_UPDATE_RECORD_MODIFIED:
           begin
             MessageDlg('The record you are trying to edit has been modified by another user. '+
                        'The table will now be refreshed',
                        mtWarning,[mbOk],0);
             DataSet.Refresh;
             Action:=daRetry;
           end;
          ABS_ERR_UPDATE_RECORD_DELETED:
           begin
             MessageDlg('The record you are trying to edit has been deleted by another user '+
                        'The table will now be refreshed',
                        mtWarning,[mbOk],0);
             DataSet.Refresh;
             Action:=daRetry;
           end
        else
          MessageDlg(E.Message,mtError,[mbOK],0);
        end
   else
      MessageDlg(E.Message,mtError,[mbOK],0);
end;

procedure TfrmMain.tCurTablePostError(DataSet: TDataSet; E: EDatabaseError;
  var Action: TDataAction);
begin
   Action:=daAbort;
   if (E is EABSEngineError) then
      begin
      if (EABSEngineError(E).ErrorCode = ABS_ERR_CONSTRAINT_VIOLATED) then
         MessageDlg(EABSEngineError(E).ErrorMessage+
                    '. Please change the record to make the constraint satisfied '+
                    'and re-post the record.',mtError,[mbOK],0)
      else if (EABSEngineError(E).ErrorCode = ABS_ERR_TABLE_LOCKED) then
         begin
         if MessageDlg('The table is locked. '+
                       'Do you want to try to post this record again?',
                        mtWarning,[mbYes,mbNo],0)=mrYes then
            Action:=daRetry;
         end
      else
         MessageDlg(E.Message,mtError,[mbOK],0);
       end
   else
      MessageDlg(E.Message,mtError,[mbOK],0);
end;

procedure TfrmMain.tCurTableDeleteError(DataSet: TDataSet;
  E: EDatabaseError; var Action: TDataAction);
begin
   Action:=daAbort;
   if (E is EABSEngineError) then
        case (EABSEngineError(E).ErrorCode) of
          ABS_ERR_RECORD_LOCKED:
           begin
           if MessageDlg('The record is locked. '+
                         'Do you want to try to delete this record again?',
                          mtWarning,[mbYes,mbNo],0)=mrYes then
              Action:=daRetry;
           end;
          ABS_ERR_TABLE_LOCKED:
           begin
           if MessageDlg('The table is locked. '+
                         'Do you want to try to delete this record again?',
                          mtWarning,[mbYes,mbNo],0)=mrYes then
              Action:=daRetry;
           end;
          ABS_ERR_DELETE_RECORD_MODIFIED:
           begin
             MessageDlg('The record you are trying to delete has been modified by another user. '+
                        'The table will now be refreshed. If you want to delete this record, try again.',
                        mtWarning,[mbOk],0);
             DataSet.Refresh;
           end;
          ABS_ERR_DELETE_RECORD_DELETED:
           begin
             MessageDlg('The record you are trying to delete has been deleted by another user '+
                        'The table will now be refreshed',
                        mtWarning,[mbOk],0);
             DataSet.Refresh;
           end
      else
         MessageDlg(E.Message,mtError,[mbOK],0);
       end
   else
      MessageDlg(E.Message,mtError,[mbOK],0);
end;

procedure TfrmMain.tCurTableAfterScroll(DataSet: TDataSet);
begin
  lRecordCount.Caption := IntToStr(tCurTable.RecordCount);
end;

procedure TfrmMain.qQueryAfterScroll(DataSet: TDataSet);
begin
  lRecordCount.Caption := IntToStr(tCurTable.RecordCount);
end;

procedure TfrmMain.AddToLog(Message: String = '');
begin
  if Message = '' then
    reLog.Lines.Add('')
  else
    reLog.Lines.Add('['+DateTimeToStr(now)+'] ' + Message);

  //reLog.CaretPos := Point(-1,0);
  reLog.Perform(EM_SCROLLCARET, 0, 0);
end;

procedure TfrmMain.ShowLog;
begin
  StatusBar.SimpleText := '';
  pcTables.ActivePage := tsSQL;
  pcSQL.ActivePage := tsLog;
end;

procedure TfrmMain.SetAllDatabaseActionsEnabled(Flag: Boolean);
begin
  aCloseDatabase.Enabled := Flag;
  aChangeDatabaseParams.Enabled := Flag;
  aCompactDatabase.Enabled := Flag;
  aRepairDatabase.Enabled := Flag;
  aExecSQL.Enabled := Flag;
end;

procedure TfrmMain.SetAllTableActionsEnabled(Flag: Boolean);
begin
  aCreateTable.Enabled := Flag;
  aEmptyTables.Enabled := Flag;
  aDeleteTables.Enabled := Flag;
  aRestructureTable.Enabled := Flag;
  aRenameTable.Enabled := Flag;
  aRefreshTableList.Enabled := Flag;
  aRefreshTableData.Enabled := Flag;
  aRefreshTableStructure.Enabled := Flag;
  aCopyTables.Enabled := Flag;
  aBorrowStructure.Enabled := Flag;
  aPrintStructure.Enabled := Flag;
end;

procedure TfrmMain.tvDatabaseDblClick(Sender: TObject);
begin
 if tvDatabase.Selected.IsFirstNode then
   aChangeDatabaseParams.Execute
 else
   //aRestructureTable.Execute
   begin
     pcTables.ActivePage := tsSQL;
     if frmQueryMaker.Visible then
       frmQueryMaker.AddTable(tCurTable, Point(0, 0))
     else
       aGoToTableData.Execute
   end;
end;

procedure TfrmMain.tvDatabaseMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var n: TTreeNode;
begin
 n := tvDatabase.GetNodeAt(X,Y);
 {if n = nil then
   tvDatabase.PopupMenu := nil
 else }if n= tvDatabase.Items[0] then
   tvDatabase.PopupMenu := pmDataBase
 else
   tvDatabase.PopupMenu := pmTables;
end;

procedure TfrmMain.aCopyTablesExecute(Sender: TObject);
var
  s,d, newname: String;
  i: Integer;
  TableList: TStringList;
  t: TABSTable;
begin
  TableList := TStringList.Create;
  try
   GetSelectedTableNames(TableList);
   if TableList.Count <=0 then Exit;
   frmCopyTable.eDbFileName.Text := db.DatabaseFileName;
   if TableList.Count=1 then
    begin
     frmCopyTable.Caption := 'Copy table: ' + TableList[0];
     frmCopyTable.eTableName.Text := TableList[0];
     frmCopyTable.eTableName.Enabled := True;
     frmCopyTable.rbCurrentDb.Enabled := True;
     frmCopyTable.rbCurrentDbClick(Sender);
    end
   else
    begin
     s := '';
     d := '';
     for i:=0 to TableList.Count-1 do
      begin
       s := s + d + TableList[i];
       d := ', ';
      end;
     frmCopyTable.Caption := 'Copy tables: (' + s + ')';
     frmCopyTable.eTableName.Text := s;
     frmCopyTable.eTableName.Enabled := False;
     frmCopyTable.rbCurrentDb.Enabled := False;
     frmCopyTable.rbSelectedDbClick(Sender);
     frmCopyTable.rbSelectedDb.Checked := True;
    end;
  if frmCopyTable.ShowModal = mrOk then
   begin
     for i:=0 to TableList.Count-1 do
      begin
       t:=TABSTable.Create(nil);
       try
        t.DatabaseName := db.DatabaseName;
        t.TableName := TableList[i];
        if frmCopyTable.eTableName.Enabled then
          newname := frmCopyT