📄 main.pas
字号:
unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Registry,
Dialogs, ActnList, RzTray, ExtCtrls, DB, ImgList, ADODB, Menus, StdCtrls, ADOFuncs,
ComCtrls, RzEdit, GridsEh, DBGridEh, RzButton, Mask, RzCmboBx, RzRadChk, IniFiles,
RzTabs;
type
TMainForm = class(TForm)
Label21: TLabel;
pgcOper: TRzPageControl;
tabsService: TRzTabSheet;
Label10: TLabel;
Label11: TLabel;
lblStart: TLabel;
lblStop: TLabel;
Image1: TImage;
chkAuthNT: TRzCheckBox;
cbbSqlSericve: TRzComboBox;
chkAutoStartWithOS: TRzCheckBox;
statStat: TStatusBar;
ckbNextStartHide: TRzCheckBox;
chkAutoStart: TRzCheckBox;
edtSQLRealName: TRzEdit;
btnStart: TRzBitBtn;
btnStop: TRzBitBtn;
ckbService: TRzCheckBox;
btnRefresh: TRzBitBtn;
tabsDB: TRzTabSheet;
Splitter2: TSplitter;
Grid: TDBGridEh;
pgcDB: TRzPageControl;
tabsAssignDB: TRzTabSheet;
Label14: TLabel;
Label18: TLabel;
Label19: TLabel;
edtMDF: TRzEdit;
edtLDF: TRzEdit;
btnOpenDBFile: TRzButton;
edtDb: TRzEdit;
ckbPath: TRzCheckBox;
btnAssignDB: TRzButton;
btnNewDB: TRzButton;
tabsPass: TRzTabSheet;
Label15: TLabel;
Label16: TLabel;
Label17: TLabel;
btnEditPass: TRzButton;
edtOldPass: TRzEdit;
edtNewPass1: TRzEdit;
edtNewPass2: TRzEdit;
tabsConnStr: TRzTabSheet;
edtConnStr: TRzEdit;
btnGetConnStr: TRzButton;
tabsLog: TRzTabSheet;
redtLog: TRzRichEdit;
MainMenu: TMainMenu;
N1: TMenuItem;
pmiStart: TMenuItem;
pmiStop: TMenuItem;
pmiRefresh: TMenuItem;
N4: TMenuItem;
pmiExit: TMenuItem;
N7: TMenuItem;
pmiIsqlw: TMenuItem;
pmiProfiler: TMenuItem;
pmiManager: TMenuItem;
N33: TMenuItem;
pmiBackupSet: TMenuItem;
N9: TMenuItem;
pmTray: TPopupMenu;
piStart: TMenuItem;
piStop: TMenuItem;
N14: TMenuItem;
piExit: TMenuItem;
aqExec: TADOQuery;
ADS: TADODataSet;
ADSDSDesigner: TSmallintField;
ADSDSDesigner2: TWideStringField;
ADSDSDesigner3: TWideStringField;
ADOConn: TADOConnection;
imgAction: TImageList;
ds1: TDataSource;
OpenDlg: TOpenDialog;
imgTrayOpen: TImageList;
imgTrayClose: TImageList;
pmOperDB: TPopupMenu;
pmiSpliteDB: TMenuItem;
N19: TMenuItem;
pmiTestLinkDB: TMenuItem;
N23: TMenuItem;
pmiBackupDB: TMenuItem;
pmiRestoreDB: TMenuItem;
backup: TTimer;
Start: TTimer;
TrayIcon: TRzTrayIcon;
ActionList: TActionList;
actStart: TAction;
actStop: TAction;
actRefresh: TAction;
actIsqlw: TAction;
actProfiler: TAction;
actManager: TAction;
actExit: TAction;
actShow: TAction;
SaveDlg: TSaveDialog;
CheckStat: TTimer;
PROCEDURE FormCloseQuery(Sender:TObject; VAR CanClose:Boolean);
PROCEDURE FormClose(Sender:TObject; VAR Action:TCloseAction);
PROCEDURE FormCreate(Sender:TObject);
PROCEDURE ckbNextStartHideClick(Sender:TObject);
PROCEDURE chkAutoStartWithOSClick(Sender:TObject);
PROCEDURE chkAuthNTClick(Sender:TObject);
PROCEDURE btnAssignDBClick(Sender:TObject);
PROCEDURE btnGetConnStrClick(Sender:TObject);
PROCEDURE btnEditPassClick(Sender:TObject);
PROCEDURE pmiSpliteDBClick(Sender:TObject);
PROCEDURE btnNewDBClick(Sender:TObject);
PROCEDURE pmiBackupDBClick(Sender:TObject);
PROCEDURE pmiRestoreDBClick(Sender:TObject);
PROCEDURE chkAutoStartClick(Sender:TObject);
PROCEDURE pmiBackupSetClick(Sender:TObject);
PROCEDURE backupTimer(Sender:TObject);
PROCEDURE StartTimer(Sender:TObject);
PROCEDURE GridExit(Sender:TObject);
PROCEDURE GridEnter(Sender:TObject);
PROCEDURE actStartExecute(Sender:TObject);
PROCEDURE actStopExecute(Sender:TObject);
PROCEDURE actExitExecute(Sender:TObject);
PROCEDURE actShowExecute(Sender:TObject);
PROCEDURE btnOpenDBFileClick(Sender:TObject);
PROCEDURE ckbServiceClick(Sender:TObject);
PROCEDURE edtSQLRealNameExit(Sender:TObject);
PROCEDURE edtConnStrExit(Sender:TObject);
PROCEDURE pmiTestLinkDBClick(Sender:TObject);
PROCEDURE actIsqlwExecute(Sender:TObject);
PROCEDURE actProfilerExecute(Sender:TObject);
PROCEDURE actManagerExecute(Sender:TObject);
PROCEDURE actRefreshExecute(Sender:TObject);
PROCEDURE CheckStatTimer(Sender:TObject);
PRIVATE
{ Private declarations }
StartClickTime:TDateTime;
sSelfPath, sSQLRootPath:STRING;
sComputerName:STRING;
GridlayoutFile:STRING;
Reg:TRegistry;
bStart:Boolean;
FUNCTION CheckStat_SQL:Boolean;
PUBLIC
BackupType, EveryTime, EveryDay, EveryMonth, EveryWeek:Integer;
FUNCTION ConnectDB(DBConStr:STRING):Boolean;
PROCEDURE RegisterNewName; //注册新的SQL实例名
PROCEDURE SetButtonStat;
FUNCTION IsSysDB(ADB:STRING):Boolean;
PROCEDURE LoadMyVar;
PROCEDURE SaveMyVar;
PROCEDURE SetMyVar;
FUNCTION LoadSqlLog(AList:TStrings):Integer;
FUNCTION CheckIsStart:Boolean;
END;
VAR
MainForm:TMainForm;
IMPLEMENTATION
USES GlobalPara, RunDosThrd, UnitFrmSetupTime, xfuncs, XFunc, PublicFunction;
{$R *.dfm}
VAR MyVar:TMyVar;
FUNCTION TMainForm.ConnectDB(DBConStr:STRING):Boolean;
BEGIN
TRY
ADOConn.Connected:=False;
ADOConn.ConnectionString:=DBConStr;
ADOConn.Connected:=True;
Result:=True;
ADOConn.Connected:=False;
EXCEPT
Result:=False;
ADOConn.Connected:=False;
END;
END;
PROCEDURE TMainForm.FormCloseQuery(Sender:TObject; VAR CanClose:Boolean);
BEGIN
CanClose:=NOT bStart;
END;
PROCEDURE TMainForm.FormClose(Sender:TObject; VAR Action:TCloseAction);
BEGIN
Reg.Free;
EndProcessSA;
ExitProcess(0);
Self.SaveMyVar;
GridExit(NIL);
Action:=caFree;
END;
PROCEDURE TMainForm.FormCreate(Sender:TObject);
VAR
myreg, myreg2, myreg3:STRING;
f, m:textfile;
BEGIN
Reg:=TRegistry.Create;
pgcOper.ActivePageIndex:=0;
sSelfPath:=ExtractFilePath(ParamStr(0));
sSQLRootPath:=StringReplace(sSelfPath, 'binn\', '', [rfReplaceAll, rfIgnoreCase]);
GridlayoutFile:=sSelfPath+'GridLayout.ini';
sComputerName:=Computername;
Self.LoadMyVar;
Self.SetMyVar;
bStart:=False;
Self.SetButtonStat;
Reg.RootKey:=HKEY_LOCAL_MACHINE;
myreg:='SOFTWARE\Microsoft\Microsoft SQL Server\'+MyVar.SysDB.RealName;
myreg2:='Software\Microsoft\Windows\CurrentVersion\Run';
myreg3:='SOFTWARE\Microsoft\MSSQLServer\MSSQLServer';
Reg.OpenKey(myreg2, False);
IF (NOT Reg.KeyExists(myreg3))OR(NOT Reg.KeyExists(myreg)) THEN
BEGIN
RegisterNewName;
END;
Reg.RootKey:=HKEY_LOCAL_MACHINE;
myreg:='SOFTWARE\Microsoft\Microsoft SQL Server\'+MyVar.SysDB.RealName+'\Setup';
Reg.OpenKey(myreg, True);
Reg.WriteString('SQLDataRoot', sSQLRootPath);
Reg.WriteString('SQLPath', sSQLRootPath);
Reg.CloseKey;
myreg:='SOFTWARE\Microsoft\Microsoft SQL Server\'+MyVar.SysDB.RealName+'\MSSQLServer\SuperSocketNetLib\Tcp';
Reg.OpenKey(myreg, True);
Reg.WriteString('TcpDynamicPorts', MyVar.SysDB.port);
Reg.WriteString('TcpPort', MyVar.SysDB.port);
Reg.CloseKey;
EndProcessSA;
END;
PROCEDURE TMainForm.ckbNextStartHideClick(Sender:TObject);
BEGIN
MyVar.UserDB.NextHide:=ckbNextStartHide.Checked;
END;
PROCEDURE TMainForm.chkAutoStartWithOSClick(Sender:TObject);
BEGIN
MyVar.UserDB.Starup:=chkAutoStartWithOS.Checked;
IF MyVar.UserDB.Starup THEN
BEGIN
Reg.RootKey:=HKEY_LOCAL_MACHINE;
Reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Run', True);
IF NOT Reg.KeyExists('PM6SERVER') THEN
Reg.CreateKey('PM6SERVER');
Reg.WriteString('PM6SERVER', Application.ExeName);
Reg.CloseKey;
END
ELSE
BEGIN
Reg.RootKey:=HKEY_LOCAL_MACHINE;
Reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Run', True);
Reg.DeleteKey('PM6SERVER');
Reg.CloseKey;
END;
END;
PROCEDURE TMainForm.chkAuthNTClick(Sender:TObject);
BEGIN
MyVar.UserDB.LoginMode:=chkAuthNT.Checked;
END;
PROCEDURE TMainForm.btnAssignDBClick(Sender:TObject);
VAR
sp:STRING;
sDmdf, sDldf:STRING;
mysql:STRING;
BEGIN
sDmdf:='';
sDldf:='';
IF ckbPath.Checked THEN
BEGIN
sp:=pchar(sSQLRootPath+'MYDB\');
IF sp[length(sp)]<>'\' THEN
sp:=sp+'\';
sDmdf:=sp+ExtractFileName(edtMDF.Text);
IF NOT CopyFile(pchar(edtMDF.Text), pchar(sDmdf), True) THEN
BEGIN
ShowMessage('拷贝文件失败:'+sDmdf);
exit;
END;
IF edtLDF.Text<>'' THEN
BEGIN
sDldf:=sp+ExtractFileName(edtLDF.Text);
IF NOT CopyFile(pchar(edtLDF.Text), pchar(sDldf), True) THEN
BEGIN
ShowMessage('拷贝文件失败:'+sDldf);
exit;
END;
END;
END
ELSE
BEGIN
sDmdf:=edtMDF.Text;
sDldf:=edtLDF.Text;
END;
mysql:=format(sSingl, [edtDb.Text, sDmdf])
+#13#10+format(sDB, [edtDb.Text, sDmdf, sDldf]);
ExecSQL(aqExec, mysql);
TRY
IF Self.ckbPath.Checked THEN
BEGIN
////////////////////////
mysql:=pchar(format(' update sysaltfiles set filename=''%s'' where filename=''%s'' ',
[sSQLRootPath+'MYDB\'+ExtractFileName(edtMDF.Text), sDmdf]));
ExecSQL(aqExec, mysql);
mysql:=format(' update sysaltfiles set filename=''%s'' where filename=''%s'' ',
[sSQLRootPath+'MYDB\'+ExtractFileName(edtLDF.Text), sDldf]);
ExecSQL(aqExec, mysql);
mysql:=format('update sysdatabases set filename=''%s'' where name=''%s''',
[sSQLRootPath+'MYDB\'+ExtractFileName(edtMDF.Text), Trim(edtDb.Text)]);
ExecSQL(aqExec, mysql);
Self.ADS.Active:=False;
Self.ADS.Active:=True;
////////////////////////设为相对路径
END;
ShowMessage('附加数据库成功!');
EXCEPT
ON E:Exception DO
ShowMessage(E.Message);
END;
END;
PROCEDURE TMainForm.btnGetConnStrClick(Sender:TObject);
BEGIN
edtConnStr.Text:=MyVar.UserDB.ConnStr;
END;
PROCEDURE TMainForm.btnEditPassClick(Sender:TObject);
VAR passsql:STRING;
BEGIN
IF Trim(edtNewPass1.Text)<>Trim(edtNewPass2.Text) THEN
BEGIN
MyWarning('您输入的修改密码与确定密码不一致......');
exit;
END;
IF Trim(Self.edtOldPass.Text)='' THEN
passsql:=format('sp_password null,''%s'',''%s'' ', [Trim(Self.edtNewPass1.Text), 'SA'])
ELSE
passsql:=format('sp_password ''%s'',''%s'',''%s'' ', [Trim(Self.edtOldPass.Text),
Trim(Self.edtNewPass1.Text), 'SA']);
IF NOT MyConfirmation('真的要修改当前数据库的密码吗?'+#13#10+'本操作将可能会影响到其它和户的操作!')
THEN
exit;
TRY
Self.ADOConn.Execute(passsql);
MyInformation('修改密码成功!');
MyVar.SysDB.pass:=Trim(Self.edtNewPass1.Text);
EXCEPT
MyError('修改密码失败!');
END;
END;
PROCEDURE TMainForm.pmiSpliteDBClick(Sender:TObject);
VAR sql, s:STRING;
BEGIN
IF NOT Self.ADS.Active THEN exit;
s:=Self.ADS.FieldByName('名称').AsString;
IF (s='')OR(IsSysDB(s)) THEN exit;
IF NOT MyConfirmation('真的要分离当前数据库吗?'+#13#10
+'本操作将可能会影响到相关程序的数据!') THEN exit;
sql:=format('exec sp_detach_db ''%s'', ''true''', [s]);
Self.ADOConn.Execute(sql);
Self.ADS.Delete;
END;
FUNCTION TMainForm.CheckStat_SQL:Boolean;
VAR FDBName:STRING;
DBConStr:STRING;
s:STRING;
BEGIN
Result:=False;
IF NOT bStart THEN exit;
FDBName:='master';
IF MyVar.SysDB.RealName[length(MyVar.SysDB.RealName)]='\' THEN
s:=Copy(MyVar.SysDB.RealName, 1, length(MyVar.SysDB.RealName)-1)
ELSE
s:=MyVar.SysDB.RealName;
IF Self.chkAuthNT.Checked=True THEN
DBConStr:='Provider=SQLOLEDB.1;Integrated Security=SSPI;'+
'Persist Security Info=False;User ID=sa;Initial Catalog=master;Data Source='+s
ELSE IF MyVar.SysDB.pass='' THEN
DBConStr:='Provider=SQLOLEDB.1;Persist Security Info=False;'+
'User ID='+MyVar.SysDB.user+';Initial Catalog=master;Data Source='+s
ELSE
DBConStr:='Provider=SQLOLEDB.1;Password='+MyVar.SysDB.pass+';Persist Security Info=True;'+
'User ID='+MyVar.SysDB.user+';Initial Catalog=master;Data Source='+s;
Screen.Cursor:=crHourGlass;
TRY
Result:=ConnectDB(DBConStr);
IF Result THEN
BEGIN
ShowInfo(statStat, -1, '启动SQL Server 成功!');
redtLog.Lines.Add('连接成功!');
edtConnStr.Text:=DBConStr;
edtConnStrExit(NIL);
Self.ADS.Active:=False;
Self.ADS.Active:=True;
END
ELSE
BEGIN
redtLog.Lines.Add('连接失败!');
END;
FINALLY
Screen.Cursor:=crDefault;
END;
END;
PROCEDURE TMainForm.btnNewDBClick(Sender:TObject);
VAR datasql, mysql:STRING;
sDmdf, sDldf, sDB:STRING;
BEGIN
sDB:=Trim(edtDb.Text);
IF sDB<>'' THEN
BEGIN
TRY
Self.ADOConn.Execute('use master');
datasql:=format('create database %s ', [sDB]);
Self.ADOConn.Execute(datasql);
sDmdf:=StringReplace(LowerCase(sSelfPath), '\binn\', '\data\',
[rfReplaceAll])+sDB+'.mdf';
sDldf:=StringReplace(LowerCase(sSelfPath), '\binn\', '\data\',
[rfReplaceAll])+sDB+'_log.ldf';
IF ckbPath.Checked THEN
BEGIN
////////////////////////
mysql:=pchar(format(' update sysaltfiles set filename=''%s'' where filename=''%s'' ',
[sSQLRootPath+'data\'+sDB+'.mdf', sDmdf]));
aqExec.Close;
aqExec.sql.Text:=mysql;
aqExec.ExecSQL;
mysql:=format(' update sysaltfiles set filename=''%s'' where filename=''%s'' ',
[sSQLRootPath+'data\'+sDB+'_log.ldf', sDldf]);
aqExec.Close;
aqExec.sql.Text:=mysql;
aqExec.ExecSQL;
mysql:=format('update sysdatabases set filename=''%s'' where name=''%s''',
[sSQLRootPath+'data\'+sDB+'.mdf', sDB]);
aqExec.Close;
aqExec.sql.Text:=mysql;
aqExec.ExecSQL;
Self.ADS.Active:=False;
Self.ADS.Active:=True;
END;
////////////////////////设为相对路径
MyInformation('创建数据库成功!');
Self.ADS.Active:=False;
Self.ADS.Active:=True;
EXCEPT
MyInformation('创建数据库失败!');
END;
END;
END;
PROCEDURE TMainForm.pmiBackupDBClick(Sender:TObject);
VAR sDbName:STRING;
BEGIN
IF NOT Self.ADS.Active THEN exit;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -