Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Delphi: WinAPI и системное программирование > Создание сервиса

Автор: Гость_Павел 16.12.2005, 13:03

Здравствуйте,
необходимо написать сервис, который будет в 8 вечера лезть в базу копировать её и зачищать.
Сервисы никогда не писал, нашл пример (http://www.stikriz.narod.ru/art/services.htm), реализовал. Прописался в сервисах, но только он ничего не делает, решил сдаелать так чтобы он по тикеру выдавал сообщение. Не работает. Помогите где ошибка и где можно почитать для дальнейшей работы.

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,
  ExtCtrls;

type
  TMyService = class(TService)
    Timer1: TTimer;
    procedure ServiceStart(Sender: TService; var Started: Boolean);
    procedure ServiceStop(Sender: TService; var Stopped: Boolean);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    function GetServiceController: TServiceController; override;
    { Public declarations }
  end;

var
  MyService: TMyService;

implementation

{$R *.DFM}
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  MyService.Controller(CtrlCode);
end;
 function TMyService.GetServiceController: TServiceController;
begin
  Result:=ServiceController;
end;
 procedure TMyService.ServiceStart(Sender: TService; var Started: Boolean);
begin
 Started:=True;
 ShowMessage('555');
 Timer1.Enabled :=true;
end;
 procedure TMyService.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
 Stopped:=True;
 Timer1.Enabled :=false;
end;

procedure TMyService.Timer1Timer(Sender: TObject);
begin
  ShowMessage('555');
end;

end.

Автор: Демо 16.12.2005, 13:30

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,
  ExtCtrls;

type

  TThreadTimer=class(TThread)
  protected
    FS: TFileStream;
    procedure Execute; override;
  end;

  TTwoService = class(TService)
    procedure ServiceExecute(Sender: TService);
    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);
  private
    { Private declarations }
  public
    function GetServiceController: TServiceController; override;
    { Public declarations }
  end;

var
  TwoService: TTwoService;
  ThrTimer: TThreadTimer;

implementation

{$R *.DFM}

{TTwoService}

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

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

procedure TTwoService.ServiceExecute(Sender: TService);
begin
    while not terminated do
    begin
      ServiceThread.ProcessRequests(True);
    end;
end;
procedure TTwoService.ServiceStart(Sender: TService; var Started: Boolean);
begin
  ThrTimer := TThreadTimer.Create(True);
  ThrTimer.FreeOnTerminate := True;
  try
    ThrTimer.FS := TFileStream.Create('c:\log.tmp',fmOpenReadWrite or fmShareDenyWrite);
    Started := True;
  except
    ThrTimer.Terminate;
    Started := False;
  end;
  ThrTimer.Resume;
end;

procedure TTwoService.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
  ThrTimer.Terminate;
  Stopped := True;
end;

procedure TTwoService.ServiceContinue(Sender: TService;
  var Continued: Boolean);
begin
  ThrTimer.Resume;
  Continued := True;
end;

procedure TTwoService.ServicePause(Sender: TService; var Paused: Boolean);
begin
 ThrTimer.Suspend;
 Paused := True;
end;

{ TThreadTimer }

procedure TThreadTimer.Execute;
var
  s: String;
begin
  while not Terminated do
  begin
    try
      s := FormatDateTime('hh:nn:ss',Now)+#13#10;
      FS.Write(s[1],Length(s));
      Sleep(1000);
    except
    end;
  end;
  FS.Free;
end;


end.

Автор: puzzle 16.12.2005, 14:41

Спасибо,
но не пишит в файл. Инталировал его, запустил, статус "работает", но не записывает в файл.
(((

Автор: Демо 17.12.2005, 14:34

Цитата(puzzle @ 16.12.2005, 15:41)

но не пишит в файл

Ну так отлаживай.
Может прав нет на запись в корневой каталог. Может быть, надо при первом открытии файла указать флаг fmCreate.

Я сейчас не вспомню - давненько писал.