📄 unit_dbparamset.pas

📁 SQL Server数据库安装程序.本程序通过列出可用远程SQL Server列表
💻 PAS
字号:
unit Unit_DBParamSet;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Buttons, ADODB, DB,ShellAPI,jpeg,Registry,FileCtrl,
  ComCtrls;

type
  Tfrm_DBParamSet = class(TForm)
    Panel1: TPanel;
    Label1: TLabel;
    Image1: TImage;
    Panel2: TPanel;
    Label2: TLabel;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    Label3: TLabel;
    Label4: TLabel;
    edt_ConnUser: TEdit;
    Label5: TLabel;
    edt_Pwd: TEdit;
    lst_SQLSrvList: TListBox;
    edt_DBName: TEdit;
    Label6: TLabel;
    Bevel1: TBevel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    ADOConn: TADOConnection;
    ADS: TADODataSet;
    chkSafe: TCheckBox;
    BitBtn3: TBitBtn;
    edt_ServerName: TEdit;
    Label10: TLabel;
    ADOQuery1: TADOQuery;
    Label11: TLabel;
    edt_DataPath: TEdit;
    Button1: TButton;
    Bevel2: TBevel;
    RichEdit1: TRichEdit;
    procedure FormCreate(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure lst_SQLSrvListClick(Sender: TObject);
    procedure edt_DBNameKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure BitBtn2Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure chkSafeClick(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    DBConStr: string;
    FMacineName: string;
    FDBName: string;
    FPwd: string;
    FConnUser: string;
    isServer: Boolean;
    srcMdf:string;
    srcLdf:string;
    function DBExists: Boolean;
    function ConnectDB(DBConStr:string):Boolean;
    procedure GetSQLServerLsit;
    function GetLocalSQLDataPath:string;
    procedure CopyFile(Const SrcFile,DestFile:string);
  public
    { Public declarations }
  end;

var
  frm_DBParamSet: Tfrm_DBParamSet;

implementation

uses
  comobj;
{$R *.dfm}

function Tfrm_DBParamSet.DBExists: Boolean;
begin
  with ADS do
  begin
    Close;
    CommandText := 'SELECT * FROM sysdatabases WHERE name = ''' + FDBName + '''';
    Open;
    if isEmpty then
      Result := False
    else
      Result := True;
  end;
end;

procedure Tfrm_DBParamSet.FormCreate(Sender: TObject);
begin
  GetSQLServerLsit;
  edt_DataPath.Text:=GetLocalSQLDataPath;
  srcMdf:=ExtractFilePath(ParamStr(0))+'Data\test_data.mdf';
  srcLdf:=ExtractFilePath(ParamStr(0))+'Data\test_log.ldf';
end;

procedure Tfrm_DBParamSet.BitBtn1Click(Sender: TObject);
const
  SQLStr='exec sp_attach_db %s,%s,%s';
var
  DBConStr: string;
  sFile1,sFile2:string;
begin
  if Trim(edt_DBName.Text) = '' then
  begin
    Application.MessageBox('您必需输入要创建的数据库名称！', '信息提示', MB_OK + MB_ICONINFORMATION);
    Exit;
  end;

  if Trim(edt_ConnUser.Text) = '' then
  begin
    Application.MessageBox('输入您选中的SQL Server服务器的数据库管理员名称，默认为sa', '信息提示', MB_OK + MB_ICONINFORMATION);
    Exit;
  end;

  FDBName := edt_DBName.Text;
  FConnUser := edt_ConnUser.Text;
  FPwd := Trim(edt_Pwd.Text);

  if chkSafe.Checked = True then
    DBConStr:='Provider=SQLOLEDB.1;Integrated Security=SSPI;'+
                'Persist Security Info=False;User ID=sa;Initial Catalog=master;Data Source='+FMacineName
  else if FPwd = '' then
    DBConStr := 'Provider=SQLOLEDB.1;Persist Security Info=False;' +
      'User ID=' + FConnUser + ';Initial Catalog=master;Data Source=' + FMacineName
  else
    DBConStr := 'Provider=SQLOLEDB.1;Password=' + FPwd + ';Persist Security Info=True;' +
      'User ID=' + FConnUser + ';Initial Catalog=master;Data Source=' + FMacineName;

  ADOConn.ConnectionString :=DBConStr;
  try
    ADOConn.Connected := True;
    if not DBExists then
    begin
        //1、拷贝数据库文件
        //2、将数据库加载到SQL Server
      try
        CopyFile(srcMdf,(edt_DataPath.Text+Trim(edt_DBName.Text)+'_data.mdf'));
        CopyFile(srcLdf,(edt_DataPath.Text+Trim(edt_DBName.Text)+'_log.ldf'));

        sFile1:=''''+edt_DataPath.Text+Trim(edt_DBName.Text)+'_data.mdf'+'''';
        sFile2:=''''+edt_DataPath.Text+Trim(edt_DBName.Text)+'_log.ldf'+'''';
        ADOQuery1.SQL.Clear;
        ADOQuery1.SQL.Add(Format(SQLStr,[edt_DBName.Text,sFile1,sFile2]));
        ADOQuery1.ExecSQL;        //附加数据库
        ADOConn.Connected:=False;
        Application.MessageBox('创建数据库成功!','FRACAS',MB_OK);
        Bitbtn1.Enabled:=False;
     except
        if ADOConn.Connected=True then ADOConn.Connected:=False;
        Application.MessageBox('创建数据库失败!','数据库创建程序',MB_OK);
     end;
    end
    else
    begin
      Application.MessageBox('数据库已经存在，请更换数据库名称!', '信息提示', MB_OK + MB_ICONINFORMATION);
      BitBtn1.Enabled:=False;
      edt_DBName.SelectAll;
      edt_DBName.SetFocus;
      Exit;
    end;
  except
    Application.MessageBox('不能连接服务器，请稍后重试！', '信息提示', MB_OK + MB_ICONINFORMATION);
    Close;
  end;
end;

procedure Tfrm_DBParamSet.lst_SQLSrvListClick(Sender: TObject);
begin
  edt_ServerName.Text := lst_SQLSrvList.Items[lst_SQLSrvList.ItemIndex];
end;

procedure Tfrm_DBParamSet.edt_DBNameKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = 13 then
    edt_Pwd.SetFocus;
end;

procedure Tfrm_DBParamSet.FormKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key = VK_F8) and (ssCtrl in Shift) then
  begin
    edt_ConnUser.Color := clWhite;
    edt_ConnUser.Enabled := True;
    edt_ConnUser.SetFocus;
  end;
end;

procedure Tfrm_DBParamSet.BitBtn2Click(Sender: TObject);
begin
  Close;
end;

procedure Tfrm_DBParamSet.FormShow(Sender: TObject);
begin
  edt_DBName.SetFocus;
end;

procedure Tfrm_DBParamSet.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  Action := caFree;
  frm_DBParamSet := nil;
end;

procedure Tfrm_DBParamSet.chkSafeClick(Sender: TObject);
begin
  if chkSafe.Checked = True then
  begin
    edt_Pwd.Color:=clSilver;
    edt_Pwd.Enabled:=False;
  end
  else
  begin
    edt_Pwd.Color:=clWhite;
    edt_Pwd.Enabled:=True;
  end;
end;

procedure Tfrm_DBParamSet.BitBtn3Click(Sender: TObject);
begin
  if Trim(edt_ServerName.Text)='' then
  begin
    Application.MessageBox('您没有选择或输入要安装的SQL Server服务器！', '信息提示', MB_OK + MB_ICONINFORMATION);
    edt_ServerName.SetFocus;
    Exit;
  end;
  if Trim(edt_ConnUser.Text) = '' then
  begin
    Application.MessageBox('输入您选中的SQL Server服务器的数据库管理员名称，默认为sa', '信息提示', MB_OK + MB_ICONINFORMATION);
    Exit;
  end;

  FMacineName:=edt_ServerName.Text;
  FDBName := edt_DBName.Text;
  FConnUser := edt_ConnUser.Text;
  FPwd := Trim(edt_Pwd.Text);

  IF chkSafe.Checked =True then
    DBConStr:='Provider=SQLOLEDB.1;Integrated Security=SSPI;'+
                'Persist Security Info=False;User ID=sa;Initial Catalog=master;Data Source='+FMacineName
  else if FPwd = '' then
    DBConStr := 'Provider=SQLOLEDB.1;Persist Security Info=False;' +
      'User ID=' + FConnUser + ';Initial Catalog=master;Data Source=' + FMacineName
  else
    DBConStr := 'Provider=SQLOLEDB.1;Password=' + FPwd + ';Persist Security Info=True;' +
      'User ID=' + FConnUser + ';Initial Catalog=master;Data Source=' + FMacineName;
      
  Screen.Cursor:=crHourGlass;
  try
    if ConnectDB(DBConStr) then
    begin
      Application.MessageBox('测试连接成功','信息提示',MB_OK+MB_ICONINFORMATION);
      BitBtn1.Enabled:=True;
    end
    else
      Application.MessageBox('测试连接失败,请重新测试或选用其他的服务器','信息提示',MB_OK+MB_ICONINFORMATION)
  finally
    Screen.Cursor:=crDefault;
  end;
end;

function Tfrm_DBParamSet.ConnectDB(DBConStr: string): Boolean;
begin
  try
    ADOConn.ConnectionString:=DBConStr;
    ADOConn.Connected:=True;
    Result:=True;
    ADOConn.Connected:=False;
  except
    Result:=False;
    ADOConn.Connected:=False;
  end;
end;

procedure Tfrm_DBParamSet.GetSQLServerLsit;
var
  SQLServer: Variant;
  ServerList: Variant;
  i, nServers: integer;
begin
  lst_SQLSrvList.Items.Clear;
  try
    SQLServer := CreateOleObject('SQLDMO.Application');
    ServerList := SQLServer.ListAvailableSQLServers;
    nServers := ServerList.Count;
    for i := 1 to nservers do
      lst_SQLSrvList.Items.Add(ServerList.Item(i));
    SQLServer := NULL;
    serverList := NULL;
  except
    Application.MessageBox('您当前的机器没有安装SQL Server，无法导入SQL Server服务器列表，'+#13+#10+'请直接输入SQL Server服务器名称！','信息提示',MB_OK+MB_ICONINFORMATION);
  end;
end;

function Tfrm_DBParamSet.GetLocalSQLDataPath: string;
var
  myReg:TRegistry;
begin
  myReg:=TRegistry.Create;
  with myReg do
  try
    RootKey:=HKEY_LOCAL_MACHINE;
    if OpenKey('Software\Microsoft\MSSQLServer\Setup\',False) then
      Result:=ReadString('SQLDataRoot')+'\Data\'
    else
      Result:='';
  finally
    CloseKey;
    Free;
  end;
end;

procedure Tfrm_DBParamSet.Button1Click(Sender: TObject);
var
  myDist:string;
begin
  if SelectDirectory('选择路径','',myDist) then
    edt_DataPath.Text:=myDist;
end;

procedure Tfrm_DBParamSet.CopyFile(const SrcFile, DestFile: string);
var
  FileOp: TSHFileOpStruct;
begin
  with FileOp do
  begin
    Wnd := 0;
    wFunc := FO_Copy;//更换此参数可实现拷贝和更名
    pFrom := PChar(SrcFile);
    pTo := PChar(DestFile);
    fFlags := FOF_NoConfirmation;
    fAnyOperationsAborted := False;
    hNameMappings := nil;
    lpszProgressTitle := nil
  end;
  SHFileOperation(FileOp);
end;

end.
💿 文件大小 101 K
👤 上传用户 sy361
📂 所属分类 SQL Server
🏷️ 相关标签

#Server #SQL #数据库 #安装程序
⌨️ 快捷键说明

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