mainunit.pas

MsSQL通用数据库创建程序源码 ,程序的功能主要是在Delphi中利用程序创建MsSQL通用数据库

unit MainUnit;

interface

uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   StdCtrls, ExtCtrls, DB, ADODB, ShellApi,Dialogs, Buttons, Gauges,IniFiles,
  ComCtrls, StatusBarEx,FileCtrl;

type
  TMainForm = class(TForm)
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    IPEdit: TEdit;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    saEdit: TEdit;
    sapwdEdit: TEdit;
    newdbfnEdit: TEdit;
    newdbsaEdit: TEdit;
    newdbpwdEdit: TEdit;
    Bevel1: TBevel;
    btn_Open: TSpeedButton;
    btn_Start: TButton;
    btn_Close: TButton;
    OpenDialog1: TOpenDialog;
    ADOConnection1: TADOConnection;
    Memo1: TMemo;
    CheckBox1: TCheckBox;
    newdbEdit: TComboBox;
    Access_Connection: TADOConnection;
    tmpquery: TADOQuery;
    access_query: TADOQuery;
    CheckBox2: TCheckBox;
    StatusBarEx1: TStatusBarEx;
    Gauge1: TGauge;
    btn_Help: TButton;
    procedure btn_OpenClick(Sender: TObject);
    procedure btn_CloseClick(Sender: TObject);
    procedure btn_StartClick(Sender: TObject);
    procedure CheckBox2Click(Sender: TObject);
    procedure btn_HelpClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    initaccessfn:string;              //初始化ACCESS数据库文件
    dbscriptfn:string;                //数据库创建脚本文件名
    Initialized_dbscriptfn:string;    //已经初始化好的了数据库创建脚本文件名
    procedure SysInitialize;
    function DbisExists(dbName:String;var dbfn:String):Boolean;
    function Create_Db(dbName:String;dbfn,logfn:String): Boolean;
    function Drop_Db(dbName:String):Boolean;
    function TableisExists(tbName,constr:String): Boolean;
    function Init_Create_db_fn(sql_fn:String):Boolean;
    function CreateDataBase(const dbname,FileName:string):boolean;
    function Table_Exists(const tbName:String;const myadocon:TAdoconnection): Boolean;
    function DBSrv_Connect_Is_OK:Boolean;

  public
    { Public declarations }
    function Init_Data:Boolean;
  end;

  function Copy_Table(s,d:Tadoquery;tn:String):Boolean;
  function AccessDB_Is_OK(dbfn:String):Boolean;
  function SplitString(const source,ch:string):tstringlist;
  function ReplaceStr(Str, SearchStr, ReplaceStr: string): string;
  function GetLocalHostName():string;

var
  MainForm: TMainForm;
  Log_Strings,Table_Name_Strings:TStrings;

implementation

uses HelpUnit;

{$R *.dfm}
var
  vmsg:String;

function GetLocalHostName():string;
var
  s:array[1..127] of Char;
  i:DWORD;
begin
  i := 127;
  GetComputerName(@s,i);
  Result := s;
end;

//分离字符串
function SplitString(const source,ch:string):tstringlist;
var
  temp:string;
  i:integer;
begin
  Result:=tstringlist.Create;
  temp:=source;
  i:=pos(ch,source);
  while i<>0 do
  begin
    Result.Add(copy(temp,0,i-1));
    delete(temp,1,i);
    i:=pos(ch,temp);
  end;
  Result.Add(Trim(temp));
end;

//字符串替换
function ReplaceStr(Str, SearchStr, ReplaceStr: string): string;
begin
  while Pos(SearchStr, Str) <> 0 do
  begin
    Insert(ReplaceStr, Str, Pos(SearchStr, Str));
    Delete(Str, Pos(SearchStr, Str), Length(SearchStr));
  end;
  Result := Str;
end;

function  TMainForm.CreateDataBase(const dbname,FileName:string):boolean;
var
  strlist:TStringList ;
  i:integer;
begin
  with tmpquery do
  begin

    if not Create_Db(dbname,newdbfnEdit.Text+newdbEdit.Text+'_Data.mdf',newdbfnEdit.Text+newdbEdit.Text+'_Log.ldf') then
    begin
      Result := False;
      Exit;
    end;

    //sql.Text:='Create database ['+dbname+'] ';
    //Execsql;
    ADOconnection1.DefaultDatabase:=Dbname;

    
    strlist:=TStringList.Create;
    strlist.LoadFromFile(Filename);
    if strlist.Text ='' then
      Result:=false;
    sql.Clear;
  end;

  StatusBarEx1.Panels.Items[1].Text := '正在创建数据库....';
  Gauge1.MaxValue := strlist.Count-1;
  with tmpquery do
  begin
    //ADO_DB.BeginTrans;
    try
      for i:=0 to strlist.Count -1 do
      begin
        Application.ProcessMessages;
        Gauge1.Progress:=i;
        if (Copy(Trim(strlist.Strings[i]),1,2)='/*') or (Copy(Trim(strlist.Strings[i]),1,2)='--') then
          continue;

        if UpperCase(Trim(strlist.Strings[i]))='GO' then
        begin
          Application.ProcessMessages;
          try
            Execsql;
          except
            on e:Exception do begin
              vmsg := '第'+inttostr(i)+'行：'+e.Message;
              Log_Strings.Add(DateTimeToStr(now)+'  '+vmsg);
              MessageBox(Handle, PChar(vmsg), PChar(Application.Title), MB_OK
                + MB_ICONSTOP);
              sql.Clear;
              Result:=false;
              Exit;
            end;
          end;
          sql.Clear;
        end
        else
          sql.Add(strlist.Strings[i]);
      end;
      Execsql;
      sql.Clear;
      //ADO_DB.CommitTrans;
    except
      on e:Exception do begin
        Log_Strings.Add(DateTimeToStr(now)+'  '+e.Message);
        //ADO_DB.RollbackTrans;
        sql.Clear;
        result:=false;
        Exit;
      end;
    end;
  end;
  strList.Free;
  Result:=true;
end;

procedure TMainForm.btn_OpenClick(Sender: TObject);
const
  SELDIRHELP = 1000;
var
  tmp_dir :String;
begin
  //tmp_dir := newdbfnEdit.Text;
  
  //if SelectDirectory(tmp_dir, [sdAllowCreate, sdPerformCreate, sdPrompt],SELDIRHELP) then
  if SelectDirectory('请选择数据库文件存放目录：','',tmp_dir) then
    newdbfnEdit.Text := tmp_dir;
end;

procedure TMainForm.btn_CloseClick(Sender: TObject);
begin
  Close;
end;

procedure TMainForm.btn_StartClick(Sender: TObject);
var
  dbfn,s :string;
  //old,i,ii,j:integer;
  is_OK :Boolean;
begin
  try
    screen.Cursor := crHourGlass;
    if newdbEdit.Text='' then
    begin
      MessageBox(Handle, '数据库名不能为空！请输入要创建的数据库名称！　　', 
        '数据库名不能为空', MB_OK + MB_ICONSTOP);
      Exit;
    end;

    Log_Strings.Clear;

    btn_Start.Enabled := False;

    if not DBSrv_Connect_Is_OK then
       Exit; 

    if Application.MessageBox(pchar('真的要创建名为〖'+newdbEdit.Text+'〗的数据库吗？'),'建库确认',MB_YESNO+MB_ICONQUESTION+MB_DEFBUTTON2)<>idyes then
       Exit;

    if DbisExists(newdbEdit.Text,dbfn) then
    begin
       if Application.MessageBox(pchar('同名数据库：〖'+newdbEdit.Text+'〗已经存在！'+#13+'其文件位于：〖'+dbfn+'〗，'+#13+#13+'如果再次创建的话，将会把原来的数据库及所有数据删除掉！　'+#13+#13+'你确定还要删除并重新创建这一同名数据库吗？'),'存在同名数据库',MB_YESNO+MB_ICONWARNING+MB_DEFBUTTON2)<>idyes then
          exit
       else
       begin
         s := '';

         if InputQuery('请确认', '请输入〖OK〗两个字符以便确认：',s) then
         begin
           if UpperCase(s)<>'OK' then
           begin
             is_OK := False;
             vmsg := '确认字符串验证失败！操作被取消！';
             Log_Strings.Add(DateTimeToStr(now)+'  '+vmsg);
             Application.MessageBox(PChar(vmsg),'操作中止',MB_OK+MB_ICONERROR);
             Exit;
           end else
           begin
             is_OK := True;
             Application.ProcessMessages;
             if not Drop_Db(newdbEdit.Text) then
             begin
             is_OK := False;
               vmsg := '数据库〖'+newdbEdit.Text+'〗删除失败！可能有其他用户正在使用！　　'+#13+'如果确实要删除它，重启数据库服务器再试！';
               Log_Strings.Add(DateTimeToStr(now)+'  '+vmsg);
               Application.MessageBox(pchar(vmsg),'数据库删除失败',MB_OK+MB_ICONERROR);
               Exit;
             end;
           end;
         end
         else
         begin
           is_OK := False;
           vmsg := '用户取消！操作被中止！';
           Log_Strings.Add(DateTimeToStr(now)+'  '+vmsg);
           Application.MessageBox(PChar(vmsg),'操作中止',MB_OK+MB_ICONINFORMATION);
           Exit;
         end;
       end;

       s := newdbfnedit.Text ;

       if s[length(s)]<>'\' then
         s := s+'\';

       newdbfnedit.Text := s;

       if not DirectoryExists(s) then
          ForceDirectories(s);

       sleep(1000);

       Memo1.Lines.Clear;


    end;

    if is_OK then
    begin
      s := newdbfnedit.Text ;

      if s[length(s)]<>'\' then
        s := s+'\';

      newdbfnedit.Text := s;

      if not DirectoryExists(s) then
         ForceDirectories(s);

      sleep(1000);

      if not Init_Create_db_fn(dbscriptfn) then
      begin
        vmsg := '数据库创建脚本文件初始化失败！';
        Log_Strings.Add(DateTimeToStr(now)+'  '+vmsg);
        Application.MessageBox(PChar(vmsg),'数据库脚本失败',MB_OK+MB_ICONERROR);
        Exit;
      end;

      if not CreateDataBase(newdbEdit.Text,Initialized_dbscriptfn) then
      begin
        vmsg := '数据库创建失败！请重试！　　';
        Log_Strings.Add(DateTimeToStr(now)+'  '+vmsg);
        Application.MessageBox(PChar(vmsg),'创建失败',MB_OK+MB_ICONERROR);
        Exit;
      end;

    end;

    if CheckBox1.Checked then
      is_OK := Init_Data; //初始化数据库基本数据

    if is_OK then
    begin
      vmsg := '数据库：〖'+newdbEdit.Text+'〗创建成功！　　';
      Log_Strings.Add(DateTimeToStr(now)+'  '+vmsg);
      Application.MessageBox(pchar(vmsg+#13+'请记住数据库用户角色及密码！　　'),'创建完成',MB_OK+MB_ICONINFORMATION)
    end else
    begin
      vmsg := '数据库：〖'+newdbEdit.Text+'〗创建失败！　　';
      Log_Strings.Add(DateTimeToStr(now)+'  '+vmsg);
      Application.MessageBox(pchar(vmsg+#13+#13+'请关闭所有与数据库连接的应用程序后重新创建！'),'创建失败',MB_OK+MB_ICONERROR);
    end;
    //Button2.Click;

  finally
    if Log_Strings.Text<>'' then
    begin
      Log_Strings.SaveToFile('Result.Log');
      if MessageBox(Handle, '日志已生成！要查看数据库创建过程日志吗？　　　',
        '系统提示', MB_YESNO + MB_ICONQUESTION + MB_TOPMOST) = IDYES then
      begin
        ShellExecute(Application.Handle,'OPEN','Result.Log',nil,nil,1);
      end;
    end;
    screen.Cursor := crDefault;
    btn_Start.Enabled := True;
  end;
end;

function TMainForm.DbisExists(dbName:String;var dbfn:String): Boolean;
var
  adoquery1:Tadoquery;
begin
  try
    Result := False;
    adoquery1 := TAdoquery.Create(nil);
    with adoquery1  do
    begin
      CommandTimeout := 300;
      Connection := AdoConnection1;
      close;
      sql.Clear;
      sql.Add('SELECT name,filename FROM master.dbo.sysdatabases WHERE name = '+quotedstr(dbName));
      Prepared := true;
      Open;
      dbfn := fieldbyname('filename').AsString;
      Result := Recordcount>0 ;
      Close;
    end;
  finally
    adoquery1.Free;
  end;
end;

function TMainForm.Drop_Db(dbName:String): Boolean;
var
  adoquery1:Tadoquery;
  sql_str :String;
begin
  try
    Result := False;
    vmsg := '正在删除旧数据库....';
    StatusBarEx1.Panels.Items[1].Text := vmsg;
    Application.ProcessMessages;
    sql_str := 'IF EXISTS (SELECT * FROM sysdatabases WHERE name = '+quotedstr(dbname)+') BEGIN DROP database '+dbname+' END;';

    //sql_str := 'DROP database '+dbName;
    //sql_str := 'sp_detach_db '+quotedstr(dbname)+','+quotedstr('true');

    adoquery1 := TAdoquery.Create(nil);
    with adoquery1  do
    begin
      CommandTimeout := 300;
      Connection := AdoConnection1;
      close;
      sql.Clear;
      sql.Add(sql_str);
      try
        ExecSql;
        Result := True;
        Close;
        vmsg := vmsg+'成功！';
        Log_Strings.Add(DateTimeToStr(now)+'  '+vmsg);
      except
        on e:Exception do begin
          vmsg := vmsg+'失败！'+e.Message;
          Log_Strings.Add(DateTimeToStr(now)+'  '+vmsg);
          Result := False;
        end;
      end;
    end;
  finally
    adoquery1.Free;
  end;
end;

function TMainForm.TableisExists(tbName,constr:String): Boolean;
var
  i:integer;
  mystrings:TStrings;
  myadocon:TAdoConnection;
begin
  try
    Result := False;
    mystrings := TStringList.Create;
    myadocon := TADoConnection.Create(self);
    myadocon.Close;
    myadocon.ConnectionString := constr;
    myadocon.Open;

    myadocon.GetTableNames(mystrings);
    for i:=0 to mystrings.Count-1 do
    begin
      if UpperCase(tbName)=UpperCase(mystrings.Strings[i]) then
      begin
        Result := True;
        break;
      end;
    end;
  finally
    myadocon.Close;
    myadocon.Free;