unit1.pas

自己写的一个动态访问SQL数据的程序

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,sqlapi,registry, ComCtrls, ExtCtrls, Menus, ImgList,
  Grids, Buttons,ComObj, DB, ADODB, CheckLst, XPMan;

type
  TItemEx=class(TObject)      caption:string;
   public
      StringValue:string;
end;


type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    ImageList1: TImageList;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    StatusBar1: TStatusBar;
    Panel2: TPanel;
    Label1: TLabel;
    Image1: TImage;
    Label2: TLabel;
    cmb_sql_server: TComboBox;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    cmb_sql_database: TComboBox;
    edt_sql_username: TEdit;
    edt_sql_password: TEdit;
    Label3: TLabel;
    Label4: TLabel;
    Bevel1: TBevel;
    Panel3: TPanel;
    Label5: TLabel;
    Image2: TImage;
    Panel4: TPanel;
    Label6: TLabel;
    Image3: TImage;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Bevel2: TBevel;
    ComboBox1: TComboBox;
    RadioButton3: TRadioButton;
    RadioButton4: TRadioButton;
    ComboBox2: TComboBox;
    Edit1: TEdit;
    Edit2: TEdit;
    Panel5: TPanel;
    Label10: TLabel;
    Image4: TImage;
    Panel1: TPanel;
    Label11: TLabel;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    BitBtn4: TBitBtn;
    BitBtn5: TBitBtn;
    BitBtn6: TBitBtn;
    BitBtn7: TBitBtn;
    BitBtn8: TBitBtn;
    btn_connect: TBitBtn;
    Label12: TLabel;
    ADOConnection1: TADOConnection;
    ADOQuery1: TADOQuery;
    CheckListBox1: TCheckListBox;
    XPManifest1: TXPManifest;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure BitBtn7Click(Sender: TObject);
    procedure BitBtn8Click(Sender: TObject);
    procedure btn_connectClick(Sender: TObject);
    procedure cmb_sql_databaseChange(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
  private
    { Private declarations }
    procedure list_lan_sqlserver(Sender: TObject);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
//SQLServerAvailable(GetComputerName
end;

Procedure test_sql;
  var   
      reg:Tregistry;
      cdkey:String;   
  begin   
      reg:=Tregistry.Create;   
      reg.RootKey:=HKEY_LOCAL_MACHINE;   
      try
            reg.OpenKey('SOFTWARE\MICROSOFT\MICROSOFT   SQL   SERVER\80\Registration',false);
            cdkey:=reg.ReadString('CD_KEY');   
            reg.CloseKey;   
            if   cdkey=NULL   then   showMessage('本机未安装SQL   SERVER!')
      else   showMessage('本机安装了SQL   SERVER!')   ;
      except   
            showMessage('本机未安装SQL   SERVER!');
      end;   
      reg.Free;   
  end;   

procedure TForm1.Button2Click(Sender: TObject);
begin
  test_sql;
end;

procedure TForm1.Button9Click(Sender: TObject);
begin
application.Terminate;
end;

procedure TForm1.FormCreate(Sender: TObject);

begin
  test_sql;
  cmb_sql_server.Items.Clear;
  //list_lan_sqlserver(sender);
end;
procedure TForm1.list_lan_sqlserver(Sender: TObject);
var
  sqlserver:variant;
  serverlist:variant;
  i:integer;
begin
  screen.cursor   :=   crhourglass;
  sqlserver     :=   createoleobject('sqldmo.application');
  serverlist   :=   sqlserver.listavailablesqlservers;
  if   serverlist.count   <   1   then
  begin
    showmessage('服务器不存在，请检测服务器是否已经开机或者服务是否打开了');
  end
  else
  begin

    for   i   :=   1   to   serverlist.count   do
      cmb_sql_server.items.add(serverlist.item(i));
    end;
  cmb_sql_server.itemindex:=0;
  sqlserver   :=   unassigned;
  screen.cursor   :=   crdefault;

end;
procedure TForm1.BitBtn7Click(Sender: TObject);
begin
  application.Terminate;
end;

procedure TForm1.BitBtn8Click(Sender: TObject);
begin
  list_lan_sqlserver(sender);
end;

procedure TForm1.btn_connectClick(Sender: TObject);
begin
  if btn_connect.Caption='连接数据库' then
  begin
    btn_connect.Caption:='断开连接';
    edt_sql_username.Enabled:=false;
    edt_sql_password.Enabled:=false;
    cmb_sql_server.Enabled:=false;
    WITH adoconnection1 do
    begin
      connected:=false;
      //Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=pubs;Data Source=FUX-IBMR50
      ConnectionString   :=   'Provider=SQLOLEDB.1;Persist Security Info=False;Initial   Catalog=master;';
      ConnectionString   :=   ConnectionString   +   'Data   Source=';
      ConnectionString   :=   ConnectionString   +   cmb_sql_server.Items[cmb_sql_server.itemindex]   +   ';';
      ConnectionString   :=   ConnectionString   +   'User ID=';
      ConnectionString   :=   ConnectionString   +   edt_sql_username.Text   +   ';';
      ConnectionString   :=   ConnectionString   +   'Password=';
      ConnectionString   :=   ConnectionString   +   edt_sql_password.Text;
      ConnectionTimeOut   :=   30;
      LoginPrompt   :=   False;
      KeepConnection   :=   False;
      //showmessage(ConnectionString);
      Connected   :=   True;
    end;
    adoquery1.SQL.Add('select name from master.dbo.sysdatabases');
    adoquery1.Open;
    ADOQUERY1.First;
    while not adoquery1.Eof do
    begin
      cmb_sql_database.Items.Add(adoquery1.fieldbyname('name').AsString);
      adoquery1.Next
    end;
    adoquery1.Close;
  end
  else
  begin
    btn_connect.Caption:='连接数据库';
    edt_sql_username.Enabled:=true;
    edt_sql_password.Enabled:=true;
    cmb_sql_server.Enabled:=true;
    adoconnection1.Close;
    cmb_sql_database.Items.Clear;
  end;
end;
procedure TForm1.cmb_sql_databaseChange(Sender: TObject);
var
  i:integer;
  ConnectionString:string;
begin
  if adoquery1.Active then
    adoquery1.Active:=false;
  if (cmb_sql_server.Items.Strings[cmb_sql_server.itemindex]='') and (cmb_sql_server.Text='') then exit;
      ConnectionString   :=   'Provider=SQLOLEDB.1;Persist Security Info=False;Initial   Catalog='+cmb_sql_database.Items[cmb_sql_database.itemindex]+';';
      ConnectionString   :=   ConnectionString   +   'Data   Source=';
      ConnectionString   :=   ConnectionString   +   cmb_sql_server.Items[cmb_sql_server.itemindex]   +   ';';
      ConnectionString   :=   ConnectionString   +   'User ID=';
      ConnectionString   :=   ConnectionString   +   edt_sql_username.Text   +   ';';
      ConnectionString   :=   ConnectionString   +   'Password=';
      ConnectionString   :=   ConnectionString   +   edt_sql_password.Text;
  //showmessage(connectionstring);
  adoquery1.ConnectionString:=connectionstring;
  adoquery1.SQL.Clear;
  adoquery1.SQL.Add('select name,crdate from '+cmb_sql_database.Items[cmb_sql_database.itemindex]+'.dbo.sysobjects where xtype=''U'' order by name');

  adoquery1.Open;
  adoquery1.First;
  checklistbox1.Items.Clear;
  i:=1;
  while not adoquery1.Eof do
  begin
    checklistbox1.Items.Add(adoquery1.fieldbyname('name').AsString);
    adoquery1.Next;
    i:=i+1;
  end;
  adoquery1.close;
end;

procedure TForm1.BitBtn3Click(Sender: TObject);
var
  i:integer;
begin
  for   i:=0   to   CheckListBox1.Count-1   do
    CheckListBox1.State[i]:=cbChecked;

end;

procedure TForm1.BitBtn4Click(Sender: TObject);
var
  i:integer;
begin
  for   i:=0   to   CheckListBox1.Count-1   do
    CheckListBox1.State[i]:=cbUnChecked;

end;

end.