Форум: "Начинающим";
Текущий архив: 2006.01.29;
Скачать: [xml.tar.bz2];

Вниз

Помогите с сервисом   Найти похожие ветки 

← →
parasolka ©   (2006-01-13 12:59) [0]

Надо написать сервис, который бы запускал одну функцию из dll-ки. А именно, функция проверяет указанный каталог и удаляет папки, которые не соответствуют определенным условиям. Импорт dll - статический. Сервис писать хочу не на API, а через стандартный Service Application. Так вот, делаю все как в примере (в хелпе), только вместо ихнего кода вставляю свой (вызов моей функции). Откомпилировал, установил, запустил сервис. Ошибок ни каких, но ничего не происходит, функция не работает. Хотя тот же кусок кода, но в обычном приложении работает должным образом.
В чем дело? Заранее благодарен.

---

← →
Fay ©   (2006-01-13 13:04) [1]

parasolka ©   (13.01.06 12:59)
Ошибка в 17-й строке.

---

← →
Digitman ©   (2006-01-13 13:04) [2]

> В чем дело?


дело в ошибке в 17-й строке

---

← →
kukuikar ©   (2006-01-13 14:18) [3]

Если из [1] и [2] не понял, то ....

КОД ДАВАЙ!!!!!

---

← →
Reindeer Moss Eater ©   (2006-01-13 14:32) [4]

В чем дело?

Служба не нашла DLL.

---

← →
Rouse_ ©   (2006-01-13 15:21) [5]

> Reindeer Moss Eater ©   (13.01.06 14:32) [4]
> В чем дело?
>
> Служба не нашла DLL.

У него статическая загрузка - еслибы не нашла - она бы сразу свалилась...

---

← →
Reindeer Moss Eater ©   (2006-01-13 16:09) [6]

Сервис бы не загрузился.
Так а мы и не знаем, запустился он или нет.
Симптом похож - ничего не происходит

---

← →
Anatoly Podgoretsky ©   (2006-01-13 17:06) [7]

Гипс снимают, клиент уезжает.

---

← →
parasolka ©   (2006-01-14 14:47) [8]

Вот вам код:

unit srv;

interface

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

type
 TSRC_SRV = class(TService)
   procedure ServiceExecute(Sender: TService);
   
 private
   { Private declarations }
 public
   function GetServiceController: TServiceController; override;
   { Public declarations }
 end;

var
 SRC_SRV: TSRC_SRV;
  implementation

{$R *.DFM}

function CleanDir (dir: String): Integer; stdcall;
external "CleanArh.dll" name "CleanDir";

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

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

procedure TSRC_SRV.ServiceExecute(Sender: TService);
var
res: Integer;
begin

while not terminated do begin
 ServiceThread.ProcessRequests(True);
 res:=CleanDir("C:\VXR_SRC_KADR");
if res=-1 then
 ShowMessage("Error when deleting");
end;

end;
end.

---

← →
parasolka ©   (2006-01-16 11:01) [9]

Концепция изменилась. Теперь Сервис выглядит так:

unit main_srv;

interface

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

type
 TSRC_Service = class(TService)
   Timer1: TTimer;
   procedure Timer1Timer(Sender: TObject);
   procedure ServiceStart(Sender: TService; var Started: Boolean);
   procedure ServiceStop(Sender: TService; var Stopped: Boolean);
   procedure ServiceExecute(Sender: TService);

 private
   { Private declarations }
 public
   function GetServiceController: TServiceController; override;
   { Public declarations }
 end;
 
type
 TCleanDir = function  (dir: String): integer; stdcall;

var
 SRC_Service: TSRC_Service;
 IniFile: TIniFile;
 Path: String;
 CleanDir: TCleanDir;
 LibHandle: HModule;
 res: Integer;

implementation

{$R *.DFM}

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

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

procedure TSRC_Service.Timer1Timer(Sender: TObject);
begin
ShowMessage("Deleting now");
res:=CleanDir("C:\VXR_SRC_KADR");
if res=-1 then
   SRC_Service.Status:=csStopped;
end;

procedure TSRC_Service.ServiceStart(Sender: TService;
 var Started: Boolean);
begin
LibHandle:=LoadLibrary("CleanArh.dll");
if LibHandle<>0 then
 @CleanDir:=GetProcAddress(LibHandle, "CleanDir");
Timer1.Enabled:=True;
end;

procedure TSRC_Service.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
Timer1.Enabled:=False;
FreeLibrary(LibHandle);
end;

procedure TSRC_Service.ServiceExecute(Sender: TService);
begin
while not terminated do
begin
 ServiceThread.ProcessRequests(true);
end;
end;

end.

Все действия проиходят на OnTimer, линковка dll - динамическая. Что самое интересное, сообщение на экран выводится, а вот функция не выполняется.
Что теперь скажите?

---

← →
Fay ©   (2006-01-16 11:08) [10]

2 parasolka ©   (16.01.06 11:01) [9]
А код функции?

---

← →
Digitman ©   (2006-01-16 11:08) [11]

Вызывать ShowMessage() в контексте доп.трэда VCL-приложения не допустимо

---

← →
parasolka ©   (2006-01-16 12:18) [12]

ShowMessage я вызвал для примера, чтобы проверить что он вообще работает.

Чтобы выложить код функции, придется код всей dll класть, так как эта внешняя функция использует несколько функций внутри самой dll. Вы точно этого хотите. Хотя конечно не так уж и много, но все же.

---

← →
Fay ©   (2006-01-16 12:21) [13]

2 parasolka ©   (16.01.06 12:18) [12]
> Вы точно этого хотите
На самом деле я хочу спать. Удачи.

---

← →
parasolka ©   (2006-01-16 12:31) [14]

Не спать!!!
Вот код всей dll-ки.

library CleanArh;

uses
 Windows, Messages, SysUtils, Variants, Classes, Controls,
 Dialogs, StdCtrls, ShellApi, DateUtils, IniFiles;

    RasDial
{$R *.res}

//Вычисление свободного места в Mb

function CalcFreeSpace(DriveLetter: PAnsiChar): integer;
var
FreeAv, Total, FreeSpace: TLargeInteger;
begin
GetDiskFreeSpaceEx(DriveLetter, FreeAv, Total, @FreeSpace);
Result:=FreeSpace div 1048576;
end;

//Функция преобразования имени файла в формате yyyymdd в формат DateTime dd.mm.yyyy

function GetFileDate(fName: String): TDateTime;
var
i: integer;
y, d, m: String;
begin
 y:="";
 d:="";
 m:=fName[5];
 for i:=1 to 4 do
   y:=y+fName[i];
 d:=fName[6]+fName[7];
if (m="A") or (m="a") then m:="10";
if (m="B") or (m="b")then m:="11";
if (m="C") or (m="c")then m:="12";
try
Result:=StrToDateTime(d+"."+m+"."+y);
except
Result:=Date;
ShowMessage("Wrong filename "+fName);
end;
end;

//Функция удаления каталога со всем содержимым
function DelDir(dir: string): Boolean;
var
 fos: TSHFileOpStruct;
begin
 ZeroMemory(@fos, SizeOf(fos));
 with fos do
 begin
   wFunc  := FO_DELETE;
   fFlags := FOF_SILENT or FOF_NOCONFIRMATION;
   pFrom  := PChar(dir + #0);
 end;
 Result := (0 = ShFileOperation(fos));
end;

//Функция очистки каталогов с кадрами.
//Удаляются файлы старше MinDay (см Ini файл) дней.

function CleanDir (dir: String): integer; stdcall;
var
Sr1, Sr2, Sr3: TSearchRec;
IniFile: TIniFile;
space, days: integer;

function IsDirNotation (DirName: String): Boolean;
begin
Result:=(DirName=".") or (DirName="..");
end;

begin     //1
 IniFile:=TIniFile.Create(".\CleanArh.ini");
 days:=IniFile.ReadInteger("OPTIONS", "MinDay", 4);
 space:=IniFile.ReadInteger("OPTIONS", "MinFreeSpace", 500);

if CalcFreeSpace(PChar(ExtractFileDrive(dir)))>space then
begin     //2
 Result:=1;
 Exit;
end;      //2

if dir[Length(dir)]<>"\" then dir:=dir+"\";
if FindFirst(dir+"*", faDirectory, Sr1)=0 then
   repeat
     if ((sr1.Attr and faDirectory)=faDirectory) and not IsDirNotation(sr1.Name) then
     begin   //3
       if FindFirst(dir+sr1.Name+"\*",faDirectory,sr2)=0 then
         repeat
           if ((sr1.Attr and faDirectory)=faDirectory) and not IsDirNotation(sr2.Name) then
           begin   //4
             if FindFirst(dir+sr1.Name+"\"+sr2.Name+"\*",faDirectory,sr3)=0 then
               repeat
                 if ((sr3.Attr and faDirectory)=faDirectory) and not IsDirNotation(sr3.Name) then
                 begin   //5
                   if DaysBetween(Date, GetFileDate(sr3.Name))>days then
                     if not DelDir(dir+sr1.Name+"\"+sr2.Name+"\"+sr3.Name) then begin //6
                      ShowMessage("Error when deleting");
                      Result:=-1;
                      Exit;
                     end;   //6
                 end;     //5
                 until FindNext(sr3)<>0;
           end;    //4
         until FindNext(sr2)<>0;
       end;       //5
   until FindNext(sr1)<>0;

if CalcFreeSpace(PChar(ExtractFileDrive(dir)))>space then Result:=1
else Result:=0;

FindClose(sr1);
FindClose(sr2);
FindClose(sr3);

IniFile.Free;

end;   //1

exports
CleanDir name "CleanDir";

begin
end.

CleanDir должен запускаться в сервисе.

---

← →
Alexander Panov ©   (2006-01-16 12:45) [15]

>parasolka ©   (16.01.06 11:01) [9]

> procedure TSRC_Service.ServiceStart(Sender: TService;
>  var Started: Boolean);
> begin
> LibHandle:=LoadLibrary("CleanArh.dll");
> if LibHandle<>0 then
>  @CleanDir:=GetProcAddress(LibHandle, "CleanDir");
> Timer1.Enabled:=True;
> end;


А ты уверен, что у тебя библиотека загружена?

---

← →
parasolka ©   (2006-01-16 12:51) [16]

Думаю, что да, потому что тот же кусок кода, но в обычном приложении работает должным образом.

---

← →
Alexander Panov ©   (2006-01-16 12:54) [17]

> Думаю, что да, потому что тот же кусок кода, но в обычном
> приложении работает должным образом.


Как ты думаешь, как находит твоя программа эту DLL в обычном приложении?
А как в сервисе?

---

← →
Desdechado ©   (2006-01-16 12:54) [18]

тебе уже говорили, что взаимодействие с рабочим столом в сервисах (и DLL для них) не допускается
кстати, и неплохо бы все вызовы, могущие потенциально вывалиться на AV с показом системных сообщений, тоже в try-блок спрятать
если хочешь проверить или показать ошибку - пиши в журнал или в файл

---

← →
Игорь Шевченко ©   (2006-01-16 13:07) [19]

> тебе уже говорили, что взаимодействие с рабочим столом в
> сервисах (и DLL для них) не допускается


При установке соответствующей гайки очень даже допускается

---

← →
Digitman ©   (2006-01-16 15:10) [20]

> parasolka ©   (16.01.06 12:18) [12]
> ShowMessage я вызвал для примера, чтобы проверить что он
> вообще работает.


Еще раз повторяю - вызывать ShowMessage() чв дополнительном кодовом потоке VCL-приложения НЕДОПУСТИМО ! Хоть для примера, хоть не для примера ..

Разберись сначала с этим, а потом уже будешь маяться со своей DLL

---

Страницы: 1 вся ветка

Форум: "Начинающим";
Текущий архив: 2006.01.29;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.51 MB
Время: 0.037 c