main.pas

sql server200数据库创建和分离工具, 有源码

unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, DB, ADODB, FileCtrl, WinSkinData;

type
  TMainForm = class(TForm)
    ADOConnection1: TADOConnection;
    ADODataSet1: TADODataSet;
    ListBox1: TListBox;
    Button1: TButton;
    ADOCommand1: TADOCommand;
    Button2: TButton;
    ADOQuery1: TADOQuery;
    SkinData1: TSkinData;
    Button3: TButton;
    GroupBox1: TGroupBox;
    DirectoryListBox1: TDirectoryListBox;
    DriveComboBox1: TDriveComboBox;
    FileListBox1: TFileListBox;
    Edit1: TEdit;
    procedure FormShow(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure ListBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FileListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure FileListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure Button3Click(Sender: TObject);
    procedure Edit1Enter(Sender: TObject);
    procedure FileListBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure FileListBox1Click(Sender: TObject);
  private
    { Private declarations }
    Procedure Init();
    Procedure FillDataBaseName();
    Function GetDataBaseStoreFileName(DataBaseName:String):String;
//    Function DetachDataBase(DataBaseName:String):Boolean;
//    Function AttachDataBase(DataBaseName:String):Boolean;
    Function GetMasterDataBasePath():String;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}


Procedure TMainForm.FillDataBaseName();
begin
  try
    ADODataSet1.Active:=False;
    ADODataSet1.CommandText:='SELECT name FROM sysdatabases WHERE name<>''master''';
    ADODataSet1.Active:=True;
    ListBox1.Clear;
    While Not ADODataSet1.Eof do
    begin
      ListBox1.Items.Add(ADODataSet1.FieldByName('name').AsString);
      ADODataSet1.Next;
    end;
  except
    ShowMessage('取得数据库失败');
  end;
end;

Procedure TMainForm.Init();
begin
  FillDataBaseName();
end;

procedure TMainForm.FormShow(Sender: TObject);
begin
  Init();
end;

procedure TMainForm.Button1Click(Sender: TObject);
var
  SqlStr:String;
begin
  if (ListBox1.ItemIndex>-1)and(MessageBox(Self.Handle,'确定要分离该数据库吗？','警告',MB_YESNO+MB_DEFBUTTON2)=ID_YES) then
  begin
    SqlStr:='sp_detach_db '''+ListBox1.Items.Strings[ListBox1.ItemIndex]+''',''true''';
    ADOCommand1.CommandText:=SqlStr;
    ADOCommand1.Execute;
    FillDataBaseName();
  end;
end;

procedure TMainForm.Button2Click(Sender: TObject);
var
  SqlStr:String;
  SourceFileName:String;
  DestinationFileName:String;
begin
  Screen.Cursor:=crHourGlass;
  Try
    if (ListBox1.ItemIndex>-1)and(MessageBox(Self.Handle,'确定要分离该数据库吗？','警告',MB_YESNO+MB_DEFBUTTON2)=ID_YES) then
    begin
      SourceFileName:=GetDataBaseStoreFileName(ListBox1.Items.Strings[ListBox1.ItemIndex]);
      if ((Trim(DirectoryListBox1.Directory)<>'') and(DirectoryExists(DirectoryListBox1.Directory)=True)) then
      begin
        DestinationFileName:=DirectoryListBox1.Directory+'\'+ExtractFileName(SourceFileName);
        SqlStr:='sp_detach_db '''+ListBox1.Items.Strings[ListBox1.ItemIndex]+''',''true''';
        Try
          ADOCommand1.CommandText:=SqlStr;
          ADOCommand1.Execute;
          if CopyFile(PChar(SourceFileName),PChar(DestinationFileName),False)=True then
          begin
            FillDataBaseName();
            FileListBox1.Update;
            DeleteFile(SourceFileName);
          end
          else
          begin
          
          end;
        Except
          on E:Exception do
          begin
            ShowMessage(E.Message);
          end;
        End;
      end
      else
      begin
        ShowMessage('目录为空或不存在');
      end;
    end;
  Finally
    Screen.Cursor:=crDefault;
  end;
end;

Function TMainForm.GetDataBaseStoreFileName(DataBaseName:String):String;
begin
  try
    ADOQuery1.Active:=False;
    ADOQuery1.SQL.Text:='SELECT sysaltfiles.name AS DataBaseFile,sysaltfiles.filename AS DataBaseFileName '+
    'FROM sysaltfiles,sysdatabases '+
    'WHERE sysdatabases.dbid=sysaltfiles.dbid AND sysdatabases.name='''+DataBaseName+''' AND sysaltfiles.fileid=1';
    ADOQuery1.Active:=True;
    if ADOQuery1.RecordCount=1 then
    begin
      Result:=Trim(ADOQuery1.FieldByName('DataBaseFileName').AsString);
    end
    else
    begin
      Result:='';
    end;
  except
    Result:='';
  end;
end;

procedure TMainForm.ListBox1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
  with Sender as TListBox do
  begin
    if ItemAtPos(Point(X, Y), True) >= 0 then
      BeginDrag(False);
  end;
end;

procedure TMainForm.FileListBox1DragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
begin
  if Sender Is TListBox then
  begin
    Accept:=True;
  end;
end;

procedure TMainForm.FileListBox1DragDrop(Sender, Source: TObject; X,
  Y: Integer);
begin
  if Source Is TListBox then
  begin
    Button2.Click;
  end;
end;

{Function TMainForm.DetachDataBase(DataBaseName:String):Boolean;
begin
  Try
    Result:=True;
  Except
    Result:=False;
  End;
end;

Function TMainForm.AttachDataBase(DataBaseName:String):Boolean;
begin
  Try
    Result:=True;
  Except
    Result:=False;
  End;
end;          }

Function TMainForm.GetMasterDataBasePath():String;
begin
  Try
    ADOQuery1.Active:=False;
    ADOQuery1.SQL.Text:='SELECT filename FROM sysfiles1 WHERE fileid=1';
    ADOQuery1.Active:=True;
    if ADOQuery1.RecordCount=1 then
    begin
      Result:=ExtractFilePath(Trim(ADOQuery1.FieldByName('filename').AsString));
    end
    else
    begin
      Result:='';
    end;
  Except
    Result:='';
  End;
end;

procedure TMainForm.Button3Click(Sender: TObject);
var
  SqlStr:String;
  SourceFileName:String;
  DestinationFileName:String;
  DataBaseName:String;
begin
  Screen.Cursor:=crHourGlass;
  Try
    Try
      if MessageBox(Self.Handle,'确定要创建该数据库吗？','警告',MB_YESNO+MB_DEFBUTTON2)=ID_NO then
        Exit;
      SourceFileName:=Trim(FileListBox1.FileName);
      if SourceFileName='' then
      begin
        ShowMessage('没有选择数据库文件');
        Exit;
      end;

      DataBaseName:=Trim(Edit1.Text);
      if DataBaseName='' then
      begin
        ShowMessage('没有选择数据库文件');
        Exit;
      end;

      DestinationFileName:=GetMasterDataBasePath;
      if DestinationFileName<>'' then
      begin
        DestinationFileName:=DestinationFileName+ExtractFileName(SourceFileName);
      end
      else
      begin
        ShowMessage('未输入创建数据库名或取得SQLServer数据库目录失败');
        Exit;
      end;

      if CopyFile(PChar(SourceFileName),PChar(DestinationFileName),False)=True then
      begin
        Try
          SqlStr:='sp_attach_db '''+DataBaseName+''','''+DestinationFileName+'''';
          ADOCommand1.CommandText:=SqlStr;
          ADOCommand1.Execute;
          DeleteFile(SourceFileName);
          FillDataBaseName();
          FileListBox1.Update;
        Except
          on E:Exception do ShowMessage(E.Message);
        End;
      end;
    Except
      on E:Exception do ShowMessage(E.Message);
    End;
  Finally
    Screen.Cursor:=crDefault;
  End;
end;

procedure TMainForm.Edit1Enter(Sender: TObject);
begin
  TEdit(Sender).Text:='';
end;

procedure TMainForm.FileListBox1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
  with Sender as TFileListBox do
  begin
    if ItemAtPos(Point(X, Y), True) >= 0 then
      BeginDrag(False);
  end;
end;

procedure TMainForm.ListBox1DragDrop(Sender, Source: TObject; X,
  Y: Integer);
begin
  if Source Is TFileListBox then
  begin
    Button3.Click;
  end;
end;

procedure TMainForm.ListBox1DragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
begin
  if Sender Is TFileListBox then
  begin
    Accept:=True;
  end;
end;

procedure TMainForm.FileListBox1Click(Sender: TObject);
begin
//  Edit1.Text:=Copy(ExtractFileName(FileListBox1.FileName),1,pos('.',ExtractFileName(FileListBox1.FileName))-1);
end;

end.