main.pas

可以很方便地管理access数据库

unit main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, OVCL, LMDCustomComponent, LMDIniCtrl, OCL, Grids,
  DBGrids, Buttons, ImgList, Db, ODSI, ComCtrls, ToolWin, TinyDB, OSI,
  Danhint, SyntaxEd, SynParse, VExportDlg, Menus;

type
  Tmain_Form = class(TForm)
    Hdbc1: THdbc;
    LMDIniCtrl1: TLMDIniCtrl;
    Panel1: TPanel;
    Splitter1: TSplitter;
    Panel3: TPanel;
    DataSource1: TDataSource;
    ImageList1: TImageList;
    Table1: TTinyTable;
    TinyDB: TTinyDB;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    OECatalog1: TOECatalog;
    Panel5: TPanel;
    DBGrid1: TDBGrid;
    Label4: TLabel;
    DanHint1: TDanHint;
    SyntaxMemoParser1: TSyntaxMemoParser;
    VExportDialog1: TVExportDialog;
    Panel2: TPanel;
    Bevel3: TBevel;
    Bevel1: TBevel;
    Label6: TLabel;
    Label3: TLabel;
    Bevel2: TBevel;
    Edit2: TEdit;
    Edit1: TEdit;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    DSComboBox1: TDSComboBox;
    TabSheet2: TTabSheet;
    SpeedButton1: TSpeedButton;
    Edit3: TEdit;
    Label2: TLabel;
    Panel4: TPanel;
    Panel6: TPanel;
    Label1: TLabel;
    SyntaxMemo1: TSyntaxMemo;
    Splitter2: TSplitter;
    Splitter3: TSplitter;
    Label5: TLabel;
    ListBox1: TListBox;
    Splitter4: TSplitter;
    ToolBar2: TToolBar;
    ToolButton7: TToolButton;
    ToolButton10: TToolButton;
    ToolButton21: TToolButton;
    ToolButton24: TToolButton;
    ToolButton29: TToolButton;
    ToolButton30: TToolButton;
    ToolButton31: TToolButton;
    ToolButton32: TToolButton;
    ToolButton33: TToolButton;
    ToolButton34: TToolButton;
    ToolButton35: TToolButton;
    ToolButton39: TToolButton;
    ToolBar3: TToolBar;
    ToolButton25: TToolButton;
    ToolButton36: TToolButton;
    ToolButton37: TToolButton;
    ToolButton38: TToolButton;
    ToolButton47: TToolButton;
    ToolButton48: TToolButton;
    ToolButton50: TToolButton;
    ToolBar1: TToolBar;
    ToolButton8: TToolButton;
    ToolButton17: TToolButton;
    ToolButton19: TToolButton;
    Panel7: TPanel;
    Label7: TLabel;
    ListBox2: TListBox;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    PopupMenu2: TPopupMenu;
    MenuItem1: TMenuItem;
    aq1: TOEQuery;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure DSComboBox1Change(Sender: TObject);
    procedure ToolButton3Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure ToolButton4Click(Sender: TObject);
    procedure Edit1KeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ToolButton11Click(Sender: TObject);
    procedure Hdbc1AfterConnect(Sender: TObject);
    procedure Hdbc1AfterDisconnect(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ListBox1Click(Sender: TObject);
    procedure ListBox1DblClick(Sender: TObject);
    procedure Edit3Change(Sender: TObject);
    procedure SyntaxMemo1KeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure SyntaxMemo1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure SyntaxMemo1Change(Sender: TObject);
    procedure PageControl1Change(Sender: TObject);
    procedure ToolButton17Click(Sender: TObject);
    procedure ToolButton37Click(Sender: TObject);
    procedure ToolButton29Click(Sender: TObject);
    procedure ToolButton32Click(Sender: TObject);
    procedure ToolButton33Click(Sender: TObject);
    procedure ToolButton34Click(Sender: TObject);
    procedure ToolButton39Click(Sender: TObject);
    procedure ToolButton48Click(Sender: TObject);
    procedure ToolButton38Click(Sender: TObject);
    procedure ToolButton36Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure MenuItem1Click(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure CheckBox2Click(Sender: TObject);
  private
    path: string;
    acctype: byte;
    function Creatmemodata: Boolean;
    procedure hdbcconnt;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  main_Form: Tmain_Form;

implementation

{$R *.DFM}

function Tmain_Form.Creatmemodata: Boolean;
var
  dbfilename: string;
begin
  try
    dbfilename := path + 'system.dat';
    TinyDB.CreateDatabase(dbfilename, True, clNormal, 'ZIP', False, '', '', True);
    TinyDB.DatabaseName := DBFileName;
    TinyDB.CreateTable('memodata', [
      FieldItem('name', ftString, 120),
        FieldItem('fType', ftWord),
        FieldItem('username', ftString, 15),
        FieldItem('Password', ftString, 15)
        ]);
    Result := True;
  except
    DeleteFile(DBFileName);
    Result := False;
  end;
end;

procedure Tmain_Form.FormCreate(Sender: TObject);
begin
  path := ExtractFiledir(Application.ExeName);
  if (Length(path) > 0) and (path[Length(path)] <> '\') then
    path := path + '\';
  if not FileExists(path + 'system.dat') then
    if not Creatmemodata then
    begin
      Application.MessageBox(pchar('  不能建立数据文件 !  '), '警告信息...', MB_OK);
      Application.Terminate;
    end;
  Table1.DatabaseName := path + 'system.dat';
  Table1.TableName := 'memodata';
  Table1.Open;
  acctype := 0;
  DSComboBox1.Populate;
  SyntaxMemoParser1.Script := path + 'SQLLIB.DAT';
end;

procedure Tmain_Form.DSComboBox1Change(Sender: TObject);
begin
  Hdbc1.Terminate;
  Hdbc1.Disconnect;
  Edit1.Text := '';
  Edit2.Text := '';
  if DsComboBox1.ItemIndex > -1 then
    if Table1.Locate('ftype;name', VarArrayOf([acctype, DSComboBox1.DataSource]), []) then
    begin
      Edit1.Text := Table1.fieldbyname('username').asstring;
      Edit2.Text := Table1.fieldbyname('password').asstring;
    end;
end;

procedure Tmain_Form.ToolButton3Click(Sender: TObject);
begin
  OpenDialog1.Filter := 'SQL 文件|*.sql';
  OpenDialog1.Title := '打开 SQL 文件 ...';
  OpenDialog1.FileName := '';
  if OpenDialog1.Execute then
    SyntaxMemo1.Lines.LoadFromFile(OpenDialog1.FileName);
end;

procedure Tmain_Form.SpeedButton1Click(Sender: TObject);
begin
  OpenDialog1.Filter := 'Access 文件|*.MDB';
  OpenDialog1.Title := '选择 Access 文件 ...';
  OpenDialog1.FileName := '';
  if OpenDialog1.Execute then
    Edit3.Text := OpenDialog1.FileName;
end;

procedure Tmain_Form.ToolButton4Click(Sender: TObject);
begin
  SaveDialog1.Filter := 'SQL 文件|*.sql';
  SaveDialog1.Title := '保存 SQL 文件 ...';
  SaveDialog1.DefaultExt := 'sql';
  if SaveDialog1.Execute then
    SyntaxMemo1.Lines.SaveToFile(SaveDialog1.FileName);
end;

procedure Tmain_Form.Edit1KeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  dbfname: string;
begin
  if acctype = 0 then
    dbfname := DSComboBox1.DataSource
  else
    dbfname := Edit3.Text;
  if Table1.Locate('ftype;name', VarArrayOf([acctype, dbfname]), []) then
  begin
    Table1.Edit;
    Table1.fieldbyname('username').asstring := Edit1.Text;
    Table1.fieldbyname('password').asstring := Edit2.Text;
    Table1.Refresh;
  end;
end;

procedure Tmain_Form.ToolButton11Click(Sender: TObject);
begin
  SyntaxMemo1.SelectAll;
  SyntaxMemo1.SetFocus;
end;

procedure Tmain_Form.Hdbc1AfterConnect(Sender: TObject);
begin
  OECatalog1.Refresh;
  ListBox1.Items := OECatalog1.TableNames;
  OECatalog1.Terminate;
end;

procedure Tmain_Form.Hdbc1AfterDisconnect(Sender: TObject);
begin
  ListBox1.Items.Clear;
  ListBox2.Items.Clear;
end;

procedure Tmain_Form.hdbcconnt;
var
  dbfname: string;
begin
  try
    Hdbc1.Disconnect;
    Hdbc1.Attributes.Clear;
    Hdbc1.DataSource := '';
    if acctype = 0 then
    begin
      if DsComboBox1.ItemIndex > -1 then
        Hdbc1.DataSource := DsComboBox1.DataSource;
    end
    else
    begin
      Hdbc1.Attributes.Add('DRIVER=Microsoft Access Driver (*.mdb)');
      Hdbc1.Attributes.Add('UserCommitSync=Yes');
      Hdbc1.Attributes.Add('Threads=3');
      Hdbc1.Attributes.Add('SafeTransactions=0');
      Hdbc1.Attributes.Add('PageTimeout=5');
      Hdbc1.Attributes.Add('MaxScanRows=8');
      Hdbc1.Attributes.Add('MaxBufferSize=2048');
      Hdbc1.Attributes.Add('FIL=MS Access');
      Hdbc1.Attributes.Add('DriverId=25');
      Hdbc1.Attributes.Add('DefaultDir=' + path);
      Hdbc1.Attributes.Add('DBQ=' + Edit3.text);
    end;
    Hdbc1.UserName := Edit1.Text;
    Hdbc1.Password := Edit2.Text;
    if ((acctype = 0) or ((acctype = 1) and (edit3.text <> ''))) then
      Hdbc1.Connect;
    if Hdbc1.Connected then
    begin
      if acctype = 0 then
        dbfname := DSComboBox1.DataSource
      else
        dbfname := Edit3.Text;
      if not Table1.Locate('ftype;name', VarArrayOf([acctype, dbfname]), []) then
      begin
        Table1.Append;
        Table1.Edit;
        Table1.fieldbyname('username').asstring := Edit1.Text;
        Table1.fieldbyname('password').asstring := Edit2.Text;
        Table1.fieldbyname('ftype').asinteger := acctype;
        Table1.fieldbyname('name').asstring := dbfname;
        Table1.Refresh;
      end;
    end;
  finally
  end;
end;

procedure Tmain_Form.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  hdbc1.Disconnect;
  Table1.Close;
end;

procedure Tmain_Form.ListBox1Click(Sender: TObject);
begin
  ToolButton37.Enabled := ListBox1.Itemindex >= 0;
  if ListBox1.Itemindex >= 0 then
    listbox2.items := OECatalog1.Tables[listbox1.ItemIndex].ColumnNames;
end;

procedure Tmain_Form.ListBox1DblClick(Sender: TObject);
begin
  ToolButton37Click(Sender);
end;

procedure Tmain_Form.Edit3Change(Sender: TObject);
begin
  Hdbc1.Terminate;
  Hdbc1.Disconnect;
  Edit1.Text := '';
  Edit2.Text := '';
  if Table1.Locate('ftype;name', VarArrayOf([acctype, Edit3.Text]), []) and (Edit3.Text <> '') then
  begin
    Edit1.Text := Table1.fieldbyname('username').asstring;
    Edit2.Text := Table1.fieldbyname('password').asstring;
  end;
end;

procedure Tmain_Form.SyntaxMemo1KeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  ToolButton32.Enabled := SyntaxMemo1.SelLength > 0;
  ToolButton33.Enabled := SyntaxMemo1.SelLength > 0;
end;

procedure Tmain_Form.SyntaxMemo1MouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  ToolButton32.Enabled := SyntaxMemo1.SelLength > 0;
  ToolButton33.Enabled := SyntaxMemo1.SelLength > 0;
end;

procedure Tmain_Form.SyntaxMemo1Change(Sender: TObject);
begin
  ToolButton29.Enabled := length(SyntaxMemo1.Lines.Text) > 0;
end;

procedure Tmain_Form.PageControl1Change(Sender: TObject);
var
  ls_type: byte;
  str: string;
begin
  ls_type := PageControl1.ActivePageIndex;
  if ls_type <> acctype then
  begin
    acctype := ls_type;
    if acctype = 0 then
    begin
      str := DSComboBox1.DataSource;
      DSComboBox1.Populate;
      DSComboBox1.DataSource := str;
      DSComboBox1Change(Sender);
    end
    else
      Edit3Change(Sender);
  end;
end;

procedure Tmain_Form.ToolButton17Click(Sender: TObject);
begin
  VExportDialog1.Execute;
end;

procedure Tmain_Form.ToolButton37Click(Sender: TObject);
begin
  try
    if not Hdbc1.Connected then
      hdbcconnt;
    if Hdbc1.Connected and (ListBox1.Itemindex >= 0) then
    begin
      aq1.Close;
      aq1.SQL.Clear;
      aq1.TableName := ListBox1.Items[ListBox1.Itemindex];
      aq1.Open;
    end;
  finally
  end;
end;

procedure Tmain_Form.ToolButton29Click(Sender: TObject);
var
  str: string;
begin
  try
    if not Hdbc1.Connected then
      hdbcconnt;
    if Hdbc1.Connected and (length(SyntaxMemo1.Lines.Text) > 0) then
    begin
      aq1.Close;
      aq1.TableName := '';
      if SyntaxMemo1.SelLength = 0 then
        str := SyntaxMemo1.Lines.Text
      else
        str := SyntaxMemo1.SelText;
      str := trim(str);
      aq1.SQL.Text := str;
      if ((uppercase(copy(str, 1, 6)) = 'SELECT') and (pos('INTO', uppercase(str)) <= 0)) then
        aq1.Open
      else
        aq1.ExecSQL;
    end;
  finally
  end;
end;

procedure Tmain_Form.ToolButton32Click(Sender: TObject);
begin
  SyntaxMemo1.CopyToClipboard;
end;

procedure Tmain_Form.ToolButton33Click(Sender: TObject);
begin
  SyntaxMemo1.CutToClipboard;
end;

procedure Tmain_Form.ToolButton34Click(Sender: TObject);
begin
  SyntaxMemo1.PasteFromClipboard;
end;

procedure Tmain_Form.ToolButton39Click(Sender: TObject);
begin
  main_Form.Close;
end;

procedure Tmain_Form.ToolButton48Click(Sender: TObject);
begin
  SaveDialog1.Filter := 'Table 列表文件|*.tls';
  SaveDialog1.Title := '保存 TLS 文件 ...';
  SaveDialog1.DefaultExt := 'tls';
  if SaveDialog1.Execute then
    ListBox1.Items.SaveToFile(SaveDialog1.FileName);
end;

procedure Tmain_Form.ToolButton38Click(Sender: TObject);
var
  dbfname: string;
begin
  if acctype = 0 then
    dbfname := DSComboBox1.DataSource
  else
    dbfname := Edit3.Text;
  if Table1.Locate('ftype;name', VarArrayOf([acctype, dbfname]), []) then
  begin
    Table1.Delete;
    Table1.Refresh;
  end;
end;

procedure Tmain_Form.ToolButton36Click(Sender: TObject);
begin
  hdbcconnt;
end;

procedure Tmain_Form.N1Click(Sender: TObject);
begin
  if ListBox1.Itemindex >= 0 then
  begin
    SyntaxMemo1.SelLength := 0;
    SyntaxMemo1.SelText := ListBox1.Items[ListBox1.Itemindex];
  end;
end;

procedure Tmain_Form.N2Click(Sender: TObject);
begin
  ToolButton37Click(sender);
end;

procedure Tmain_Form.MenuItem1Click(Sender: TObject);
begin
  if ListBox2.Itemindex >= 0 then
  begin
    SyntaxMemo1.SelLength := 0;
    SyntaxMemo1.SelText := ListBox2.Items[ListBox2.Itemindex];
  end;
end;

procedure Tmain_Form.CheckBox1Click(Sender: TObject);
begin
  if CheckBox1.Checked then
    OECatalog1.TableType := [ttview] + OECatalog1.TableType
  else
    OECatalog1.TableType := OECatalog1.TableType - [ttview];
end;

procedure Tmain_Form.CheckBox2Click(Sender: TObject);
begin
  if CheckBox2.Checked then
    OECatalog1.TableType := [ttsystem] + OECatalog1.TableType
  else
    OECatalog1.TableType := OECatalog1.TableType - [ttsystem];
end;

end.