Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Не инсталлируется сервис по /install [D7, Win2k, WinXP]


h0use ©   (2003-10-28 17:05:00) 

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

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 Звпускалось с правами администратора


Digitman   (2003-10-30 10:46:00) [1]


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


глупости)

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


h0use   (2003-10-30 10:24:00) [2]

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


Digitman   (2003-10-29 11:34:00) [3]


> h0use


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

см. File -> New -> ServiceApplication


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

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


Digitman   (2003-10-28 17:58:00) [5]


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


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

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


h0use   (2003-10-28 17:43:00) [6]

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


Reindeer Moss Eater   (2003-10-28 17:31:00) [7]

Убери ShowMessage


Наверх

Титульная страница Поиск, карта сайта Написать письмо