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 + -
显示快捷键?