⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 main.pas

📁 AbsDataBase5.16 最新版
💻 PAS
📖 第 1 页 / 共 5 页
字号:
       end;
    finally
      if OldName <> '' then
        begin
          if (sl.IndexOf(OldName) <> -1) then
            SelectTable(OldName)
          else
            if (sl.Count > 0) then
              SelectTable(sl[0])
        end
      else
        SelectTable(Settings.LastTableName);
     sl.Free;
    end;
   end;
end;


procedure TfrmMain.SelectTable(Name: String='');
var
 i: Integer;
begin
  if (name <> '') then
   for i:=1 to tvDatabase.Items.Count-1 do
    if AnsiUpperCase(tvDatabase.Items[i].Text) = AnsiUpperCase(Name) then
     begin
      tvDatabase.Selected := tvDatabase.Items[i];
      Break;
     end;
  aRefreshTableData.Execute;
  aRefreshTableStructure.Execute;
end;


procedure TfrmMain.aRefreshTableDataExecute(Sender: TObject);
var
 bookmark: TBookmark;
begin
 lRecordCount.Caption := '0';
 if ((db.Connected) and (GetCurrentTableName <> '')) then
  begin
   if ((tCurTable.Active) and
       (tCurTable.TableName = GetCurrentTableName)) then
    begin
     bookmark := tCurTable.GetBookmark;
     tCurTable.Refresh;
     tCurTable.GotoBookmark(bookmark);
     tCurTable.FreeBookmark(bookmark);
    end
   else
    begin
     tCurTable.Close;
     tCurTable.TableName := GetCurrentTableName;
     tCurTable.Open;
    end;
   lRecordCount.Caption := IntToStr(tCurTable.RecordCount);
  end
 else
  begin
   tCurTable.Close;
  end;
end;


procedure TfrmMain.aCreateDatabaseExecute(Sender: TObject);
begin
  aCloseDatabase.Execute;
  if sdSaveDatabase.Execute then
   if frmDatabase.ShowModal = mrOk then
    begin
     db.DatabaseFileName := sdSaveDatabase.FileName;
     db.PageSize := StrToInt(frmDatabase.cbPageSize.Text);
     db.PageCountInExtent := StrToInt(frmDatabase.cbPageCountInExtent.Text);
     db.MaxConnections := StrToInt(frmDatabase.eMaxConnections.Text);
     if frmDatabase.cbEncrypted.Checked then
      begin
       db.Password := frmDatabase.ePassword1.Text;
       db.CryptoAlgorithm := TABSCryptoAlgorithm(frmDatabase.cbCryptoAgorithm.ItemIndex);
      end
     else
      begin
       frmMain.db.Password := '';
      end;
     db.CreateDatabase;
     OpenDatabaseFile(db.DatabaseFileName);
     tvDatabase.Select(tvDatabase.Items[0],[]);
    end;
end;


procedure TfrmMain.aCreateTableExecute(Sender: TObject);
begin

 tIndexColumns.Close;
 tIndexColumns.EmptyTable;
 tIndexColumns.Open;

 tIndexes.Close;
 tIndexes.EmptyTable;
 tIndexes.Open;

 tFields.Close;
 tFields.EmptyTable;
 tFields.Open;

 frmTable.eTableName.text := '';

 if frmTable.ShowModal = mrOk then
  begin
   tCurTable.Close;
   tCurTable.TableName := frmTable.eTableName.text;
   tCurTable.FieldDefs.Clear;
   tCurTable.IndexDefs.Clear;
   FillFieldDefsAndIndexDefs(tCurTable.AdvFieldDefs,
                             tCurTable.AdvIndexDefs);
   tCurTable.CreateTable;
   aRefreshTableList.Execute;
   SelectTable(frmTable.eTableName.text);
  end
 else
  SelectTable;
end;


procedure TfrmMain.lbTableListClick(Sender: TObject);
begin
 if (tvDatabase.Items.Count > 1) and
    (tCurTable.TableName <> GetCurrentTableName) then
 SelectTable;
end;


procedure TfrmMain.tCurTableAfterPost(DataSet: TDataSet);
begin
 aRefreshTableData.Execute;
end;


procedure TfrmMain.FormCreate(Sender: TObject);
var OldSH: Boolean;
   tReg : TRegistry;
   sHelpFile : string;
   InstallDir: String;
begin
  // Help file
  tReg := TRegistry.Create;
  try
    tReg.RootKey := HKEY_CURRENT_USER;
    tReg.OpenKey('SOFTWARE\ComponentAce\Absolute Database', true);
    InstallDir := tReg.ReadString('InstallDir');
    sHelpFile := InstallDir+'\Help\AbsDbManual.hlp';
    if not(FileExists(sHelpFile)) then
      sHelpFile := ExtractFilePath(ParamStr(0))+'..\..\Help\AbsDbManual.hlp';
    if FileExists(sHelpFile) then
      Application.HelpFile := sHelpFile;
  finally
    tReg.Free;
  end;

  Application.HintPause := 0;
  Application.HintHidePause := 50000;
  Application.HintShortPause := 0;


  FOldActilePage := nil;
  Settings := TAppSettings.Create(HistoryOpenedFilesSize);
  SqlHistory := TSqlHistory.Create(lbSqlHistory);
  RefreshLastOpenedFiles;
  OldSH := aSyntaxHighlighting.Checked;
  aSyntaxHighlighting.Checked := False;
  reSQL.PlainText := True;
  reSQL.Text := Settings.LastSQL;
  if OldSH then aSyntaxHighlighting.Execute;
  //reSQL.OnChange(Sender);

  // Create Fields Table
  tFields.CreateTable;
  tFields.Open;
  tFields.Database.SilentMode := True;
  tFields.Close;
  tFields.RestructureFieldDefs.Find('Type').DefaultValue.AsString := 'String';
  tFields.RestructureFieldDefs.Find('Size').DefaultValue.AsInteger := 20;
  tFields.RestructureFieldDefs.Find('Required').DefaultValue.AsBoolean := False;
  tFields.RestructureFieldDefs.Find('BLOBCompressionAlgorithm').DefaultValue.AsString := 'None';
  tFields.RestructureFieldDefs.Find('BLOBCompressionMode').DefaultValue.AsInteger := 0;
  tFields.RestructureFieldDefs.Find('BLOBCompressionMode').MinValue.AsInteger := 0;
  tFields.RestructureFieldDefs.Find('BLOBCompressionMode').MaxValue.AsInteger := 9;
  tFields.RestructureFieldDefs.Find('BLOBBlockSize').DefaultValue.AsInteger := DefaultBLOBBlockSize;
  tFields.RestructureTable;
  tFields.Open;

  // Create Indexes Table
  tIndexes.CreateTable;
  tIndexes.Open;
  tIndexes.Database.SilentMode := True;
  tIndexes.Close;
  tIndexes.RestructureFieldDefs.Find('Name').DefaultValue.AsString := 'IndexName';
  tIndexes.RestructureTable;
  tIndexes.Open;

  // Create IndexesColumns Table
  tIndexColumns.CreateTable;
  tIndexColumns.Open;
  tIndexColumns.Database.SilentMode := True;
  tIndexColumns.Close;
  tIndexColumns.RestructureFieldDefs.Find('CaseInsensitive').DefaultValue.AsBoolean := False;
  tIndexColumns.RestructureFieldDefs.Find('Asc').DefaultValue.AsBoolean := True;
  tIndexColumns.RestructureFieldDefs.Find('MaxIndexedSize').DefaultValue.AsInteger := DEFAULT_MAX_INDEXED_SIZE;
  tIndexColumns.RestructureTable;
  tIndexColumns.Open;

  aCloseDatabaseExecute(nil);
  if ParamCount > 0 then
   begin
    OpenDatabaseFile(ParamStr(1));
   end
  else
   begin
    if FileExists(Settings.LastOpenedFileName) then
      OpenDatabaseFile(Settings.LastOpenedFileName);
   end;
   SqlHistory.SetDatabaseFileName(db.DatabaseFileName);
   //SelectTable(Settings.LastTableName);

   if (pcTables.Pages[Settings.LastPageIndex].TabVisible) then
     pcTables.ActivePageIndex := Settings.LastPageIndex;
   Left := Settings.LastLeft;
   Top := Settings.LastTop;
   Width := Settings.LastWidth;
   Height := Settings.LastHeight;
   Position := TPosition(Settings.LastPosition);
   WindowState := TWindowState(Settings.LastWindowState);
   pnlTree.Width := Settings.LastTreeWidth;
   pnlQuery.Height := Settings.LastQueryHeight;
   if Settings.LastPageIndex = 0 then
    begin
     FOldActilePage := nil;
     if (tvDatabase.Items.Count > 0) then
       tvDatabase.Select(tvDatabase.Items[0],[]);
     FOldActilePage := pcTables.ActivePage;
    end;
end;


procedure TfrmMain.aRefreshTableStructureExecute(Sender: TObject);
var
  i,j: Integer;
  s: String;
  FieldList, DescFieldList, CaseInsFieldList, MaxIndexedSizeList: TStringList;
begin
  tFields.Close;
  tFields.EmptyTable;
  tFields.Open;
  if tCurTable.Active then
   begin

    for i:=0 to tCurTable.AdvFieldDefs.Count-1 do
     with tFields do
      begin
       tFields.Insert;
       tFields.FieldByName('Name').AsString := tCurTable.AdvFieldDefs[i].Name;
       tFields.FieldByName('ObjectID').AsInteger := tCurTable.AdvFieldDefs[i].ObjectID;
       tFields.FieldByName('Type').AsString := AftToStr(tCurTable.AdvFieldDefs[i].DataType);
       tFields.FieldByName('Size').AsInteger := tCurTable.AdvFieldDefs[i].Size;
       tFields.FieldByName('Required').AsBoolean := tCurTable.AdvFieldDefs[i].Required;
       tFields.FieldByName('Default').AsVariant := tCurTable.AdvFieldDefs[i].DefaultValue.AsVariant;
       tFields.FieldByName('MinValue').AsVariant := tCurTable.AdvFieldDefs[i].MinValue.AsVariant;
       tFields.FieldByName('MaxValue').AsVariant := tCurTable.AdvFieldDefs[i].MaxValue.AsVariant;
       tFields.FieldByName('BLOBCompressionAlgorithm').AsString := ABSCompressionAlgorithmNames[Integer(tCurTable.AdvFieldDefs[i].BLOBCompressionAlgorithm)];
       tFields.FieldByName('BLOBCompressionMode').AsInteger := tCurTable.AdvFieldDefs[i].BLOBCompressionMode;
       tFields.FieldByName('BLOBBlockSize').AsInteger := tCurTable.AdvFieldDefs[i].BLOBBlockSize;
       tFields.Post;
      end;

    // Indexes
    tIndexes.Close;
    tIndexes.EmptyTable;
    tIndexes.Open;

    // IndexColumns
    tIndexColumns.Close;
    tIndexColumns.EmptyTable;
    tIndexColumns.Open;

    for i:=0 to tCurTable.IndexDefs.Count-1 do
     begin
      tIndexes.Insert;
      tIndexes.FieldByName('Name').AsString := tCurTable.IndexDefs[i].Name;

      if ixPrimary in tCurTable.IndexDefs[i].Options then
       s := 'Primary'
      else if ixUnique in tCurTable.IndexDefs[i].Options then
       s := 'Unique'
      else
       s := '';
      tIndexes.FieldByName('Type').AsString := s;
      s := tCurTable.AdvIndexDefs[i].Fields;
      s := '(' + AnsiReplaceStr(s,';',', ') + ')';
      tIndexes.FieldByName('Columns').AsString := s;
      tIndexes.Post;

      FieldList := TStringList.Create;
      DescFieldList := TStringList.Create;
      CaseInsFieldList := TStringList.Create;
      MaxIndexedSizeList := TStringList.Create;
      try
        GetNamesList(FieldList, tCurTable.AdvIndexDefs[i].Fields);
        GetNamesList(DescFieldList, tCurTable.AdvIndexDefs[i].DescFields);
        GetNamesList(CaseInsFieldList, tCurTable.AdvIndexDefs[i].CaseInsFields);
        GetNamesList(MaxIndexedSizeList, tCurTable.AdvIndexDefs[i].MaxIndexedSizes);
        for j:=0 to FieldList.Count-1 do
         begin
          tIndexColumns.Insert;
          tIndexColumns.FieldByName('indexid').AsInteger := tIndexes.LastAutoincValue('id');
          if tFields.Locate('name',FieldList[j],[loCaseInsensitive]) then
            tIndexColumns.FieldByName('ColumnID').AsInteger := tFields.FieldByName('id').AsInteger;
          tIndexColumns.FieldByName('Asc').AsBoolean := DescFieldList.IndexOf(FieldList[j]) = -1;
          tIndexColumns.FieldByName('CaseInSensitive').AsBoolean := CaseInsFieldList.IndexOf(FieldList[j]) <> -1;
          if (MaxIndexedSizeList[j] <> '') then
            tIndexColumns.FieldByName('MaxIndexedSize').AsInteger := StrToInt(MaxIndexedSizeList[j]);
          tIndexColumns.Post;
         end;
      finally
       FieldList.Free;
       DescFieldList.Free;
       CaseInsFieldList.Free;
       MaxIndexedSizeList.Free;
      end;
     end;
   end;//if tCurtable.Active
end;


procedure TfrmMain.aRestructureTableExecute(Sender: TObject);
var
  name: String;
  log: string;
begin
 frmTable.eTableName.text := tCurTable.TableName;
 name := frmTable.eTableName.text;
 while frmTable.ShowModal = mrOk do
  begin
   qQuery.Close;
   tCurTable.Close;
   name := frmTable.eTableName.text;
   if (tCurTable.TableName <> name) then
     tCurTable.RenameTable(name);
   FillFieldDefsAndIndexDefs(tCurTable.RestructureFieldDefs,
                             tCurTable.RestructureIndexDefs);
   tCurTable.DisableControls;
   try
     if (not tCurTable.RestructureTable(log)) then
       MessageDlg('Restructure failed. '+Log, mtError, [mbOK], 0)
     else
       break;
   finally
     tCurTable.EnableControls;
   end;
  end;
  aRefreshTableList.Execute;
  SelectTable(name);
end;


procedure TfrmMain.aDeleteTablesExecute(Sender: TObject);
var
  s: String;
  i: Integer;
  d: String;
  t: TABSTable;
  TableList: TStringList;
begin
  TableList := TStringList.Create;
  try
   GetSelectedTableNames(TableList);
   if TableList.Count <=0 then Exit;
    s := 'Delete (Drop) all selected tables: (';
    d := '';
    for i:=0 to TableList.Count-1 do
     begin
      s := s + d + TableList[i];
      d := ', ';
     end;
    s := s + '). Are you sure?';
    if (MessageDlg(s, mtConfirmation, [mbYes,mbNo],0) = mrYes) then
     begin
      qQuery.Close;
      tCurTable.Close;
      //qQuery.Close;
      t := TABSTable.Create(self);
      try
       t.DatabaseName := db.DatabaseName;
       for i:=0 to TableList.Count-1 do
         begin
          t.TableName := TableList[i];
          t.DeleteTable;
         end;
      finally
       t.Free;
      end;
     end;
  finally
   aRefreshTableList.Execute;
   TableList.Free;
   
  end;
end;


procedure TfrmMain.aExecSQLExecute(Sender: TObject);
var
  q: String;
  dtStart, dtEnd: TTime;
begin
  if ( pcTables.ActivePage <> tsSQL ) then Exit;

  frmQueryMaker.Hide;
  ToolButton3.Hint := 'Show Query Maker';
  Application.ProcessMessages;
  tCurTable.Close;
  Screen.Cursor := crHourGlass;
  try
    qQuery.Close;
    aExportToExcel.Enabled := False;
    lSQLRecordCount.Caption := '0';
    lReadOnly.Caption := '';
		if (reSQL.SelLength>0) then
      q := trim(reSQL.SelText)
		else
      q := trim(reSQL.Text);

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -