Home » Tutorials » Datenbanken » Firebird als Dienst installieren

Firebird als Dienst installieren

Quellcode

Hier das vollständige Programmlisting.

program instsvc;

{$APPTYPE CONSOLE}

uses
  SysUtils, WinSvc;

procedure InstallService(AServiceName, ADisplayName, AFilename, 
  AParam: string);
var SvcMgr: cardinal;
  Svc: Integer;
begin
  // Service Control Manager öffnen
  SvcMgr:=OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
  if SvcMgr > 0 then
  begin
    try
      // Service registrieren
      Svc := CreateService(SvcMgr,
      PChar(AServiceName),
      PChar(ADisplayName),
      SERVICE_ALL_ACCESS,
      16,
      SERVICE_AUTO_START,
      SERVICE_ERROR_NORMAL,
      PChar(AFilename+' '+AParam),
      nil,
      nil,
      PChar(''),
      nil,
      PChar(''));
      if Svc = 0 then
        WriteLn(Output,'Create service failed');
    finally
      // Service-Control-Manager schließen
      CloseServiceHandle(SvcMgr);
    end;
  end
  else
    WriteLn(Output,'Open service control manager failed');
end;

procedure UninstallService(AServiceName: string);
var SvcMgr: cardinal;
  Svc: integer;
begin
  // Service-Control-Manager öffnen
  SvcMgr:=OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
  if SvcMgr > 0 then
  begin
    try
      // Service öffnen
      Svc := OpenService(SvcMgr, PChar(AServiceName), SERVICE_ALL_ACCESS);
      if Svc > 0 then
      begin
        try
          // Service löschen
          if not DeleteService(Svc) then
            WriteLn(Output,'delete service failed');
        finally
          // Service schließen
          CloseServiceHandle(Svc);
        end;
      end
      else
        WriteLn(Output,'Open service failed');
    finally
      // Service-Control-Manager schließen
      CloseServiceHandle(SvcMgr);
    end;
  end
  else
    WriteLn(Output,'Open service control manager failed');
end;

function ExtractParamValue(ASwitch: string): string;
var p1, p2: integer;
  cmdline: string;
begin
  Result := '';
  cmdline := system.CmdLine;
  p1 := pos(ASwitch,cmdline);
  if p1 > 0 then
  begin
    delete(cmdline,1,p1+Length(ASwitch)+1);
    p2 := pos('"',cmdline);
    if p2 = 0 then p2 := Length(cmdline);
    result := StringReplace(copy(cmdline,1,p2),'"','',[rfReplaceAll]);
  end;
end;

var service_name: string;
  display_name: string;
  filename: string;
  param: string;

const param_invalid = 'invalid or missing parameter';

begin
  service_name := ExtractParamValue('-name');
  display_name := ExtractParamValue('-display_name');
  filename := ExtractParamValue('-filename');
  param := ExtractParamValue('-param');
  // Service registrieren
  if FindCmdLineSwitch('install',true) then
  begin
    if FileExists(filename)
      and (service_name <> '')
      and (display_name <> '')
    then
    begin
      InstallService(service_name,display_name,filename,param);
      WriteLn(Output,'Service installed');
    end
    else
      WriteLn(Output,param_invalid);
  end
  else
    // Service löschen
    if FindCmdLineSwitch('uninstall',true) then
    begin
      if (service_name <> '') then
      begin
        UninstallService(service_name);
        WriteLn(Output,'Service uninstalled');
      end
      else
        WriteLn(Output,param_invalid);
    end
    else 
      WriteLn(Output,param_invalid);
end.
EKON 28