Subject | Re: [ib-support] Re: inno setup |
---|---|
Author | Robert F. Tulloch |
Post date | 2002-02-09T13:25:54Z |
> How so? What parameters do you want to send? The script is set up to start FbExecute(gServiceFile,'/install /silent','');
> as a service automatically. What more could you want?
and:
Result:=ShellExecute(Application.Handle, NIL,
StrPCopy(PFileName, FileName),
StrPCopy(PParameters, Parameters),
StrPCopy(PWorking, Working), SW_SHOW);
Does not provide the flexibility to install IBGuard as
SERVICE_AUTO_START and
to install IBService as SERVICE_DEMAND_START for instance.
Whereas if you change it to a dll and modify the cInstall code, it
works perfectly:
//exported install service
function cInstallService(lpDisplayName, lpServiceName, lpPathName :
PChar; DesiredAccess, ServiceType, StartType, ErrorControl: DWORD) :
Integer; {cdecl;} stdcall;
var
lElapsed:Integer;
lElapsedStart:TDateTime;
hSCManager,hService:SC_Handle;
sMachine: String;
PathName: String;
begin
sMachine := '';
//Check parameters and supply defaults if required.
if DesiredAccess = 0 then
DesiredAccess:= dDesiredAccess;
if ServiceType = 0 then
ServiceType := dServiceType;
if StartType = 0 then
StartType := dStartType;
if ErrorControl = 0 then
ErrorControl := dErrorControl;
if GetWindowsVersion=WinNT then
begin
try
//Strip control characters if any from exe to check if file
exists
PathName := lpPathName;
Delete(PathName, Pos('.exe"', PathName) +4 , 20);
Delete(PathName, Pos('"', PathName), 1);
if FileExists(PathName) then
begin
// access allowed?
if ServiceAccess then
begin
// installed?
if not ServiceInstalled(lpDisplayName) then
begin
hSCManager:=OpenSCManager(PChar(sMachine),NIL,SC_MANAGER_CREATE_SERVICE);
if (hSCManager <> 0) then
begin
hService := CreateServiceA(hSCManager,
lpServiceName,
lpDisplayName,
DesiredAccess,
ServiceType,
StartType,
ErrorControl,
lpPathName,
nil,
nil,
nil,
nil,
nil);
// wait for install
lElapsedStart:=Now;
lElapsed:=0;
while (lElapsed<SERVICE_TIMEOUT) and
(not ServiceInstalled(lpDisplayName)) do
begin
lElapsed:=Trunc(Frac((Now-lElapsedStart)*1440)*60);
Sleep(1000);
end;
if (hService = 0) then
begin
if not CloseServiceHandle(hSCManager) then
begin
Result := 0;
Exit;
end
else
begin
Result := 0;
Exit;
end;
end
else
if not CloseServiceHandle(hService) then
begin
Result := 0;
Exit;
end
else
begin
if not CloseServiceHandle(hSCManager)
then
begin
Result := 0;
Exit;
end
else
end;
end
else
begin
Result := 0;
Exit;
end;
end
else
begin
Result := 0;
Exit;
end;
end
else
begin
Result := 0;
Exit;
end;
end
else
begin
Result := 0;
Exit;
end;
except
on e:exception do
begin
ShowMessage('Exception: ' + e.Message);
Result := 0;
Exit;
end;
end;
end
else
begin
Result := 0;
Exit;
end;
Result := 1;
end;
Partial Script
[UninstallRun]
FileName: {sys}\rundll32; Parameters:
"{code:ShortPath|{pf}\Borland\Interbase\bin\services.dll},cUninstallServiceA
""/DISPLAY_NAME=InterBase Guardian""
""/SERVICE_NAME=InterBaseGuardian""
""/PATH_NAME={pf}\Borland\InterBase\bin\IBGuard.exe"""
FileName: {sys}\rundll32; Parameters:
"{code:ShortPath|{pf}\Borland\Interbase\bin\services.dll},cUninstallServiceA
""/DISPLAY_NAME=InterBase Server"" ""/SERVICE_NAME=InterBaseServer""
""/PATH_NAME={pf}\Borland\InterBase\bin\IBServer.exe"""
[Code]
//Install, Start, Stop and Uninstall NT Service
// constants copied from Winsvc.pas
const
Left out of message
//Prototype Functions
function MessageBox(hWnd: Integer; lpText, lpCaption: String; uType:
Cardinal): Integer;
external 'user32.dll' name 'MessageBoxA'; stdcall;
function cInstallService(lpDisplayName,
lpServiceName,
lpPathName : String;
DesiredAccess,
ServiceType,
StartType,
ErrorControl: Cardinal): Integer;
external 'files:Services.dll' name 'cInstallService'; {cdecl;}
stdcall;
function cUninstallService(lpDisplayName,
lpServiceName,
lpPathName : String): Integer;
external 'files:Services.dll' name 'cUninstallService'; {cdecl;}
stdcall;
function cStartService(lpDisplayName,
lpServiceName,
lpPathName : String): Integer;
external 'files:Services.dll' name 'cStartService'; {cdecl;}
stdcall;
function cStopService(lpDisplayName,
lpServiceName,
lpPathName : String): Integer;
external 'files:Services.dll' name 'cStopService'; {cdecl;} stdcall;
//Functions
function ShortPath(LongName : String): String;
begin
Result:=GetShortName(LongName);
end;
procedure CurStepChanged(CurStep: Integer);
var
hWnd : integer;
DirName, GuardPathName, GuardStartName, ServerPathName : String;
DisplayName, ServiceName : String;
begin
if CurStep = csFinished then
begin
DirName := ChangeDirConst('{pf}');
GuardPathName := '"' + DirName +
'\Borland\Interbase\bin\ibguard.exe" -s';
GuardStartName := DirName +
'\Borland\Interbase\bin\ibguard.exe';
ServerPathName := '"' + DirName +
'\Borland\Interbase\bin\ibserver.exe" -s -g';
hWnd := StrToInt(ChangeDirConst('{wizardhwnd}'), 0);
DisplayName := 'InterBase Guardian';
ServiceName := 'InterBaseGuardian';
if (cInstallService(DisplayName,
ServiceName,
GuardPathName,
SERVICE_ALL_ACCESS,
SERVICE_WIN32_OWN_PROCESS or
SERVICE_INTERACTIVE_PROCESS,
SERVICE_AUTO_START,
SERVICE_ERROR_NORMAL)= 1) then
MsgBox('The setup process created the IB Guardian Service. ',
mbError,MB_OK)
else
begin
MsgBox('The setup process failed to create the IB Guardian
Service. ', mbError,MB_OK);
exit;
end;
DisplayName := 'InterBase Server';
ServiceName := 'InterBaseServer';
if (cInstallService(DisplayName,
ServiceName,
ServerPathName,
SERVICE_ALL_ACCESS,
SERVICE_WIN32_OWN_PROCESS or
SERVICE_INTERACTIVE_PROCESS,
SERVICE_DEMAND_START,
SERVICE_ERROR_NORMAL)= 1) then
MsgBox('The setup process created the IB Server Service. ',
mbInformation, MB_OK)
else
begin
MsgBox('The setup process failed to create the IB Server
Service. ', mbError,MB_OK);
exit;
end;
if (cStartService('InterBase Guardian',
'InterBaseGuardian',
GuardStartName) = 1) then
MsgBox('The setup process started the IB Guardian Service. ',
mbInformation, MB_OK)
else
begin
MsgBox('The setup process failed to start the IB Guardian
Service. ', mbError, MB_OK);
exit;
end;
end;
end;