VPF::Service - Форум программистов

m1nder

Дата 17.12.2009, 13:53 (ссылка)

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

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 29
Регистрация: 23.9.2009
Где: Нижний Новгород

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

Здравствуйте! У меня следующая проблема: нужно скопировать файлы с локального диска на сетевой(он уже смонтирован). Написал приложение - все отлично работает, но как только стал переносить его в службу начались проблемы с копированием. Файлы просто не копируются. В чем может быть загвоздка? Вот исходник:

Код


program OMK_srvn1;

{$APPTYPE CONSOLE}

uses
  windows,
  winsvc,
  SysUtils;

const c_ServiceName = 'OMK_srvn1';
var DispatchTable : array [0..1] of _SERVICE_TABLE_ENTRYW;//_SERVICE_TABLE_ENTRYW;
var sst : SERVICE_STATUS;
var sstHandle : SERVICE_STATUS_HANDLE;

var schService, schSCManager: SC_HANDLE;
var binExe: pchar;
    pac: PAnsiChar;
///////////////////////////////////////////////////////////////////////
procedure SetServiceStatus1;
begin
  if not SetServiceStatus(sstHandle,sst) then
  RaiseLastOSError;
end;
///////////////////////////////////////////////////////////////////////
procedure ServiceCtrlHandler(Opcode : Cardinal);stdcall;
begin
 case Opcode of

  SERVICE_CONTROL_STOP:
   begin
    sst.dwWin32ExitCode:=0;         
    sst.dwCurrentState := SERVICE_STOP_PENDING;//; SERVICE_STOPPED
    sst.dwCheckPoint   :=0;
    sst.dwWaitHint     :=10000;
    SetServiceStatus1;
    exit;
   end;

  SERVICE_CONTROL_INTERROGATE : ;
 end;

 SetServiceStatus1;
end;

///////////////////////////////////////////////////////////////////////
procedure ServiceProc(argc : DWORD;var argv : array of PChar);stdcall;
var  F: TSearchRec;
     files,mls,path,source: string;
     Attr,intFileAge1,intFileAge2: Integer;

begin
  path:='c:\test\';   //ParamStr(1)
  source:='x:\test\'; // \\127.0.0.1\c$\

  files:='';
  Attr:= faAnyFile;
  intFileAge1:=0;
  intFileAge2:=0;

  sst.dwServiceType      := SERVICE_WIN32;
  sst.dwCurrentState     := SERVICE_START_PENDING;
  sst.dwControlsAccepted := SERVICE_ACCEPT_STOP;
//    or SERVICE_ACCEPT_PAUSE_CONTINUE;
  sst.dwWin32ExitCode           := 0;
  sst.dwServiceSpecificExitCode := 0;
  sst.dwCheckPoint              := 0;
  sst.dwWaitHint                := 10000;

  sstHandle :=
           RegisterServiceCtrlHandler(c_ServiceName,@ServiceCtrlHandler);

  if sstHandle = 0 then RaiseLastOSError;

   sst.dwCurrentState :=SERVICE_RUNNING;
   sst.dwCheckPoint   :=0;
   sst.dwWaitHint     :=10000;

   SetServiceStatus1;

  //ОСНОВНОЙ КОД ПРОГРАММЫ
  repeat
   sleep(1000);
//   sleep(90000);
//    sleep(StrToInt64(mls));
//    FindFirst(Path+'1*.*', Attr, F);
    FindFirst(Path+'*.*', Attr, F); //CoilManager_QUALITY_REP_
    if F.name <> '' then files:= F.Name;
      if intFileAge1 <> intFileAge2 then
        CopyFile(PChar(path + files),PChar(source+files),false);
//          MoveFile(PChar(path + files),PChar(source+files));
    while (FindNext(F) = 0) do
      begin
        files:=F.Name;
        intFileAge1 := sysutils.FileAge(path + files);
        intFileAge2 := sysutils.FileAge(source+files);
        if intFileAge1 <> intFileAge2 then
        CopyFile(PChar(path + files),PChar(source+files),false);
//          MoveFile(PChar(path + files),PChar(source+files));

        if sst.dwCurrentState = SERVICE_STOP_PENDING then
            SetServiceStatus1;
      end;
    FindClose(F);


  until sst.dwCurrentState = SERVICE_STOP_PENDING;
    sst.dwWin32ExitCode:=0;
    sst.dwCurrentState := SERVICE_STOPPED;
    sst.dwCheckPoint   :=0;
    sst.dwWaitHint     :=10000;
    SetServiceStatus1;

end;

procedure sService(P: Pointer); stdcall;
begin
///////////////////////////// Запуск службы
 writeln('Start thread)');
end;

///////////////////////////////////////////////////////////////////////
//var ThreadID: DWORD;
//    HThread: THandle;
begin

{ if ParamStr(1)='' then begin
   writeln('Enter parameter "/?" for help(example: OMK_srvn.exe /?)');
   exit;
 end;

 if ParamStr(1)='/?' then begin
   writeln('This program(service) move DAS files.');
   writeln('Enter parameters for starting: /i-install service | /d-delete service');
   exit;
 end;

 if (ParamStr(1)<>'/i') and (ParamStr(1)<>'/d') then begin
   writeln('Enter parameters for starting: /i-install service | /d-delete service');
   exit;
   end;

 }
 if ParamStr(1)='/i' then begin
   binExe:=pchar(ParamStr(0));
 ///////////////////////////// Установка службы

    schSCManager := OpenSCManager(
    nil,                    // local machine
    nil,                    // ServicesActive database
    SC_MANAGER_ALL_ACCESS);  // full access rights

    if schSCManager=0 then RaiseLastOSError;

    schService := CreateService(
        schSCManager,              // SCManager database
        c_ServiceName,               // name of service
        c_ServiceName,           // service name to display
        SERVICE_ALL_ACCESS,        // desired access
        SERVICE_WIN32_OWN_PROCESS, // service type
        SERVICE_DEMAND_START,//,  SERVICE_AUTO_START    // start type
        SERVICE_ERROR_NORMAL,      // error control type
        binExe,        // service's binary
        nil,                      // no load ordering group
        nil,                      // no tag identifier
        nil,                      // no dependencies
        nil,                      // LocalSystem account
        nil);                     // no password

     if schService=0 then
       RaiseLastOSError;

     if not CloseServiceHandle(schService) then
       RaiseLastOSError;

     if not CloseServiceHandle(schSCManager) then
      RaiseLastOSError;

       exit;

 ///////////////////////////// Удаление службы

   end else if ParamStr(1)='/d' then begin

    schSCManager := OpenSCManager(
    nil,                    // local machine
    nil,                    // ServicesActive database
    SC_MANAGER_ALL_ACCESS);  // full access rights

    if schSCManager=0 then RaiseLastOSError;

     schService := OpenService(
        schSCManager,       // SCManager database
        c_ServiceName,       // name of service
        SERVICE_ALL_ACCESS);            // only need DELETE access

    if schService = 0 then
      RaiseLastOSError;

    if not DeleteService(schService) then
      RaiseLastOSError;

    if not CloseServiceHandle(schService) then
      RaiseLastOSError;

    if not CloseServiceHandle(schSCManager) then
      RaiseLastOSError;
    exit;
 end;

 DispatchTable[0].lpServiceName:=c_ServiceName;
 DispatchTable[0].lpServiceProc:=@ServiceProc;
 DispatchTable[1].lpServiceName:=nil;
 DispatchTable[1].lpServiceProc:=nil;

 if not StartServiceCtrlDispatcher(DispatchTable[0]) then
   RaiseLastOSError;


//HThread := CreateThread(nil, 0, @sService,nil, 0, ThreadID);
//WaitForSingleObject(HThread,10000);
end.

VladBD

Дата 24.3.2010, 15:47 (ссылка)

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

Загрузка ...

Шустрый

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

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

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

CodeMonkey

Дата 24.3.2010, 18:44 (ссылка)

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

Загрузка ...

Эксперт

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

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

А наверное проблема в том, что смонтировали вы диски только у себя (учётка пользователя).

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

Опытный программист на C++ легко решает любые не существующие в Паскале проблемы.

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