checkserverunit.pas

来自「很好地delphi书籍源码」· PAS 代码 · 共 525 行 · 第 1/2 页

PAS
525
字号
unit CheckServerUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,Registry, DB, DBTables, Grids, DBGrids, ExtCtrls,
  IniFiles;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    ServerCB: TComboBox;
    CheckButton: TButton;
    Query1: TQuery;
    Database1: TDatabase;
    CreateButton: TButton;
    RestoreButton: TButton;
    WriteButton: TButton;
    Label2: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure CheckButtonClick(Sender: TObject);
    procedure RestoreButtonClick(Sender: TObject);
    procedure CreateButtonClick(Sender: TObject);
    procedure WriteButtonClick(Sender: TObject);
  private
    { Private declarations }
    procedure CreateTable;
    procedure CreateView;
    function  GetSQLServerName:string;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  function NewAlias(ServerName,DatabaseName:string):string;

implementation
var
   MyIniFiles:TInifile;
{$R *.dfm}

function NewAlias(ServerName,DatabaseName:string):string;
var
  Str:TStrings;
  Alias:string;
  N:integer;
begin
  Randomize;
  N:=Random(30000);
  Alias:='MySQL'+IntToStr(N);
  Str:=TStringList.Create;
  Str.Add('Server Name='+ServerName);
  Str.Add('Database Name='+DatabaseName);
  Str.Add('User Name=sa');
  Str.Add('Password=');
  with Session do
  begin
    ConfigMode := cmSession;
    try
     AddAlias(Alias,'MSSQL',Str);
    finally
      ConfigMode := cmAll;
    end;
  end;
  result:=Alias;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
 FileName,SName,DBName:string;
 IniFileOK:bool;
begin
  FileName:=ExtractFilePath(ParamStr(0))+'Hotel.ini';
  MyIniFiles:=TInifile.Create(FileName);
  SName:=MyIniFiles.ReadString('服务器系统','服务器名称','');
  DBName:=MyIniFiles.ReadString('服务器系统','数据库名称','');
  IniFileOK:=true;
  if (SName='')or(DBName='')or(not FileExists(FileName))then
    IniFileOK:=false;
  if IniFileOK then
  begin
    if Application.MessageBox(
      '服务器和数据库系统已经创建好,建议你退出!',
      '提示',MB_YesNo+MB_IconExclamation+MB_SystemModal)=IDYES then
       Application.Terminate;
  end else
  begin
    Caption:='检测服务器和数据库......';
    SName:=GetSQLServerName;
    if SName<>'' then  CheckButton.Visible:=true;
  end;
    ServerCB.Text:=SName ;
end;

procedure TForm1.CheckButtonClick(Sender: TObject);
begin
  with  Database1 do
  begin
    DatabaseName:='TestDatabase';
    Close;
    LoginPrompt:=False;
    DriverName:='MSSQL';
    Params.Clear;
    Params.Add('Server Name='+ServerCB.Text);
    Params.Add('Database Name=master');
    Params.Add('User Name=sa');
    Params.Add('Password=123');
    Caption:='正在尝试连接到'+ServerCB.Text+'服务器的master数据库......';
    Application.ProcessMessages;
    try
      //尝试打开数据库,如果正常打开,则说明SQL服务器工作正常,并且用户名和密码正确。
      Open;
      MyIniFiles.WriteString('服务器系统','服务器名称',ServerCB.Text);
      Caption:='连接'+ServerCB.Text+'服务器的master数据库成功!';
    except On E:Exception do
      begin
        MyIniFiles.WriteString('服务器系统','服务器名称','');
        Application.MessageBox(PChar('连接服务器的master数据库失败,'+
        #13#10#13#10+'错误信息:'+E.Message),'提示:',MB_ICONERROR);
      end;
    end;
  end;
  with Query1 do
  begin
    Close;
    DatabaseName:='TestDatabase';
    SQL.Clear;
    SQL.Add('Select * from Sysdatabases Where Name="HotelDB"');
    try
      Application.ProcessMessages;
      Open;
      if not IsEmpty then
      begin
        Caption:='找到了名为HotelDB数据库!';
        MyIniFiles.WriteString('服务器系统','数据库名称','HotelDB');
        WriteButton.Enabled:=true;
        CheckButton.Enabled:=false;
      end else
      begin
        Caption:='还没有创建HotelDB数据库系统.....';
        MyIniFiles.WriteString('服务器系统','数据库名称','');
        CreateButton.Visible:=true;
        RestoreButton.Visible:=true;
      end;
    except On E:Exception do
        Application.MessageBox(PChar('不能打开master库的Sysdatabases表,'+
        #13#10#13#10+'错误信息:'+E.Message),'提示:',MB_ICONERROR);
    end;
  end;
end;

procedure TForm1.RestoreButtonClick(Sender: TObject);
var
  FileName,BackupName:string;
begin
  //检查当前目录中是否存在还原文件HotelDB.bak
  FileName:=ExtractFilePath(ParamStr(0))+'\HotelDB.bak';
  if not FileExists(FileName) then
  begin
    ShowMessage('宾馆管理系统数据库还原文件不存在!');
    exit;
  end;
  if InputQuery('请输入备份设备','请输入备份设备',BackupName) then
  begin
    Query1.Close;
    Query1.SQL.Clear;
    Query1.SQL.Add('restore database HotelDB from '+BackupName);
    Query1.ExecSQL;
  end;
  RestoreButton.Visible:=false;
end;

procedure TForm1.CreateButtonClick(Sender: TObject);
begin
//创建HotelDB数据库
  Query1.Close;
  Query1.DatabaseName:=NewAlias(ServerCB.Text,'Master');
  Query1.SQL.Clear;
  Query1.SQL.Add('Declare @Result int');
  Query1.SQL.Add('IF EXISTS (Select * from Sysdatabases Where Name="HotelDB")');
  Query1.SQL.Add('set @Result=1 else set @Result=0');
  Query1.SQL.Add('select @Result');
  Query1.Open;
  if Query1.Fields[0].AsInteger=0  then
  begin  ////数据库系统不存在 ,创建数据库系统-------start
    Caption:='创建数据库.......';
    Application.ProcessMessages;
    Query1.Close;
    Query1.SQL.Clear;
    Query1.SQL.Add('Create Database HotelDB');
    try
      Query1.ExecSQL;
      MyIniFiles.WriteString('服务器系统','数据库名称','HotelDB');
      CreateTable;
      CreateView;
    except On E:Exception do
      begin
        MyIniFiles.WriteString('服务器系统','数据库名称','');
        Application.MessageBox(PChar('创建数据库失败!'+#13#10+'错误信息:'
                             +E.Message),'提示:',MB_ICONERROR);
      end;
    end;
  end  // 创建数据库系统-------end
  else  //数据库系统已经存在,询问是否重新创建数据库系统-----start
    if Application.MessageBox('数据库已经存在,重建会丢失所有数据,还要进行吗?',
    '程序执行确认',MB_YesNo+MB_DEFBUTTON2+MB_IconAsterisk+MB_ApplModal)<>IDYES then
       halt                          
    else
    begin  //  重新创建数据库系统---start
      Query1.Close;
      Query1.SQL.Clear;
      Query1.SQL.Add('Drop Database HotelDB');
      Query1.SQL.Add('Create Database HotelDB');
      try
        Query1.ExecSQL;
        Cursor:=crHourGlass;
        CreateTable;
        CreateView;
        Showmessage('创建数据库完毕!');
        Cursor:=crArrow;
      except On E:Exception do
        Application.MessageBox(PChar('创建数据库失败!'+#13#10+'错误信息:'
                             +E.Message),'提示:',MB_ICONERROR);
      end;
    end;   //重新创建数据库系统-----end
end;

function  TForm1.GetSQLServerName:string;
var
  Reg:TRegistry;
  Str:string;
begin
  Reg:=TRegistry.Create;
  Reg.RootKey:=HKEY_CURRENT_USER;
  Str:='\Software\MicroSoft\MicroSoft SQL Server' ;
  if not Reg.KeyExists(Str) then
  begin
    Showmessage('您的计算机上可能还没有安装SQL Server系统!');
    Application.Terminate;
  end;
  Str:=Str+'\80\Tools\SQLEW\Registered Servers X\SQL Server 组';
  if Reg.OpenKeyReadOnly(Str)then
    Reg.GetValueNames(ServerCB.Items);
  ServerCB.ItemIndex:=0;
  result:=ServerCB.Text;
end;

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

procedure TForm1.CreateTable  ;
begin
  Query1.Close;
  Query1.DatabaseName:=NewAlias(ServerCB.Text,'HotelDB');
  //------------创建用户信息表 tbUser -----------
  with  Query1 do
  begin
    SQL.Clear;
    SQL.Add('CREATE TABLE tbUser (');//创建数据表。

⌨️ 快捷键说明

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