Не инсталлируется сервис по /install

← →
h0use (2003-10-28 17:05) [0]

Имеем вот такой юнит:

unit Service;

interface

uses
Windows, Messages, SysUtils, Classes, Controls, SvcMgr, DB, ADODB, JvLogFile,
Registry, SyncObjs, Dialogs;

type
TSimpleClient = class(TObject)
DNS,Name : String;
Permission : Byte;
ListLink : Integer;
Thread : Pointer;
end;

TBAService = class(TService)
BADBCon: TADOConnection;
. . .
procedure ServiceStart(Sender: TService; var Started: Boolean);
procedure ServiceStop(Sender: TService; var Stopped: Boolean);
procedure ServiceContinue(Sender: TService; var Continued: Boolean);
procedure ServicePause(Sender: TService; var Paused: Boolean);
procedure ServiceShutdown(Sender: TService);
procedure ServiceExecute(Sender: TService);
function ServerStart:boolean;
function ServerStop:boolean;
function BaseStart:boolean;
function BaseStop:boolean;
procedure LoadDefaults;
function LoadFromReg:boolean;
function SaveToReg:boolean;
procedure ServiceAfterInstall(Sender: TService);
. . .
private
Stream:TMemoryStream;
{ Private declarations }
public
flServerStat : Boolean;
flBaseStat : Boolean;
flViewLaunch : Boolean;
flHasChanges : Boolean;
flUserConnected : Boolean;
LogFileName : String;
BDFileName : String;
ServerIP : String;
ServerName : String;
ServerPort : String;
flByName : Boolean;
flAutostart : Boolean;
flAutoSelectLast: Boolean;
flLogNet : Boolean;
CS : TCriticalSection;
. . .
function GetServiceController: TServiceController; override;
{ Public declarations }
end;

var
BAService: TBAService;
isBaseStarted : Boolean;
implementation
Uses SrvMain;

{$R *.DFM}
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
BAService.Controller(CtrlCode);
end;

function TBAService.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
. . .
procedure TBAService.ServiceStart(Sender: TService; var Started: Boolean);
begin
flServerStat := False;
flBaseStat := False;
flViewLaunch := False;
flHasChanges := False;
flUserConnected := False;
flByName := True;
flAutostart := False;
flAutoSelectLast:= True;
flLogNet :=True;
if not assigned (CS) then CS := TCriticalSection.Create;
StartLogging;
If not LoadFromReg then LoadDefaults;
If ServerStart and BaseStart then SaveLog(1, "+ Successefully started.")
else SaveLog(1, "- Started with any errors.");
Started := True;
end;

procedure TBAService.ServiceStop(Sender: TService; var Stopped: Boolean);
var
f1,f2:Boolean;
begin
f1:=True;f2:=True;
if flBaseStat then f2:=BaseStop;
if flServerStat then f1:=ServerStop;
If f1 and f2 then SaveLog(1, "+ Successefully stopped.")
else SaveLog(1, "- Stopped with any errors.");
StopLogging;
if assigned(CS) then FreeAndNil(CS);
ServiceThread.Terminate;
Stopped := True;
end;

procedure TBAService.ServiceContinue(Sender: TService;
var Continued: Boolean);
var
f1,f2:Boolean;
begin
f1:=True;f2:=True;
if not flServerStat then f1:=ServerStart;
if not flBaseStat then f2:=BaseStart;
If f1 and f2 then SaveLog(1, "+ Successefully restarted.")
else SaveLog(1, "- Restarted with any errors.")
end;

procedure TBAService.ServicePause(Sender: TService; var Paused: Boolean);
var
f1:Boolean;
begin
f1:=True;
if flServerStat then f1:=ServerStop;
If f1 then SaveLog(1, "+ Successefully paused.")
else SaveLog(1, "- Paused with any errors.");
Paused:=True;
end;

procedure TBAService.ServiceExecute(Sender: TService);
begin
while not Terminated do
begin
if RegisterWindowMessage("TaskbarCreated")<>0 then
begin
Application.CreateForm(TfmSrvMain, fmSrvMain);
fmSrvMain.ShowModal;
end;
end;
end;
. . .

procedure TBAService.ServiceAfterInstall(Sender: TService);
begin
ShowMessage("Service installed");
end;

end.

И есть сама прога

program Server;

uses
Forms,
SrvView in "SrvView.pas" {Visual administartion form for server},
// SrvMain in "SrvMain.pas" {Main form (not visual) for hidden server operations},
Service in "Service.pas" {Build in service provider};

{$R *.res}

begin
Application.Initialize;
Application.Title := " Name ";
Application.CreateForm(TBAService, BAService);
Application.Run;
end.

При запуске server.exe /install не присходит совершенно ничего. Т.е. сервис не появляется в списке сервисов системы. В чем грабли?

PS Звпускалось с правами администратора

← →
Reindeer Moss Eater (2003-10-28 17:31) [1]

Убери ShowMessage

← →
h0use (2003-10-28 17:43) [2]

ShowMessage - это я для отладки написал. Без него тоже не работает. До него даже не доходит. И в системных евентах вообще никакх записей, как-будто программа вообще не запускается.

← →
Digitman (2003-10-28 17:58) [3]

> ShowMessage - это я для отладки написал

для отладки в событиях TBAServiceCreate и TBAServiceDestroy создавай/уничтожай свою форму и посылай ее окну нужные сообщения, если метода LogMessage() недостаточно

либо убери везде ShowMessage() и используй при крайней необходимости MessageBox()

← →
h0use (2003-10-28 18:08) [4]

Убрал я все ShowMessage только толку ноль, все равно не инсталлится.

← →
Digitman (2003-10-29 11:34) [5]

> h0use

так, милый мой, приложение Server.exe-то твое д.б. быть создано не как обычное приложение, а именно как приложение-сервис !

см. File -> New -> ServiceApplication

← →
h0use (2003-10-30 10:24) [6]

Спасибо за совет, я уже сам догадался :) Но вообще это свинство со стороны Борланда, почему они не обрабатывают добавление в проект сервисного юнита :(

← →
Digitman (2003-10-30 10:46) [7]

> Но вообще это свинство со стороны Борланда, почему они не
> обрабатывают добавление в проект сервисного юнита

глупости)

с какой стати Борланд должен что-то "обрабатывать", если он знать ничего не знает о логическом содержимом "юнита" ? И какое это имеет отношение к инсталляции сервисного приложения ? Ведь механизм инсталляции фигурирует в модуле SvcMgr, где реализован класс TServiceApplication, который, собственно, и обрабатывает ключи /INSTALL , /UNINSTALL) ... а обработать он их сможет лишь в том случае, если в списке Components[] созданного объекта TServiceApplication фигурирует хотя бы один объект-наследник TService

Не инсталлируется сервис по /install Найти похожие ветки