<pre class="brush:delphi;toolbar:false">unit Unit_SvcMgr;
interface
uses
Windows,SysUtils,SvcMgr,Registry,ADODB,Classes,StrUtils,ActiveX,WinSvc,IniFiles;
type
TINIReader=class(TObject)
private
FReader:TIniFile;
FInstanceName,FInstanceData,FInstanceLog: string;
FPort: string;
FInstanceApp:string;
function GetLogName:string;
function GetAppPath: string;
public
constructor Create(const FileName:string);overload;
destructor Destroy;override;
property AppPath:string read GetAppPath;
property InstanceName:string read FInstanceName;
property InstanceApp:string read FInstanceApp;
property InstanceData:string read FInstanceData;
property InstanceLog:string read FInstanceLog;
property Port:string read FPort;
property LogName:string read GetLogName;
end;
TLsSvcCenter = class(TService)
procedure ServiceStart(Sender: TService; var Started: Boolean);
procedure ServiceStop(Sender: TService; var Stopped: Boolean);
procedure ServiceCreate(Sender: TObject);
private
FHProcess:THandle;
FInstanceName,FCommandLine:string;
{ Private declarations }
public
function GetServiceController: TServiceController; override;
{ Public declarations }
end;
const
_MDACVersion='数据访问组件版本:';
_InstanceName='数据库当前实例名:';
_ListenPort='数据服务访问端口:';
_ServiceCaption='服务信息';
_ServiceName='LsSvcCenter';
_ServiceDisplayName='Ls Service Manager';
_SectionName='ServerCnfg';
_DefaultLocalTestConnStr='Provider=SQLOLEDB.1;Persist Security Info=True;User ID=sa;Initial Catalog=master;Data Source=127.0.0.1,';
var
LsSvcCenter: TLsSvcCenter;
implementation
{$R *.DFM}
{ TINIReader }
function FileNameToLong(const AFileName: string): string;
var
Buf: PChar;
BufSize: Integer;
begin
BufSize := GetShortPathName(PChar(AFileName), nil, 0) + 1;
GetMem(Buf, BufSize);
try
GetShortPathName(PChar(AFileName), Buf, BufSize);
Result := Buf;
finally
FreeMem(Buf);
end;
end;
constructor TINIReader.Create(const FileName:string);
begin
FReader:=TIniFile.Create(FileName);
try
FInstanceApp:=FileNameToLong(AppPath+'BINN\')+'sqlservr.exe';
FInstanceData:=FileNameToLong(AppPath+'DATA\');
FInstanceLog:=FileNameToLong(AppPath+'LOG\');
FInstanceName:=FReader.ReadString(_SectionName,'InstanceName','LSSOFT');
FPort:=FReader.ReadString(_SectionName,'Port','17717');
finally
FreeAndNil(FReader);
end;
end;
destructor TINIReader.Destroy;
begin
inherited;
end;
function TINIReader.GetAppPath: string;
begin
Result:=ExtractFilePath(ParamStr(0));
end;
function TINIReader.GetLogName: string;
begin
Result:=AppPath+'LOG\Log.TXT';
end;
procedure WriteLog(S: string);
var
FHandle: THandle;
i: integer;
begin
try
FHandle := CreateFile(PChar(ExtractFilePath(ParamStr(0))+'Log.txt'), GENERIC_WRITE,
0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
if (FHandle = 0) or (FHandle = INVALID_HANDLE_VALUE) then
begin
FHandle := CreateFile(PChar(ExtractFilePath(ParamStr(0))+'Log.txt'), GENERIC_WRITE,
0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
if (FHandle = 0) or (FHandle = INVALID_HANDLE_VALUE) then
begin
Exit;
end;
end;
SetFilePointer(FHandle, 0, nil, FILE_END);
s := FormatDateTime('yyyy-mm-dd hh:nn:ss ', NOW)+s + #13#10;
WriteFile(FHandle, s[1], Length(s), LongWord(i), nil);
CloseHandle(FHandle);
except
end;
end;
function GetMDACVersion: string;
var
RegReader:TRegistry;
begin
RegReader:=TRegistry.Create;
try
RegReader.RootKey:=HKEY_LOCAL_MACHINE;
RegReader.OpenKey('SOFTWARE\Microsoft\DataAccess',False);
Result:=RegReader.ReadString('FullInstallVer');
RegReader.CloseKey;
finally
FreeAndNil(RegReader);
end;
end;
function InstallService(const ServiceName,DisplayName:string):Boolean;
var
Mgr,Svc:integer;
begin
Mgr:=OpenSCManager(nil,nil,SC_MANAGER_ALL_ACCESS);
if Mgr<>0 then
begin
Svc:=WinExec(PChar('sc create '+ServiceName+' binpath= "'+ExtractFilePath(ParamStr(0))+'LsServer.exe"'+' start= auto DisplayName= "'+DisplayName+'"'),SW_HIDE);
Result:=Svc>31;
CloseServiceHandle(Mgr);
end else Result:=False;
end;
function StopService(const ServiceName:string):Boolean;
var
Mgr, Svc: Integer;
SvcState:TServiceStatus;
begin
Result:=True;
try
Mgr:=OpenSCManager(nil,nil,SC_MANAGER_ALL_ACCESS);
if Mgr<>0 then
begin
Svc := OpenService(Mgr, PChar(ServiceName), SERVICE_ALL_ACCESS);
if Svc<>0 then
begin
if QueryServiceStatus(Svc,SvcState) then
begin
if SvcState.dwCurrentState=SERVICE_RUNNING then
ControlService(Svc,SERVICE_CONTROL_STOP,SvcState);
end;
CloseServiceHandle(Svc);
end;
CloseServiceHandle(Mgr);
end;
except on E:Exception do
begin
WriteLog(E.Message);
Result:=False;
end;
end;
end;
function _StartService(const ServiceName:string):Boolean;
var
Mgr, Svc: Integer;
SAV:PChar;
SvcState:TServiceStatus;
begin
Result:=True;
try
Mgr:=OpenSCManager(nil,nil,SC_MANAGER_ALL_ACCESS);
if Mgr<>0 then
begin
Svc := OpenService(Mgr, PChar(ServiceName), SERVICE_ALL_ACCESS);
if Svc<>0 then
begin
if QueryServiceStatus(Svc,SvcState) then
begin
if SvcState.dwCurrentState=SERVICE_STOPPED then
StartService(Svc,0,SAV);
end;
CloseServiceHandle(Svc);
end
else
begin
//如果服务不存在一直安装服务
while True do
begin
InstallService(_ServiceName,_ServiceDisplayName);
Svc := OpenService(Mgr, PChar(ServiceName), SERVICE_ALL_ACCESS);
if Svc<>0 then
begin
if QueryServiceStatus(Svc,SvcState) then
begin
if SvcState.dwCurrentState=SERVICE_STOPPED then
StartService(Svc,0,SAV);
end;
CloseServiceHandle(Svc);
Break;
end;
Sleep(2000);
end;
end;
CloseServiceHandle(Mgr);
end;
except on E:Exception do
begin
WriteLog(E.Message);
Result:=False;
end;
end;
end;
function UnInstallService(const ServiceName:string):Boolean;
var
Mgr, Svc: Integer;
SvcState:TServiceStatus;
begin
Result:=True;
try
Mgr:=OpenSCManager(nil,nil,SC_MANAGER_ALL_ACCESS);
if Mgr<>0 then
begin
Svc := OpenService(Mgr, PChar(ServiceName), SERVICE_ALL_ACCESS);
if Svc<>0 then
begin
if QueryServiceStatus(Svc,SvcState) then
begin
if SvcState.dwCurrentState=SERVICE_RUNNING then
ControlService(Svc,SERVICE_CONTROL_STOP,SvcState);
end;
DeleteService(Svc);
CloseServiceHandle(Svc);
end;
CloseServiceHandle(Mgr);
end;
except on E:Exception do
begin
WriteLog(E.Message);
Result:=False;
end;
end;
end;
function StartMSSQL(const CommandLine:string;var HProcess:THandle):Boolean;
var
PROCESSINFORMATION:_PROCESS_INFORMATION;
STARTUPINFO:TStartupInfo;
begin
FillChar(STARTUPINFO, SizeOf(STARTUPINFO), 0);
STARTUPINFO.cb := SizeOf(STARTUPINFO);
Result:=CreateProcess(
nil,
PChar(CommandLine),
nil,
nil,
True,
CREATE_NO_WINDOW,
nil,
nil,
STARTUPINFO,
PROCESSINFORMATION);
if Result then HProcess:=PROCESSINFORMATION.hProcess;
end;
function SetupServiceDescription(const SvcName,Description:string):Boolean;
var
Reg:TRegistry;
begin
Reg:=TRegistry.Create;
try
Reg.RootKey:=HKEY_LOCAL_MACHINE;
Reg.OpenKey('SYSTEM\ControlSet001\Services\'+SvcName+'\',True);
Reg.WriteString('Description',Description);
Reg.CloseKey;
Result:=True;
finally
FreeAndNil(Reg);
end;
end;
function RemoveServiceDescription(const SvcName:string):Boolean;
var
Reg:TRegistry;
begin
Reg:=TRegistry.Create;
try
Reg.RootKey:=HKEY_LOCAL_MACHINE;
Reg.OpenKey('SYSTEM\ControlSet001\Services\'+SvcName+'\',False);
Reg.DeleteValue('Description');
Reg.DeleteKey(SvcName);
Reg.CloseKey;
Result:=True;
finally
FreeAndNil(Reg);
end;
end;
function SetupRegistry(const InstanceName,Port:string):Boolean;
var
Reg:TRegistry;
Buffer:array[0..162] of Char; //ID
begin
Result:=True;
Buffer:='8022c158ae7d4cd750da034b7dc20c80e66110850d0744b9e3148563a'+
'6613a257dc2ee02c012f12d040bbad9060549ea11a714aec63d6452c5'+
'5e27d82d71307227edf7f0cf15d88d1a1e3222949d7bea02';
Reg:=TRegistry.Create;
try
Reg.RootKey:=HKEY_LOCAL_MACHINE;
Reg.OpenKey('SOFTWARE\Microsoft\Microsoft SQL Server',True);
Reg.CloseKey;
Reg.OpenKey('SOFTWARE\Microsoft\Microsoft SQL Server\'+InstanceName,True);
Reg.CloseKey;
Reg.OpenKey('SOFTWARE\Microsoft\Microsoft SQL Server\'+InstanceName+'\MSSQLServer',True);
Reg.CloseKey;
Reg.OpenKey('SOFTWARE\Microsoft\Microsoft SQL Server\'+InstanceName+'\Setup',True);//不是必需要的,进程会读取该键值
Reg.CloseKey;
Reg.OpenKey('SOFTWARE\Microsoft\Microsoft SQL Server\'+InstanceName+'\MSSQLServer\CurrentVersion',True);
Reg.WriteBinaryData('checksum',Buffer,SizeOf(Buffer));
Reg.WriteString('CurrentVersion','8.00.194');
Reg.CloseKey;
Reg.OpenKey('SOFTWARE\Microsoft\Microsoft SQL Server\'+InstanceName+'\MSSQLServer\SuperSocketNetLib',True);
Reg.CloseKey;
Reg.OpenKey('SOFTWARE\Microsoft\Microsoft SQL Server\'+InstanceName+'\MSSQLServer\SuperSocketNetLib\Np',True);
Reg.WriteString('PipeName','\\.\pipe\MSSQL$'+InstanceName+'\sql\query');
Reg.CloseKey;
Reg.OpenKey('SOFTWARE\Microsoft\Microsoft SQL Server\'+InstanceName+'\MSSQLServer\SuperSocketNetLib\Tcp',True);
Reg.WriteString('TcpDynamicPorts',Port);
Reg.WriteInteger('TcpHideFlag',0);
Reg.WriteString('TcpPort',Port);
Reg.CloseKey;
finally
FreeAndNil(Reg);
end;
end;
function LocalADOTest(const ConnStr,LogName,ServerName:string): Boolean;
var
FADOExec:TADOQuery;
FADOConnection:TADOConnection;
DBList:TStringList;
i,j:integer;
S:string;
function ExtractDBName(S:string):string;
var
Pos:integer;
begin
Pos:=LastDelimiter('.',S);
Result:=MidBStr(S,0,Pos-1);
end;
function IsFileUsing(const AName: string): Boolean;
var
HFileRes: HFILE;
begin
Result := False;
if not FileExists(AName) then Exit;
HFileRes := CreateFile(PCHAR(AName), GENERIC_READ or GENERIC_WRITE,
0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
Result := (HFileRes = INVALID_HANDLE_VALUE);
if not Result then CloseHandle(HFileRes);
end;
procedure GetDBList(StringList:TStringList;FileMask:string);
var
Dir:string;
SearchRec:TSearchRec;
begin
Dir:=ExtractFilePath(ParamStr(0))+'UDATA\';
FindFirst(Dir+FileMask,faAnyFile,SearchRec);
if not SameText(SearchRec.Name,'') then StringList.Add(SearchRec.Name);
while FindNext(SearchRec)=0 do
begin
StringList.Add(SearchRec.Name);
end;
end;
begin
try
j:=0;
DBList:=TStringList.Create;
FADOConnection:=TADOConnection.Create(nil);
FADOExec:=TADOQuery.Create(nil);
FADOConnection.LoginPrompt:=False;
FADOConnection.ConnectionString:=ConnStr;
//如果连接失败尝试连接5次
while True do
begin
Inc(j);
if (FADOConnection.Connected) or (j>5) then Break;
Sleep(1000);
try
FADOConnection.Open;
except
end;
end;
try
if not IsFileUsing(LogName) then DeleteFile(LogName);
DBList.Clear;
GetDBList(DBList,'*.MDF');
for i:=0 to DBList.Count-1 do
begin
S:=S+'INSERT INTO sysaltfiles(fileid,groupid,size,maxsize,growth,status,perf,dbid,name,filename) VALUES(1,1,128,-1,10,32770,0,'+InTToStr(i+5)+','+QuotedStr(ExtractDBName(DBList[i]))+','+QuotedStr('.\..\'+'UDATA\'+DBList[i])+')'+#13#10#13#10;
S:=S+'INSERT INTO sysaltfiles(fileid,groupid,size,maxsize,growth,status,perf,dbid,name,filename) VALUES(2,0,128,-1,10,49218,0,'+InTToStr(i+5)+','+QuotedStr(ExtractDBName(DBList[i])+'_Log')+','+QuotedStr('.\..\'+'UDATA\'+ExtractDBName(DBList[i])+'_Log.LDF')+')'+#13#10#13#10;
S:=S+'INSERT INTO sysdatabases(name,dbid,mode,status,status2,crdate,reserved,category,cmptlevel,filename) VALUES('+QuotedStr(ExtractDBName(DBList[i]))+','+InTToStr(i+5)+',0,1077936153,1090519040,GETDATE(),1900-1-1,0,80,'+QuotedStr('.\..\'+'UDATA\'+DBList[i])+')'+#13#10#13#10;
end;
FADOExec.SQL.Clear;
FADOExec.SQL.Add('USE master');
FADOExec.SQL.Add('exec sp_configure ''allow updates'',1');
FADOExec.Connection:=FADOConnection;
FADOExec.ExecSQL;
Sleep(200);
FADOExec.SQL.Clear;
FADOExec.SQL.Add('RECONFIGURE WITH OVERRIDE');
FADOExec.Connection:=FADOConnection;
FADOExec.ExecSQL;
Sleep(200);
try
FADOConnection.BeginTrans;
FADOExec.SQL.Clear;
FADOExec.SQL.Add('DELETE FROM sysdatabases WHERE name NOT IN(''master'',''model'',''msdb'',''tempdb'')');
FADOExec.SQL.Add('DELETE FROM sysaltfiles WHERE dbid>=5');
FADOExec.SQL.Add('UPDATE sysservers SET srvname='+ServerName+',datasource='+ServerName);
if not SameText(S,'') then FADOExec.SQL.Add(S);
FADOExec.Connection:=FADOConnection;
FADOExec.ExecSQL;
FADOConnection.CommitTrans;
except on E:Exception do
begin
FADOConnection.RollbackTrans;
WriteLog(E.Message);
Result:=False;
end;
end;
Sleep(200);
FADOExec.SQL.Clear;
FADOExec.SQL.Add('exec sp_configure ''allow updates'',0');
FADOExec.Connection:=FADOConnection;
FADOExec.ExecSQL;
Sleep(200);
FADOExec.SQL.Clear;
FADOExec.SQL.Add('RECONFIGURE WITH OVERRIDE');
FADOExec.Connection:=FADOConnection;
FADOExec.ExecSQL;
Result:=True;
finally
FADOExec.Close;
FADOConnection.Close;
FreeAndNil(FADOExec);
FreeAndNil(FADOConnection);
FreeAndNil(DBList);
end;
except on E:Exception do
begin
WriteLog(E.Message);
Result:=False;
end;
end;
end;
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
LsSvcCenter.Controller(CtrlCode);
end;
function TLsSvcCenter.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
procedure TLsSvcCenter.ServiceStart(Sender: TService;
var Started: Boolean);
var
FINIReader:TINIReader;
begin
FINIReader:=TINIReader.Create(ExtractFilePath(ParamStr(0))+'\Config.INI');
try
FInstanceName:=FINIReader.InstanceName;
if SetCurrentDir(ExtractFilePath(ParamStr(0))+'BINN\') then //一定要设置当前路径
begin
SetupRegistry(FINIReader.InstanceName,FINIReader.Port); //安装注册表
Sleep(1000);
FCommandLine:=FINIReader.InstanceApp+' -c -d'+FINIReader.InstanceData+'master.mdf'+' -l'
+FINIReader.InstanceData+'mastlog.ldf'+' -e'+FINIReader.InstanceLog+'Log.txt'+' -s'
+FINIReader.InstanceName+' Port='+FINIReader.Port;
StartMSSQL(FCommandLine,FHProcess); //启动服务
Sleep(6000);
//重新启动数据库
CoInitialize(nil);
LocalADOTest(_DefaultLocalTestConnStr+FINIReader.Port,FINIReader.LogName,QuotedStr('127.0.0.1'+','+FINIReader.Port));
CoUninitialize;
Started:=True;
end;
finally
//释放对象
FreeAndNil(FINIReader);
end;
end;
procedure TLsSvcCenter.ServiceStop(Sender: TService;
var Stopped: Boolean);
begin
//卸载注册表
WinExec(PChar('REG DELETE '+'"HKLM\SOFTWARE\Microsoft\Microsoft SQL Server\'+FInstanceName+'" /f'),SW_HIDE);
//停止SQLServer服务器
TerminateProcess(FHProcess,1);
//
Stopped:=True;
end;
procedure TLsSvcCenter.ServiceCreate(Sender: TObject);
var
CmdLine:string;
FINIReader:TINIReader;
begin
CmdLine:=ParamStr(1);
if CmdLine='' then Exit;
if SameText(CmdLine,'/IS') then //安装服务
begin
InstallService(_ServiceName,_ServiceDisplayName);
SetupServiceDescription(_ServiceName,'LsServer Manager Provider');
end;
if SameText(CmdLine,'/US') then //卸载服务
begin
UnInstallService(_ServiceName);
RemoveServiceDescription(_ServiceName);
end;
if SameText(CmdLine,'/SS') then //停止服务
begin
StopService(_ServiceName);
end;
if SameText(CmdLine,'/LS') then //启动服务
begin
_StartService(_ServiceName);
end;
if SameText(CmdLine,'/SI') then //服务信息
begin
FINIReader:=TINIReader.Create(ExtractFilePath(ParamStr(0))+'\Config.INI');
try
MessageBox(0,PChar(_MDACVersion+GetMDACVersion+' '+#13#10+
_InstanceName+FINIReader.InstanceName+' '+#13#10+
_ListenPort+FINIReader.Port+' '),_ServiceCaption,MB_OK+MB_ICONINFORMATION);
finally
FreeAndNil(FINIReader);
end;
end;
end;
end.</pre><p><br/></p>