VPF::Создание сервиса - Форум программистов

Гость_Павел

Дата 16.12.2005, 13:03 (ссылка)

(голосов: 0)

Загрузка ...

Unregistered

Здравствуйте,
необходимо написать сервис, который будет в 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 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1278
Регистрация: 3.11.2005

Репутация: 6
Всего: 50

Код


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 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 1
Регистрация: 16.12.2005

Репутация: нет
Всего: нет

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

Демо

Дата 17.12.2005, 14:34 (ссылка)

(голосов:1)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1278
Регистрация: 3.11.2005

Репутация: 6
Всего: 50

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

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

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

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

--------------------

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: WinAPI и системное программирование \| Следующая тема »