main.pas

简单的SQL Server数据库安装

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, DB, ADODB, Registry, ComCtrls, Mask, DBCtrlsEh,
  DBLookupEh, Buttons, DBGridEh;

type
  TForm1 = class(TForm)
    ADOConnection1: TADOConnection;
    Label2: TLabel;
    ADOQuery1: TADOQuery;
    ADOQuery2: TADOQuery;
    ADOConnection2: TADOConnection;
    btCancel: TButton;
    OpenDialog1: TOpenDialog;
    Edit2: TEdit;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    Label3: TLabel;
    Label4: TLabel;
    Button1: TButton;
    Edit3: TEdit;
    Edit4: TEdit;
    CheckBox1: TCheckBox;
    btOpen: TButton;
    btConnect: TButton;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    DBLookupComboboxEh1: TDBLookupComboboxEh;
    ADOQuery3: TADOQuery;
    DataSource1: TDataSource;
    Label5: TLabel;
    Edit5: TEdit;
    Label6: TLabel;
    SaveDialog1: TSaveDialog;
    btSave: TButton;
    btBuckup: TButton;
    DBLookupComboboxEh2: TDBLookupComboboxEh;
    Label7: TLabel;
    ADOQuery4: TADOQuery;
    BitBtn1: TBitBtn;
    DataSource2: TDataSource;
    TabSheet4: TTabSheet;
    btSetup: TButton;
    ADOQuery5: TADOQuery;
    ADOConnection3: TADOConnection;
    ADOQuery6: TADOQuery;
    TabSheet5: TTabSheet;
    Label9: TLabel;
    ReportName: TDBLookupComboboxEh;
    ComboBox1: TComboBox;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    DBLookupComboboxEh3: TDBLookupComboboxEh;
    Label10: TLabel;
    Button5: TButton;
    ADOReportMst: TADOQuery;
    ADOReportDtl: TADOQuery;
    DataSource3: TDataSource;
    Edit7: TEdit;
    Label1: TLabel;
    Edit1: TEdit;
    ADOQuery7: TADOQuery;
    procedure FormShow(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure btCancelClick(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure btOpenClick(Sender: TObject);
    procedure btConnectClick(Sender: TObject);
    procedure Edit2Change(Sender: TObject);
    procedure btSaveClick(Sender: TObject);
    procedure btBuckupClick(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure btSetupClick(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure ReportNameChange(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
    m_sSQLPlan: string;
    m_sBackupFile: string;
    m_sServer: string;
    m_bConnect, m_bNt: boolean;
    m_bHasSystem: boolean;
    iFontName: integer;
    procedure GetFontNames(Combox: TComboBox);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
function SetAdoQue(AdoQue: TADOQuery; sSQL: string; bSel: boolean): boolean;

implementation



{$R *.dfm}

function SetAdoQue(AdoQue: TADOQuery; sSQL: string; bSel: boolean): boolean;
//设定ADOQuery结果集
begin
  Result := true;
  try
    AdoQue.Close;
    AdoQue.SQL.Clear;
    AdoQue.SQL.Add(sSQL);
    if bSel then begin
      AdoQue.open;
      if AdoQue.RecordCount = 0 then begin
        Result := false;
        exit;
      end
    end else AdoQue.ExecSQL;
  except
    Result := false;
    exit;
  end;
end;


procedure TForm1.FormShow(Sender: TObject);
var
  sLedgerCode, sServer: string;
  Registry, Registry1: TRegistry;
  sSQLPlan: string;
begin
  Registry := TRegistry.Create;
  Registry1 := TRegistry.Create;
  Registry.RootKey := HKEY_LOCAL_MACHINE;
  Registry.OpenKey('SYSTEM\ControlSet001\Control\ComputerName\ActiveComputerName', false);
  sServer := Registry.ReadString('ComputerName');
  Registry1.RootKey := HKEY_LOCAL_MACHINE;
  if Registry1.OpenKey('SOFTWARE\MicroSoft\MSSQLSERVER\Setup', false) then begin
    sLedgerCode := Registry1.ReadString('LedgerName');
  end else begin
    Application.MessageBox(PChar('本系统要在SQL数据库服务器下运行！'), '警告', MB_YESNO + MB_ICONWARNING);
    Application.Terminate;
  end;
  sSQLPlan := Registry1.ReadString('SQLDataRoot');
  Registry.free;

  m_sSQLPlan := sSQLPlan;
//  Edit3.Text:=sLedgerCode;
//  Edit3.Text:=sSQLPlan;
  Edit2.Text := sServer;
  m_sServer := sServer;
  m_bConnect := false;
  m_bHasSystem := false;
  m_bNt := false;


  Registry1.free;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  sSQL: string;
  sBackupFile, sCode: string;
  bExists: boolean;
  sDataCode,sLogCode:string;
begin
{    sSQL:='select name from sysdatabases where name=''EDTSystem''';
    if not SetAdoQue(ADOQuery1,sSQL,true) then begin
      Application.MessageBox(PChar('系统数据库不存在！先安装系统数据库！'),'警告',MB_YESNO+MB_ICONWARNING);
      exit;
    end;
}
//    m_sSQLPlan:='C:\Program Files\Microsoft SQL Server\MSSQL';
  if (not m_bConnect) or (not m_bHasSystem) then begin
    Application.MessageBox(PChar('先连接服务器或未安装系统数据库！'), '警告', MB_YESNO + MB_ICONWARNING);
    exit;
  end;
  bExists := false;
  sCode := Trim(Edit3.Text);
  if sCode = '' then begin
    Application.MessageBox(PChar('请输入数据库代码！'), '警告', MB_YESNO + MB_ICONWARNING);
    exit;
  end;
//  if Trim(Edit4.Text) = '' then begin
//    Application.MessageBox(PChar('请输入数据库中文名称！'), '警告', MB_YESNO + MB_ICONWARNING);
//    exit;
//  end;
  if SetAdoQue(ADOQuery2, 'select * from tLedger where code=''' + sCode + '''', true) then begin
    if Application.MessageBox(PChar('该系统已存在这个数据库！确定要执行？'), '警告', MB_YESNO + MB_ICONWARNING) = idno then exit;
    bExists := true;
  end;
  sSQL := 'select name from sysdatabases where name=''' + Edit3.Text + '''';
  if SetAdoQue(ADOQuery1, sSQL, true) then begin
    if Application.MessageBox(PChar('该系统已存在这个数据库！确定要执行？'), '警告', MB_YESNO + MB_ICONWARNING) = idno then exit;
  end;
  if CheckBox1.Checked then begin
    if m_sBackupFile = '' then begin
      Application.MessageBox(PChar('你还没有选择备份文件!'), '警告', MB_YESNO + MB_ICONWARNING);
      exit;
    end else sBackupFile := m_sBackupFile;
  end else begin
    sBackupFile := ExtractFilePath(application.ExeName) + '\Song.bak';
  end;

//      if  Application.MessageBox(PChar('该操作将会修改数据库！确定要执行？'),'警告',MB_YESNO+MB_ICONWARNING)=idno then exit;
      {sSQL:='select * from tLedger';
      SetAdoQue(ADOQuery2,sSQL,true);
      ADOQuery2.Append;
      ADOQuery2.FieldByName('Code').AsString:=sCode;
      ADOQuery2.FieldByName('Name').AsString:=Trim(Edit4.Text);
      ADOQuery2.Post; }
//      m_sSQLPlan:='C:\Program Files\Microsoft SQL Server\MSSQL';
  try
    ADOConnection1.BeginTrans;
    sDataCode :='';
    if SetAdoQue(ADOQuery7,'RESTORE FILELISTONLY FROM DISK ='+QuotedStr(sBackupFile),True) then
    begin
      if ADOQuery7.Locate('Type','D',[]) then
      begin
        sDataCode := ADOQuery7.FieldByName('LogicalName').AsString;
      end;
      if ADOQuery7.Locate('Type','L',[]) then
      begin
        sLogCode := ADOQuery7.FieldByName('LogicalName').AsString;
      end;
    end; //if

//      sSQL:='select * from tLedger';
//      SetAdoQue(ADOQuery2,sSQL,true);

    if sDataCode<>'' then
    begin
      if bExists then ADOQuery2.Edit else ADOQuery2.Append;
      ADOQuery2.FieldByName('Code').AsString := sCode;
      ADOQuery2.FieldByName('Name').AsString := Trim(Edit4.Text);
      ADOQuery2.FieldByName('sSQLPlan').AsString := m_sSQLPlan;
      ADOQuery2.Post;
      Screen.Cursor := crHourGlass;

      sSQL := 'RESTORE DATABASE ' + Edit3.Text +
        ' FROM DISK = ''' + sBackupFile + '''' + // D:\quickbook\exe\GuamaFbas.1105'
        ' WITH MOVE '+QuotedStr(sDataCode)+' TO ''' + m_sSQLPlan + '\Data\' + sCode + '.mdf'' ,' + //     ''d:\test\xinda2.mdf'',
        ' MOVE '+QuotedStr(sLogCode)+' TO ''' + m_sSQLPlan + '\Data\' + sCode + '.ldf'', REPLACE'; //d:\test\xinda2.ldf'



      ADOConnection1.Execute(sSQL);
    end;      

    ADOConnection1.CommitTrans;
    ADOQuery3.Requery();
    ADOQuery4.Requery();
    Screen.Cursor := crDefault;
    Application.MessageBox('提交成功！', '信息', MB_OK + MB_ICONINFORMATION);
  except
    ADOConnection1.RollbackTrans;
    Application.MessageBox('提交错误，请重试。', '警告', MB_OK + MB_ICONWARNING);
  end;


end;


procedure TForm1.btCancelClick(Sender: TObject);
begin
  Close;
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  btOpen.Enabled := CheckBox1.Checked;
end;