自动创建数据库结构(sql2000+D6)

自动创建数据库结构(sql2000+D6)

---

作者：niker_2001 　来源于：delphibbs.com 　发布时间：2005-12-16 12:48:00 unit create_db_unit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, DB, ADODB,inifiles, ExtCtrls, Buttons,
  BusinessSkinForm;

type
  Tcreate_db_f = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    Label1: TLabel;
    ADOConnection: TADOConnection;
    Label2: TLabel;
    Label3: TLabel;
    Bevel1: TBevel;
    Button2: TButton;
    Edit2: TEdit;
    Edit3: TEdit;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    bsBusinessSkinForm1: TbsBusinessSkinForm;
    procedure Button1Click(Sender: TObject);
    function CheckDataBaseExists(dn:string):boolean;
    procedure Button2Click(Sender: TObject);
    procedure CheckInput;
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  create_db_f: Tcreate_db_f;

implementation

uses logo_unit;

{$R *.dfm}

const
  connectstr1 = 'Provider=SQLOLEDB.1;Password=%s;Persist Security Info=False;User ID=%s;Initial Catalog=%s;Data Source=%s;Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;Workstation ID=RD-SW;Use Encryption for Data=False;';
  connectstr2 = ' Tag with column collation when possible=False';
  dbname='CREATE DATABASE [%s]  ON (NAME = N'+''''+'%s'+'''';
  dbpath=', FILENAME = N'+''''+'%s'+'''';
  logname=', SIZE = 46, FILEGROWTH =1) LOG ON (NAME = N'+''''+'%s'+'''';
  logpath=',FILENAME = N'+''''+'%s'+''''+', SIZE = 34, FILEGROWTH = 1)';

{******************************************************************************
完整检查
*****************************************************************************}
procedure Tcreate_db_f.CheckInput;
begin
  if (edit1.Text='') or (edit2.Text='') or (edit3.Text='') then
  begin
    showmessage('套帐名称，数据路径，日志路径 都要输入完整');
    abort;
  end;
end;


{**************************************************************************
  连接数据且查看数据库是否存在
***************************************************************************}
function Tcreate_db_f.CheckDataBaseExists(dn:string):boolean;
var
  supername,password,datasource:string;
  Myinifile:Tinifile;
  qt:Tadoquery;
  procedure connect_database(pwd,supername,ds:string);
  begin
    with adoconnection do begin
      if connected then close;
      connectionstring := format(connectstr1, [pwd, supername, 'master', ds]);
      connectionstring := connectionstring + connectstr2;
      open;
    end;
  end;
begin
  MyIniFile := TIniFile.Create(extractfilepath(application.ExeName)+'connection.ini');
  with MyIniFile do begin
    try
      supername := Readstring('connection', 'supername', 'sa');
      password := readstring('connection', 'password', '');
      datasource := readstring('connection', 'source', '');
    finally
      free;
    end;
  end;
  connect_database(password,supername,datasource);
  qt:=Tadoquery.Create(self);
  qt.Connection:=adoconnection;
  qt.SQL.add('Select name From sysdatabases where name='+''''+dn+'''');
  qt.Open;
  result:=qt.RecordCount>0;
end;

procedure Tcreate_db_f.Button1Click(Sender: TObject);
var
  qt:Tadoquery;
  op:TOpenDialog;
  dbstring,createstr:string;
begin
  CheckInput;
  if CheckDataBaseExists('super'+edit1.Text) then begin
        showmessage('套帐名称已经存在！请取另一个名称。');
        exit;
  end
  else begin
  createstr:='super_'+edit1.text;
  dbstring:=format(dbname,[createstr,createstr+'Data']);
  dbstring:=dbstring+format(dbpath,[edit2.text]);
  dbstring:=dbstring+format(logname,['super_'+edit1.text]);
  dbstring:=dbstring+format(logpath,[edit3.text]);
//  showmessage(dbstring);
  qt:=Tadoquery.Create(self);
  qt.Connection:=adoconnection;
  op:=TOpenDialog.Create(self);
//  showmessage(extractfilepath(application.ExeName)+'db.txt');
  try
    qt.SQL.Add(dbstring);
//    showmessage(qt.SQL.Strings[0]);
    try
      qt.ExecSQL;//创建数据库，
      qt.SQL.Clear;
      if fileexists(extractfilepath(application.ExeName)+'db.txt') then
            qt.SQL.LoadFromFile(extractfilepath(application.ExeName)+'db.txt')
      else if op.Execute then begin
            qt.SQL.LoadFromFile(op.FileName);
      end else exit;
//      showmessage(qt.SQL.Strings[0]);
      qt.SQL.Strings[0]:='use '+createstr;
//      qt.SQL.SaveToFile('c:/test.txt');
      qt.ExecSQL;//db.txt保存的是数据库创建的脚本
      showmessage('套帐创建成功！');
//      LOGO.GETDATABASE;
      CLOSE;
    except
       on e:Exception do showmessage(e.Message);
    end;
  finally
    qt.Free;
    op.Free;
  end;
  end;
end;

procedure Tcreate_db_f.Button2Click(Sender: TObject);
begin
  close;
end;

procedure Tcreate_db_f.SpeedButton1Click(Sender: TObject);
var
  op:Tsavedialog;
begin
  op:=Tsavedialog.Create(self);
  try
    op.DefaultExt:='.MDF';
    OP.Filter:='数据文件|*.MDF';
    op.FileName:='super_data'+edit1.Text;
  //  op.Options:=op.Options+[ofPathMustExist];
    if op.Execute then edit2.Text:=op.FileName;
  finally
    op.Free;
  end;
end;

procedure Tcreate_db_f.SpeedButton2Click(Sender: TObject);
var
  op:Topendialog;
begin
  op:=Topendialog.Create(self);
  try
    op.DefaultExt:='.LDF';
    OP.Filter:='日志文件|*.LDF';
    op.FileName:='super_log'+edit1.Text;
    if op.Execute then edit3.Text:=op.FileName;
  finally
    op.Free;
  end;
end;

end.
//sql生存的脚本除去所有的go语句,初始化的数据加在其后，存成一个.txt文件，如果直接使用生成的.sql将会出现语法错误.