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

📄 unit1.pas

📁 万能数据库查看程序 万能数据库查看程序
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, DBGrids, DB, ADODB, StdCtrls, Buttons, ExtCtrls, DBTables,ShellApi,
  XPMenu,StrUtils,Math,Menus;

type
  TForm1 = class(TForm)
    DataSource1: TDataSource;
    ADOConnection1: TADOConnection;
    Panel2: TPanel;
    Panel1: TPanel;
    EDatabaseFile: TEdit;
    OpenDialog1: TOpenDialog;
    EPass: TEdit;
    LDataFile: TLabel;
    LPass: TLabel;
    BOpenDatabase: TBitBtn;
    SaveToFile: TSaveDialog;
    GroupBox2: TGroupBox;
    DBGrid1: TDBGrid;
    Splitter1: TSplitter;
    GroupBox1: TGroupBox;
    LTableList: TListBox;
    LSQLCommand: TLabel;
    BSqlCommand: TBitBtn;
    SqlStr: TComboBox;
    XPMenu1: TXPMenu;
    ADOQuery1: TADOQuery;
    ComboBox1: TComboBox;
    RadioGroup1: TRadioGroup;
    EUser: TEdit;
    LUser: TLabel;
    LPassword: TLabel;
    QueryBDE: TQuery;
    DatabaseBDE: TDatabase;
    BOutoToFile: TBitBtn;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    LDataType: TLabel;
    procedure LTableListClick(Sender: TObject);
    procedure BOpenDatabaseClick(Sender: TObject);
    procedure EDatabaseFileClick(Sender: TObject);
    procedure DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
    procedure DBGrid1TitleClick(Column: TColumn);
    procedure RadioGroup1Click(Sender: TObject);
    procedure BOutoToFileClick(Sender: TObject);
    procedure BSqlCommandClick(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  LTableList_ItemIndex:integer=0;

implementation

uses DBFunctions;


{$R *.dfm}

procedure TForm1.LTableListClick(Sender: TObject);
begin
if (LTableList.ItemIndex<>-1) {and (LTableList.Items[LTableList.ItemIndex]<>'')} then
try
  begin
    Screen.Cursor:=crAppStart;
    Application.ProcessMessages;
    LTableList_ItemIndex:=LTableList.ItemIndex;
  if RadioGroup1.Items[RadioGroup1.ItemIndex]='BDE' then
  begin
    with QueryBDE do
      begin
        Close;
        Sql.Clear;
        DatabaseName:=DatabaseBDE.DatabaseName;
        if LTableList.ItemIndex<>-1 then
          begin
            SQL.Add(Pchar('Select * from '+LTableList.Items[LTableList.ItemIndex]+';'));
            try Open; except application.MessageBox('数据表有问题,无法正常打开!','提示',0);   end;
            DataSource1.DataSet:=QueryBDE;
            DBGrid1.DataSource:=DataSource1;
          end;
      end;
  end else
  begin
    with ADOQuery1 do
      begin
        Close;
        SQL.Clear;
        Connection:=ADOConnection1;
        if LTableList.ItemIndex<>-1 then
          begin
            SQL.Add(Pchar('Select * from '+LTableList.Items[LTableList.ItemIndex]+';'));
            try Open; except application.MessageBox('数据表有问题,无法正常打开!','提示',0);   end;
            DataSource1.DataSet:=ADOQuery1;
            DBGrid1.DataSource:=DataSource1;
          end;
      end;
  end;
    DBFunctions.DBGridAutoSize(DBGrid1,15);//调用对DBGrid控件数据进行自动字段宽度的处理过程
    Screen.Cursor:=crDefault;
  end;
except
Screen.Cursor:=crDefault;
end;
end;


procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
  ComboBox1.Items.Clear;
  case TRadioGroup(Sender).ItemIndex of
    0:begin
        ComboBox1.Items.Add('=====驱动类型=====');
        ComboBox1.Items.Add('Access Database'); // MS Access Database
        ComboBox1.Items.Add('OLEDB.3.51 *.mdb'); //Microsoft.Jet.OLEDB.3.51
        ComboBox1.Items.Add('OLEDB.4.0 *.mdb');  //Microsoft.Jet.OLEDB.4.0
        ComboBox1.Items.Add('dBASE *.dbf;*.?dx'); //*.dbf;*.ndx;*.mdx
        ComboBox1.Items.Add('VFP Datebase *.dbf');
        ComboBox1.Items.Add('VFP Datebase *.dbc');
        ComboBox1.Items.Add('SQL Server');
        ComboBox1.Items.Add('搜索数据源别名...');
        ComboBox1.Text:='Access Database';
      end;
    1:begin
        ComboBox1.Items.Add('打开文件...');
        ComboBox1.Items.Add('搜索数据源别名...');
        ComboBox1.Text:='打开文件...';
      end;
  end;
  OpenDialog1.DefaultExt:='*.dbf,*.mdb,*.db,*.dbc,*.?dx';
  ///ComboBox1DropDown(Sender);   //调用此过程用来读取并重置当前应该有的数据源驱动列表
  ComboBox1Change(Sender);   //调用此过程用来重新应用当前路径框和各按钮的可用状态
end;

procedure TForm1.BOpenDatabaseClick(Sender: TObject);
var PathStr:string;  //用来接收输入的路径
begin
  try
  Screen.Cursor:=crAppStart;
  Application.ProcessMessages;
  LTableList.Clear;
  DatabaseBDE.Close;
  ADOConnection1.Close;
  ADOQuery1.Close;
  ADOQuery1.Active:=False;
  QueryBDE.Close;
  QueryBDE.Active:=False;
  LTableList_ItemIndex:=0;
  BOutoToFile.Enabled:=False;
  BSqlCommand.Enabled:=False;
  N1.Enabled:=False;
  N2.Enabled:=False;
  N3.Enabled:=False;
  N4.Enabled:=False;

  if RadioGroup1.Items[RadioGroup1.ItemIndex]='ADO' then
  begin  //如果驱动类型选择了ADO进入这里
    if Trim(ComboBox1.Text)<>'' then
      begin
        ///Session.GetAliasNames(ComboBox1.Items);
        DataSource1.DataSet:=ADOQuery1;
        ADOConnection1.LoginPrompt:=false;  //去除登录密码验证窗口
        try
        if Trim(ComboBox1.Text)='Access Database' then    //要指明文件
          begin
            if not AnsiContainsText(EDatabaseFile.text,'.') then EDatabaseFileClick(Sender);
            if not AnsiContainsText(EDatabaseFile.text,'.') then begin Screen.Cursor:=crDefault; exit; end;
            ADOConnection1.ConnectionString:='Provider=MSDASQL.1;Password='+EPass.Text+';Persist Security Info=True;User ID='+EUser.Text+';Extended Properties="DSN=MS Access Database;DBQ='+EDatabaseFile.text+';DefaultDir='+ExtractFilePath(EDatabaseFile.text)+';DriverId=25;MaxBufferSize=2048;FIL=MS Access;PWD='+EPass.Text+';UID='+EUser.Text+';"';
          end
        else
        if Trim(ComboBox1.Text)='OLEDB.3.51 *.mdb' then    //要指明文件
          begin
            if not AnsiContainsText(EDatabaseFile.text,'.') then EDatabaseFileClick(Sender);
            if not AnsiContainsText(EDatabaseFile.text,'.') then begin Screen.Cursor:=crDefault; exit; end;
            ADOConnection1.ConnectionString:='Provider=Microsoft.Jet.OLEDB.3.51;Data Source='+EDatabaseFile.text+';Persist Security Info=False;Jet OLEDB:Database Password='+EPass.text+'';
          end
        else
        if Trim(ComboBox1.Text)='OLEDB.4.0 *.mdb'  then     //要指明文件
          begin
            if not AnsiContainsText(EDatabaseFile.text,'.') then EDatabaseFileClick(Sender);
            if not AnsiContainsText(EDatabaseFile.text,'.') then begin Screen.Cursor:=crDefault; exit; end;
            ADOConnection1.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+EDatabaseFile.text+';Persist Security Info=False;Jet OLEDB:Database Password='+EPass.text+'';
          end
        else
        if Trim(ComboBox1.Text)='dBASE *.dbf;*.?dx' then    //要指明目录(已处理成可以是文件) 最后不能有'\'
          begin
            if not AnsiContainsText(EDatabaseFile.text,'\') then EDatabaseFileClick(Sender);
            if not AnsiContainsText(EDatabaseFile.text,'\') then begin Screen.Cursor:=crDefault; exit; end;
            if AnsiContainsText(EDatabaseFile.text,'.') then EDatabaseFile.text:=ExtractFilePath(EDatabaseFile.text);
            if EDatabaseFile.text[length(EDatabaseFile.text)]='\' then EDatabaseFile.text:=leftstr(EDatabaseFile.text,length(EDatabaseFile.text)-1);
            ADOConnection1.ConnectionString:='Provider=MSDASQL.1;Password='+EPass.text+';Persist Security Info=True;User ID='+EUser.Text+';Extended Properties="DSN=dBASE Files;DBQ='+EDatabaseFile.text+';DefaultDir='+ExtractFilePath(EDatabaseFile.text)+';DriverId=533;MaxBufferSize=2048;PageTimeout=5;"';
          end
        else
        if Trim(ComboBox1.Text)='VFP Datebase *.dbf' then    //要指明目录(已处理成可以是文件) 最后必须有'\'
          begin
            if not AnsiContainsText(EDatabaseFile.text,'\') then EDatabaseFileClick(Sender);
            if not AnsiContainsText(EDatabaseFile.text,'\') then begin Screen.Cursor:=crDefault; exit; end;
            if AnsiContainsText(EDatabaseFile.text,'.') then EDatabaseFile.text:=ExtractFilePath(EDatabaseFile.text);
            if EDatabaseFile.text[length(EDatabaseFile.text)]<>'\' then EDatabaseFile.text:=EDatabaseFile.text+'\';
            ADOConnection1.ConnectionString:='Provider=MSDASQL.1;Password='+EPass.Text+';Persist Security Info=True;User ID='+EUser.Text+';Extended Properties="DSN=Visual FoxPro Tables;UID='+EUser.Text+';PWD='+EPass.Text+';SourceDB='+EDatabaseFile.text+';SourceType=DBF;Exclusive=No;BackgroundFetch=Yes;Collate=Machine;Null=Yes;Deleted=Yes;"';
          end
        else
        if Trim(ComboBox1.Text)='VFP Datebase *.dbc' then      //一定要指明数据库文件
          begin
            if not AnsiContainsText(EDatabaseFile.text,'.') then EDatabaseFileClick(Sender);
            if not AnsiContainsText(EDatabaseFile.text,'.') then begin Screen.Cursor:=crDefault; exit; end;
            ADOConnection1.ConnectionString:='Provider=MSDASQL.1;Password='+EPass.Text+';Persist Security Info=True;User ID='+EUser.Text+';Extended Properties="DSN=Visual FoxPro Database;UID='+EUser.Text+';PWD='+EPass.Text+';SourceDB='+EDatabaseFile.text+';SourceType=DBC;Exclusive=No;BackgroundFetch=Yes;Collate=Machine;Null=Yes;Deleted=Yes;"';
          end
        else
        if Trim(ComboBox1.Text)='SQL Server'     then        //要求IP,数据库 另外就是登陆用户名和密码
          begin
            PathStr:='(Local)';
            if not InputQuery('SQL Server','请输入你要连接到的SQL服务器名或IP            本地可用 (Local) 或 127.0.0.1 ',PathStr) then begin Screen.Cursor:=crDefault; exit; end;
            EDatabaseFile.text:=Trim(PathStr);
            PathStr:='pubs';
            if not InputQuery('数据库选择','请输入你要打开的数据库名,如:pubs      ',PathStr) then begin Screen.Cursor:=crDefault; exit; end;
            ADOConnection1.ConnectionString:='Provider=SQLOLEDB.1;Password='+EPass.Text+';Persist Security Info=True;User ID='+EUser.Text+';Initial Catalog='+PathStr+';Data Source='+EDatabaseFile.text+'';
          end
        else {if (ComboBox1.Items.IndexOf(ComboBox1.Text)<>-1) then} //打开已创建好的数据源
          begin
            ADOConnection1.ConnectionString:='Provider=MSDASQL.1;Password='+EPass.Text+';Persist Security Info=True;User ID='+EUser.Text+';Data Source='+ComboBox1.Text+'';
          end
        ;//else application.MessageBox('所选择的数据库或数据源别名不能被打开,请检查更改后再试!','打开数据库错误',0);
        ADOConnection1.Open;
        ADOConnection1.GetTableNames(LTableList.Items);
        Screen.Cursor:=crDefault;
        except
        Screen.Cursor:=crDefault;
        application.MessageBox('连接数据库失败,请检查用户密码和数据库名称路径及是否支持后重试!','打开数据库错误',0);
        end;
      end else begin Screen.Cursor:=crDefault; application.MessageBox('老兄有没有搞错呀,你没选择数据类型或据源别名你要打开什么呀?','打开数据库错误',0); exit; end;
  end else
  begin  //如果驱动类型选择了BDE进入这里
    //Session.GetAliasNames(ComboBox1.Items);
    DatabaseBDE.DriverName:='STANDARD';   //数据类型
    DataSource1.DataSet:=QueryBDE;
    DatabaseBDE.LoginPrompt:=False;
    DatabaseBDE.DriverName:='STANDARD';   //数据类型
    if Trim(ComboBox1.Text)<>'' then DatabaseBDE.DatabaseName:=Trim(ComboBox1.Text) else DatabaseBDE.DatabaseName:='MICHAEL';//设置当前实例的数据库别名
    if Trim(ComboBox1.Text)<>'' Then
      begin  //如果别名框(即ComboBox1.text)的内容不为空
        if ComboBox1.Text='打开文件...' then    //直接打开指定目录中的数据文件
          begin
            try
            if not AnsiContainsText(EDatabaseFile.text,'\') then EDatabaseFileClick(Sender);
            if not AnsiContainsText(EDatabaseFile.text,'\') then begin Screen.Cursor:=crDefault; exit; end;
                DatabaseBDE.Params.Clear;
                EDatabaseFile.text:=Trim(EDatabaseFile.text);
                if AnsiContainsText(EDatabaseFile.text,'.') then EDatabaseFile.text:=ExtractFilePath(EDatabaseFile.text);
                DatabaseBDE.Params.Add('PATH='+EDatabaseFile.text);
                DatabaseBDE.Params.Values['USERNAME']:=EUser.Text;
                DatabaseBDE.Params.Values['PASSWORD']:=EPass.Text;
                DatabaseBDE.connected:=true;
                DatabaseBDE.Open;
                DatabaseBDE.GetTableNames(LTableList.Items);
                QueryBDE.DatabaseName:=DatabaseBDE.DatabaseName;
            except
            Screen.Cursor:=crDefault;
            application.MessageBox('打开数据失败,请检查数据路径及数据文件是否有误或不支持!','打开数据失败',0);
            end;
          end else if (ComboBox1.Items.IndexOf(Trim(ComboBox1.Text))<>-1) then
          begin    //看选择的数据库是否是已创建好的数据源
            with DatabaseBDE do
            begin
              try

⌨️ 快捷键说明

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