ufrmreadaccess.pas

数据库通用工具

unit UfrmReadAccess;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, UfrmModel, ActnList, Menus, DB, ADODB, StdCtrls, CheckLst,
  Grids, DBGrids, Buttons, ExtCtrls;

type
  TfrmReadAccess = class(TfrmModel)
    PopupMenu3: TPopupMenu;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    OpenDialog2: TOpenDialog;
    adoConnection: TADOConnection;
    ADOQuery1: TADOQuery;
    ADOQuery2: TADOQuery;
    ADOQuery3: TADOQuery;
    DataSource1: TDataSource;
    PopupMenu2: TPopupMenu;
    N3: TMenuItem;
    N4: TMenuItem;
    Panel3: TPanel;
    Panel5: TPanel;
    labPathA: TLabel;
    bbtOpenA: TBitBtn;
    Panel6: TPanel;
    DBGrid1: TDBGrid;
    Panel8: TPanel;
    Panel7: TPanel;
    labBS: TLabel;
    labJL: TLabel;
    cbxTable: TComboBox;
    grpZD: TGroupBox;
    CheckListBox1: TCheckListBox;
    Panel10: TPanel;
    btnRefresh: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    Panel1: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    editUser: TEdit;
    editPass: TEdit;
    mo: TMemo;
    BitBtn1: TBitBtn;
    procedure bbtOpenAClick(Sender: TObject);
    function LinkADO( sPathName: string ) : boolean;
    procedure cbxTableChange(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure listField( tbName : string );
    procedure btnRefreshClick(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure DBGrid1DblClick(Sender: TObject);
    procedure DBGrid1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    
  private
    { Private declarations }
    mdbUser,mdbPass : String;
  public
    { Public declarations }
  end;

var
  frmReadAccess: TfrmReadAccess;
    
implementation

uses UfrmAccessSet, Udbm;

{$R *.dfm}

function TfrmReadAccess.LinkADO( sPathName: string ) : boolean;
var
  ss : String;
  slt:TStringList;
  i:integer;
begin
  cbxTable.Items.Clear;
  Result := False;                   
//  vDir := ExtractFilePath(application.ExeName);
  if not FileExists( sPathName ) then Exit;

  if adoConnection.Connected then
    adoConnection.Connected := false;
  {
  Provider=MSDASQL.1;
  Password=why;
  Persist Security Info=True;
  User ID=admin;
  Extended Properties="DBQ=E:\card\cardBase.mdb;
  DefaultDir=E:\delphi\card;Driver={Microsoft Access Driver (*.mdb)};       //}

  {
  DriverId=25;
  Exclusive=1;
  FIL=MS Access;
  MaxBufferSize=2048;
  MaxScanRows=8;
  PageTimeout=5;
  ReadOnly=0;
  SafeTransactions=0;
  Threads=3;
  UID=admin;
  UserCommitSync=Yes;"
  //}

  //adoConnection.ConnectionString := 'Provider=MSDASQL.1;Password=why;'+
  //    'Persist Security Info=True;User ID=admin;Extended Properties="'+
  //    'DBQ='+vdir+'cardBase.mdb;'+
  //    'Driver={Microsoft Access Driver (*.mdb)};'+
  //    'DriverId=25;Exclusive=1;FIL=MS Access;MaxBufferSize=2048;MaxScanRows=8;'+
  //    'PageTimeout=5;ReadOnly=0;SafeTransactions=0;Threads=3;UID=admin;"';
  //}
  mdbUser := 'admin';
//  mdbPass := '';

  adoConnection.ConnectionString := 'Provider=MSDASQL.1;Password='+mdbPass+';'+
      'Persist Security Info=True;User ID='+mdbUser+';Extended Properties="'+
      'DBQ='+sPathName+';'+
      'Driver={Microsoft Access Driver (*.mdb)};'+
      'DriverId=25;Exclusive=1;FIL=MS Access;MaxBufferSize=2048;MaxScanRows=8;'+
      'PageTimeout=5;ReadOnly=0;SafeTransactions=0;Threads=3;UID='+mdbUser+';"';

  try
    adoConnection.Connected := true;
  except
    exit;
  end;

  Result := adoConnection.Connected;

  slt := TStringList.Create();
  adoConnection.GetTableNames(slt,false);//B
  for i := 0 to slt.Count-1 do
  begin
    ss := slt.Strings[i];
    //ss := copy(ss,5,length(ss)-4);
    cbxTable.Items.Add( ss );
  end;
  slt.Free;

end;

procedure TfrmReadAccess.bbtOpenAClick(Sender: TObject);
var
  aPassWord : PassType;
begin
  inherited;
  //
  labPathA.Caption := '';
  labBS.Caption := labBS.Hint;
  grpZD.Caption := '字段';
  labJL.Caption := labJL.Hint;
  cbxTable.Items.Clear;
  CheckListBox1.Items.Clear;

  ADOQuery1.Close;
  ADOQuery2.Close;
  ADOQuery3.Close;
  
  if adoConnection.Connected then
    adoConnection.Connected := false;
    
  if OpenDialog2.Execute then
  begin
    labPathA.Caption := OpenDialog2.FileName;

    aPassWord := ExecAccessFile( labPathA.Caption );
    mdbPass := aPassWord.PassCode;

    editUser.Text := aPassWord.FileType;
    editPass.Text := aPassWord.PassCode;

//    addMo( 'PassCode = '+ aPassWord.PassCode );
//    addMo( '该数据库是:' + aPassWord.FileType );
//    addMo( FormatDateTime( 'yyyy-m-d h:mm:ss',aPassWord.FileTime) );

    if LinkADO( labPathA.Caption ) then
    begin
      labBS.Caption := labBS.Hint + IntToStr( cbxTable.Items.Count );
      grpZD.Caption := '字段';
      labJL.Caption := labJL.Hint;
    end;
  end;
  
end;

procedure TfrmReadAccess.listField( tbName : string );
var
  ss:string;
  i,a:integer;
begin
  //
  CheckListBox1.Items.Clear;
  grpZD.Caption := '字段';
  labJL.Caption := labJL.Hint;

  with ADOQuery1 do
  begin
    Close;
    SQL.Text := 'select * from ['+tbName+']';
      
    try
      Open;
    except
      exit;
    end;

    grpZD.Caption := '字段 ( '+IntToStr( ADOQuery1.FieldCount )+' )';//字段数
    labJL.Caption := labJL.Hint + IntToStr( ADOQuery1.RecordCount );//记录数
  end;

  a := ADOQuery1.FieldCount;
  for i := 0 to a-1 do
  begin
    ss := ADOQuery1.Fields.Fields[i].FieldName;
    
//    addMo( FullString(ss,' ',10,false)
//          +FullString(' | '+getFieldType( ADOQuery1.Fields.Fields[i].ClassName )
//          +'【'+IntToStr( ADOQuery1.Fields.Fields[i].Size )+'】',' ',18,false)
//          +' | '+ADOQuery1.Fields.Fields[i].ClassName );

    CheckListBox1.Items.Add( ss );
    CheckListBox1.Checked[i] := true;  
  end;
  
end;

procedure TfrmReadAccess.cbxTableChange(Sender: TObject);
var
  ss:string;
begin
  inherited;
  //
  cbxTable.Hint := '';
  ss := cbxTable.Text;
  if pos('.',ss)<>0 then
  begin
    exit;
  end;

  //防止重复刷新
  if SameText( ss,cbxTable.Hint ) then
  begin
    exit;
  end;

  mo.Text := 'select * from '+ss;
  
  cbxTable.Hint := ss;
  listField(ss);
  btnRefresh.Click;
end;

procedure TfrmReadAccess.N5Click(Sender: TObject);
var
  i : Integer;
begin
  inherited;
  //反选 &1
  for i := 0 to CheckListBox1.Items.Count-1  do
  begin
    CheckListBox1.Checked[i] := not CheckListBox1.Checked[i];
  end;
end;

procedure TfrmReadAccess.N6Click(Sender: TObject);
var
  i : Integer;
begin
  inherited;
  //不选 &2
  for i := 0 to CheckListBox1.Items.Count-1  do
  begin
    CheckListBox1.Checked[i] := False;
  end;
end;

procedure TfrmReadAccess.N7Click(Sender: TObject);
var
  i : Integer;
begin
  inherited;
  //全选 &3
  for i := 0 to CheckListBox1.Items.Count-1  do
  begin
    CheckListBox1.Checked[i] := True;
  end;
end;

procedure TfrmReadAccess.btnRefreshClick(Sender: TObject);
var
  i,k : Integer;
  ss : string;
begin
  inherited;
  //
  if Trim(cbxTable.Hint)='' then Exit;
  if not adoConnection.Connected then Exit;
  
  ADOQuery2.Close;
  ADOQuery2.Filtered := False;
  ADOQuery2.Filter := '';
  ADOQuery2.SQL.Text := 'select';

  k := 0;
  for i := 0 to CheckListBox1.Items.Count-1 do
  begin
    if CheckListBox1.Checked[i] then
    begin
      ss := CheckListBox1.Items.Strings[i];
      if k>0 then
      begin
        ss := ',['+ ss+']';
      end;
      ADOQuery2.SQL.Add( ss );
      Inc(k)
    end;
  end;

  if k<=0 then Exit;
  ADOQuery2.SQL.Add( ' from ['+cbxTable.Hint+']' );

  mo.Text := ADOQuery2.SQL.Text;

  try
//    mo.Text := ADOQuery2.SQL.Text;
    ADOQuery2.Open;
  except
  end;  
end;

procedure TfrmReadAccess.N3Click(Sender: TObject);
var
  ss,sv : string;
begin
  inherited;
  //过滤 &G
  if not adoConnection.Connected then Exit;
  if not ADOQuery2.Active then Exit;

  ss := getFieldTypeSQL( DBGrid1.SelectedField.ClassName );
  if SameText( ss,'image' )
    or SameText( ss,'text' )
    or SameText( ss,'--' ) then
  begin
    ShowMessage( '此字段的类型不能进行过滤！' );
    Exit;
  end;

  ss := DBGrid1.SelectedField.FieldName;
  sv := ADOQuery2.FieldByName( ss ).AsString;

  ADOQuery2.Filtered := False;
  ADOQuery2.Filter := ss+'='+QuotedStr( sv );
//  ADOQuery2.Filter := ss+'='+sv;
  ADOQuery2.Filtered := True;
  labJL.Caption := labJL.Hint + IntToStr( ADOQuery2.RecordCount );//记录数

//  addMo( ADOQuery2.Filter );

end;

procedure TfrmReadAccess.N4Click(Sender: TObject);
begin
  inherited;
  //全部 &A
  if not adoConnection.Connected then Exit;
  if not ADOQuery2.Active then Exit;

  ADOQuery2.Filtered := False;
  ADOQuery2.Filter := '';
  ADOQuery2.Filtered := True;
  labJL.Caption := labJL.Hint + IntToStr( ADOQuery2.RecordCount );//记录数
end;

procedure TfrmReadAccess.DBGrid1DblClick(Sender: TObject);
begin
  inherited;
  N3.Click;
end;

procedure TfrmReadAccess.DBGrid1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  if Button = mbRight then
  begin
    N4.Click;
  end;

  if Button = mbLeft then
  begin
//    ssShift, ssAlt, ssCtrl,ssLeft, ssRight, ssMiddle, ssDouble
    if ssCtrl in Shift then
    begin

    end;

  end;
end;

procedure TfrmReadAccess.BitBtn2Click(Sender: TObject);
var
  StrList : TStrings;
  i : Integer;
begin
  inherited;
  //保存配置
//  if Trim(cbxTable.Hint)='' then Exit;
  if Trim(cbxTable.Text)='' then Exit;
  if not adoConnection.Connected then Exit;
  if CheckListBox1.Items.Count<=0 then Exit;

  strList := TStringList.Create;
//  k := 0;
  for i := 0 to CheckListBox1.Items.Count-1 do
  begin
    if CheckListBox1.Checked[i] then
    begin
      strList.Add( CheckListBox1.Items.Strings[i] );
//      Inc(k)
    end;
  end;

  if strList.Count<=0 then
  begin
    strList.Free;
    Exit;
  end;

  Application.CreateForm(TfrmAccessSet,frmAccessSet);
  frmAccessSet.sTBName := cbxTable.Text;
  frmAccessSet.StrList.Assign(strList);
  frmAccessSet.Hint := 'add';
  frmAccessSet.ShowModal;
  frmAccessSet.Free;

//  strList.Add(sFileName);
//  strList.SaveToFile( sto );
  strList.Free;
end;

procedure TfrmReadAccess.BitBtn3Click(Sender: TObject);
var
  StrList : TStrings;
  i,iRet : Integer;
  ss : string;
begin
  inherited;
  //读取配置
  if Trim(cbxTable.Text)='' then Exit;
  if not adoConnection.Connected then Exit;
  if CheckListBox1.Items.Count<=0 then Exit;

  strList := TStringList.Create;

  Application.CreateForm(TfrmAccessSet,frmAccessSet);
  frmAccessSet.sTBName := cbxTable.Text;
  frmAccessSet.Hint := 'read';
  iRet := frmAccessSet.ShowModal;
  if iRet=1 then
  begin
    strList.Assign( frmAccessSet.StrList );
  end;
  frmAccessSet.Free;

  if iRet=1 then
  begin
    for i := 0 to CheckListBox1.Count-1 do
    begin
      CheckListBox1.Checked[i] := False;
      ss := CheckListBox1.Items.Strings[i];
      for iRet := 0 to strList.Count-1 do
      begin
        if SameText( strList.Strings[iRet],ss ) then
        begin
          CheckListBox1.Checked[i] := True;
        end; 
      end; 
    end;
  end;
  //---------------------------------
  strList.Free;
end;

procedure TfrmReadAccess.BitBtn1Click(Sender: TObject);
begin
  inherited;
  ADOQuery2.Close;
  ADOQuery2.SQL.Text := mo.Text ;
  try
    ADOQuery2.Open;
  except

  end;
end;

end.