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

[Ky3Heu,]

Привет, программисты.. Есть вопрос. Написал прогу по конвертации определенных данных. Все хорошо и быстро работает, но есть необходимость выполнять программу в качестве службы. И вот тут возникли проблемы. Создал проект службы, впихнул код в OnExecute, откомпилил, проинсталил, но винда пишет, что моя служба остановлена, т.к. ей нечего делать. В OnStart пихал код - но тот же результат. Кто знает опишите плиз подробней правильный порядок действий (желательно с кодом), чтоб служба выполняла мой код раз в минуту и не останавливалась. Я в инете, конечно пороюсь еще, но если можете - хелп .

[3D Hunter]

не очень хорошая идея выполнять код в основном потоке службы. В событии OnStart создавайте поток, который и будет заниматься выполнением всей работы. А служба ваша останавливается менеджером служб из-за того, что SCM вовремя не получил сообщенияо состоянии службы скорей всего.
Формальный код таков:

type
  TMyThr = class(TThread)
  protected
    ...
  public
    ...
  end;

...

var
  gThr:TMyThr;

procedure Service1Start();
begin
  gThr:=TMyThr.Create(<ваши параметры конструктора>);
end;

...

procedure Service1Stop();
begin
  //если FreeOnTerminate=false
  gThr.Terminate;
  gThr.WaitFor;
  //в общем случае
  FreeAndNil(gThr);
end;

[Ky3Heu,]

Не совсем понял

gThr:=TMyThr.Create(<ваши параметры конструктора>);

но попробую разобраться.. И куда свой код впихивать???

[3D Hunter]

Вы работали с потоками? Если нет, то изучаем основы многопоточных приложений:
http://forum.vingrad.ru/forum/s/a0e9...y480344/0.html

[Ky3Heu,]

Спасибо за издевательство, конечно.. Но мне сейчас пример работающий нужен.. За ссылку отдельное спасибо.. Я от туда все равно ничего не понял...

[GunSmoker]

http://www.delphikingdom.ru/asp/view...catalogid=1348

есть необходимость выполнять программу в качестве службы

И какая я же это необходимость?

Я от туда все равно ничего не понял

Это как бы говорит, что задача тебе не по зубам. Опыта наберись, а потом к ней вернись.

[Ky3Heu,]

Необходимость есть. Прога должна на серваке вертеться и раз в минуту передавать данные, а наш админ любит серваки в логофе держать. Так что только служба. А по зубам или не по зубам - решать в данном случае мне.. Я сюда обратился за помощью, а не для обсуждения личного опыта в программировании. Ссылку обязательно гляну.

[Человек_Борща]

Выход из ситуации вам дали 2 сообщением.

Создаёте сервис, а сервис создаёт поток и управляет им.
Сам сервис ничего не делает.
На основе потока(tThread), пишите свой класс/код, и пускай себе работает себе.
К тому же сервис каждые WaitHint обязан сообщать SCM свой статус, если он этого не делает, значит сервис не работает и SCM прибьёт его.
на SCM я посылал сообщения при помощи мультимедийного таймера.
Предварительно проверяя поток(жив, мёртв, на паузе) и в зависимости от этого, манипулировал сервисом и его статусом.


Вот и всё в принципе.

[Ky3Heu,]

Вот сокращенный код приложения (весь не влазил). Напишите плиз где я лажанул и как исправить. Служба должна отрабатывать каждые 60 сек. Я еще не понимаю всех этих процессов, а запустить ПО необходимо очень срочно!!!!! Так что тупо нет времени изучать что из чего...

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,
   Generics.Collections, ShellAPI, IniFiles, DB, ADODB, xmldom, XMLIntf,
  msxmldom, XMLDoc, ExtCtrls;

type

  TState = (stNormal, stWarning, stError);

  TCodes = TDictionary<string, Double>;

  TConverter = class(TService)
    Data: TADOQuery;
    ADOConnection: TADOConnection;
    XMLInput: TXMLDocument;
    DataCodePAR: TIntegerField;
    DataPValue: TFloatField;
    DataCOLUMN1: TIntegerField;
    DataCOLUMN2: TIntegerField;
    Timer1: TTimer;

    procedure Run;
    procedure Log (State :TState; Msg :string);
    procedure ExportToXML;
    procedure ConvertDateTime;
    procedure Connect;
    procedure Timer1Timer(Sender: TObject);
    procedure ServiceStart(Sender: TService; var Started: Boolean);
    procedure ServiceStop(Sender: TService; var Stopped: Boolean);

  private
  {}
  public

    function GetServiceController: TServiceController; override;

  end;
  //-------------------------------------

  TMyThr = class(TThread)
  protected

   procedure Execute; override;

  public
    {}
  end;
//-----------------------------------------
var
  Converter: TConverter;

  gThr:TMyThr;

  Ini   :TIniFile;
  Codes :TCodes;
  FDate :string;

implementation

{$R *.DFM}

function WindowsCopyFile (FromFile, ToDir :string) : Boolean;
var F : TShFileOpStruct;
begin
 //операторы
end;

//------------------------------------
procedure TmyThr.execute;
begin
  Codes := TCodes.Create;
  Ini   := TIniFile.Create(GetCurrentDir + '\config.ini');

  With Converter do
  begin
  Connect;
  XMLInput.FileName := GetCurrentDir + '\data.xml';
  XMLInput.Active   := True;
  Timer1.Enabled := True;
  end; //With TConverter do

end;

procedure TConverter.Log (State :TState; Msg :string);
var st :string;
begin
 //операторы
  end;
end;

// Запись данных в XML-файл
procedure TConverter.ExportToXML;
var Node, NodeID :IXMLNode;
    Value :Double;
begin
//операторы
  Log(stNormal, 'Завершение процесса экспорта в XML');
  data.Close;
  WindowsCopyFile(GetCurrentDir+'\outf.xml',GetCurrentDir+'\ForSurgut.xml');
end;

// Конвертация даты/времени
procedure TConverter.ConvertDateTime;
var d, t, r :string;
begin
  //.......
  end;
end;

// Установка соединения
procedure TConverter.Connect;
begin
  //операторы
end;

// Основная процедура обработки данных
procedure Tconverter.Run;
var
  InCode  :string; // 
  ExCode  :string; // 
  Params  :TStringList;
  Values  :TStringList;

  i, code :Integer;
  value   :Double;

  function ExtractParams(str :string) :string;
  var i :Integer;
  begin
    i := 1;
    while str[i] <> '=' do Inc(i);
    Delete(str, i-1, Length(str));
    Result := str;
  end;

  function ExtractValue(str :string) :string;
  var i :Integer;
  begin
    i := 1;
    while str[i] <> '=' do Inc(i);
    Delete(str, 1, i+1);
    Result := str;
  end;

begin
  Params  := TStringList.Create;
  Values  := TStringList.Create;

  Log(stNormal, 'Начало обработки данных');

  try
  Params.LoadFromFile(GetCurrentDir+'\codes.txt');
  Values.LoadFromFile(GetCurrentDir+'\codes.txt');
//... и т.д.
    Log(stNormal, 'Завершение обработки данных');
    ExportToXML;

  except
    on E : Exception do begin
      Params.Free;
      Values.Free;
      Data.Close;
      Log(stError, 'Процесс завершился с ошибкой: ' + E.Message);
    end;
  end;
end;

//------------------------------------

procedure TConverter.ServiceStart(Sender: TService; var Started: Boolean);
begin
gThr.Create(False);
end;

procedure TConverter.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
  Data.Close;
  ADOConnection.Close;
  Ini.Free;
  Codes.Free;
  gThr.FreeOnTerminate := True;
  gThr.Terminate;
end;

procedure TConverter.Timer1Timer(Sender: TObject);
begin
Run;
end;

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

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

end.

[Ky3Heu,]

Нашел ошибку..Запустилась прога как служба и не останавливается.. Но и не отрабатывает((((