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.