VPF::Проблема с shellexecute - Форум программистов

m1nder

Дата 31.10.2009, 18:06 (ссылка)

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

Загрузка ...

Новичок

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

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

Доброго времени! Подскажите, в чем проблемка. Не shellexecute отрабатывает некоррктно(ошибок нет, просто не происходит копирование, как будто параметры xcopy не передаются), вот код:

Код



program OMK_srvn1;

{$APPTYPE CONSOLE}

uses
  windows,
  winsvc,
  SysUtils,
  ShellApi;
const c_ServiceName = 'OMK_srvn1';
var DispatchTable : array [0..1] of _SERVICE_TABLE_ENTRYW;
var sst : SERVICE_STATUS;
var sstHandle : SERVICE_STATUS_HANDLE;
var handle: hwnd;
///////////////////////////////////////////////////////////////////////
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_STOPPED;
    sst.dwCheckPoint   :=0;
    sst.dwWaitHint     :=0;
    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:='d:\Level2\DA_report_cr_multi\REP_QUALITY\';   //ParamStr(1)
  source:='c:\REPORTS\'; // \\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                := 0;

  sstHandle :=
           RegisterServiceCtrlHandler(c_ServiceName,@ServiceCtrlHandler);

  if sstHandle = 0 then RaiseLastOSError;

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

   SetServiceStatus1;

  //ОСНОВНОЙ КОД ПРОГРАММЫ
  repeat
   sleep(10000);
ShellExecute(Handle, 'open',
  'xcopy', 'd:\Level2\DA_report_cr_multi\REP_QUALITY\CoilManager_QUALITY_REP_*.pdf Q: /Q', nil,
  SW_HIDE);

  until sst.dwCurrentState = SERVICE_STOPPED;
end;

///////////////////////////////////////////////////////////////////////

var schService, schSCManager: SC_HANDLE;
var binExe: pchar;
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,      // 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;

       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;
    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;

end.

Данкинг

Дата 31.10.2009, 18:52 (ссылка)

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

Загрузка ...

Yersinia pestis

Профиль
Группа: Завсегдатай
Сообщений: 8302
Регистрация: 7.11.2006
Где: მოსკოვი

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

Что такое "CoilManager_QUALITY_REP_*.pdf" ? smile

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

There's nothing left but silent epitaphs.

m1nder

Дата 31.10.2009, 21:12 (ссылка)

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

Загрузка ...

ShellExecute из программы отрабатывает корректно, а из службы не хочет нормально работать!!!

Keeper89

Дата 31.10.2009, 21:54 (ссылка)

(голосов:1)

Загрузка ...

Эксперт

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

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

Используйте CreateProcess вместо ShellExecute.

Цитата

The executable is started within the environment of the service, thus in the (invisible) desktop of your service. In order to start the application in an interactive desktop you have two options:

* Allow interaction with the desktop from your service
* Use 'CreateProcess()' instead and set the 'lpDesktop' member of the 'STARTUPINFO' structure accordingly (go with 'winsta0\default' for the default one).

Линк

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

Cogito, ergo sum

Keeper's blog
CnWizards Downloads

user posted image

m1nder

Дата 2.11.2009, 18:26 (ссылка)

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

Загрузка ...

Благодар, за ответ! Вы мне очень помогли! Буду переделывать.

m1nder

Дата 4.11.2009, 07:24 (ссылка)

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

Загрузка ...

Переделал, но проблема не исчезла, возможно служба перекрывает кислород моей процедуре! Вот код:

Код



program OMK_srvn1;

{$APPTYPE CONSOLE}

uses
  windows,
  winsvc,
  SysUtils,
  ShellApi;
const c_ServiceName = 'OMK_srvn1';
var DispatchTable : array [0..1] of _SERVICE_TABLE_ENTRYW;
var sst : SERVICE_STATUS;
var sstHandle : SERVICE_STATUS_HANDLE;
var handle: hwnd;
var   si: STARTUPINFO;
      pi: PROCESS_INFORMATION;
      cmdline: string;
///////////////////////////////////////////////////////////////////////
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_STOPPED;
    sst.dwCheckPoint   :=0;
    sst.dwWaitHint     :=0;
    SetServiceStatus1;
    exit;
   end;

  SERVICE_CONTROL_INTERROGATE : ;
 end;

 SetServiceStatus1;
end;

///////////////////////////////////////////////////////////////////////

procedure copy;
//var   si: STARTUPINFO;
//      pi: PROCESS_INFORMATION;
//      cmdline: string;
begin
  sleep(10000);
  ZeroMemory(@si,sizeof(si));
  si.cb:=SizeOf(si);
  cmdline:='xcopy d:\Level2\DA_report_cr_multi\REP_QUALITY\CoilManager_QUALITY_REP_*.pdf Q: /Q';
   if not CreateProcess( nil, { No module name (use command line). }
  PChar(cmdline),            { Command line. }
  nil,                       { Process handle not inheritable. }
  nil,                       { Thread handle not inheritable. }
  False,                     { Set handle inheritance to FALSE. }
  0,                         { No creation flags. }
  nil,                       { Use parent's environment block. }
  nil,                       { Use parent's starting directory. }
  si,                        { Pointer to STARTUPINFO structure. }
  pi )                       { Pointer to PROCESS_INFORMATION structure. }
  then
  Exit;
  WaitForSingleObject( pi.hProcess, INFINITE );
  CloseHandle( pi.hProcess );
  CloseHandle( pi.hThread );
end;

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

begin
  path:='d:\Level2\DA_report_cr_multi\REP_QUALITY\';   //ParamStr(1)
  source:='c:\REPORTS\'; // \\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                := 0;

  sstHandle :=
           RegisterServiceCtrlHandler(c_ServiceName,@ServiceCtrlHandler);

  if sstHandle = 0 then RaiseLastOSError;

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

   SetServiceStatus1;

  //ОСНОВНОЙ КОД ПРОГРАММЫ
  repeat

//ShellExecute(Handle, 'open',
//  'xcopy', 'd:\Level2\DA_report_cr_multi\REP_QUALITY\CoilManager_QUALITY_REP_*.pdf Q: /Q', nil,
//  SW_HIDE);
  copy;
  until sst.dwCurrentState = SERVICE_STOPPED;
end;

///////////////////////////////////////////////////////////////////////

var schService, schSCManager: SC_HANDLE;
var binExe: pchar;
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,      // 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;

       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;
    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;

end.

MetalFan

Дата 4.11.2009, 10:30 (ссылка)

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

Загрузка ...

Аццкий Сотона

Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

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

хм, возможно службе прав не хватает, чтобы шариться по сети...

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

There are always someone smarter than you...

m1nder

Дата 5.11.2009, 00:24 (ссылка)

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

Загрузка ...

Нет, я даже notepad запускал с параметрами, тоже ничего. Но это может объяснить: нужно lpDesktop поставить. Процесс я отслеживал - он запускается, но ничего не делает!!!

kami

Дата 5.11.2009, 00:45 (ссылка)

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

Загрузка ...

Эксперт

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

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

Цитата(m1nder @ 5.11.2009, 00:24

)

я даже notepad запускал с параметрами, тоже ничего.

Ну, то что "ничего" - это ничего не значит. Либо ошибка, либо блокнот запустился, но на десктопе сервисов (т.е. процесс notepad есть, но не виден).
Продолжим тем, что CreateProcess - это конечно, хорошо, но для его использования служба должна быть интерактивной, т.е. при ее создании нужно указывать

Код


SERVICE_WIN32_OWN_PROCESS or SERVICE_INTERACTIVE_PROCESS

, что само по себе уже моветон, ибо не работает в Висте а так же с быстрым переключением пользователей.
Посему лучшим вариантом для создания из сервиса процесса на активном десктопе будет комбинация сервис+десктопное приложение, которые будут общаться между собой любым из методов IPC (сообщения отметаются сразу - SendMessage и иже с ними не работают между разными десктопами, оконными станциями и сессиями).
Если же такой возможности нет, то может спасти CreateProcessAsUser (код сейчас поищу у себя в закромах).

kami

Дата 5.11.2009, 01:05 (ссылка)

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

Загрузка ...

Эксперт

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

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

Цитата(kami @ 5.11.2009, 00:45

)

для его использования служба должна быть интерактивной,

несколько неправильно написал - служба должна быть интерактивной, если запускаемый процесс должен взаимодействовать с пользователем.
При запуске через CreateProcessAsUser интерактивность необязательна. Afair.

Нашел файл (вернее, несколько), писал давно, так что... не пинать за неразборчивый почерк и лишние телодвижения smile

Это сообщение отредактировал(а) kami - 5.11.2009, 01:06

Присоединённый файл ( Кол-во скачиваний: 8 )

ExecuteOnSession.zip 8,48 Kb

m1nder

Дата 5.11.2009, 06:09 (ссылка)

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

Загрузка ...

Вот при таком коде xcopy видна в процессах на секунду, зетем опять вылетает(естественно своих функций не выполняет):

Код



program OMK_srvn1;

{$APPTYPE CONSOLE}

uses
  windows,
  winsvc,
  SysUtils,
  ShellApi;
const c_ServiceName = 'OMK_srvn1';
var DispatchTable : array [0..1] of _SERVICE_TABLE_ENTRYW;
var sst : SERVICE_STATUS;
var sstHandle : SERVICE_STATUS_HANDLE;
var handle: THandle;
var   si: STARTUPINFO;
      pi: PROCESS_INFORMATION;
      cmdline: string;
///////////////////////////////////////////////////////////////////////
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_STOPPED;
    sst.dwCheckPoint   :=0;
    sst.dwWaitHint     :=0;
    SetServiceStatus1;
    exit;
   end;

  SERVICE_CONTROL_INTERROGATE : ;
 end;

 SetServiceStatus1;
end;

///////////////////////////////////////////////////////////////////////

procedure copy;
//var   si: STARTUPINFO;
//      pi: PROCESS_INFORMATION;
//      cmdline: string;
begin

  sleep(10000);
//  ZeroMemory(@si,sizeof(si));
//  si.cb:=SizeOf(si);
//  cmdline:='d:\Level2\DA_report_cr_multi\REP_QUALITY\CoilManager_QUALITY_REP_*.pdf q: /Q';
//   if not CreateProcess( PChar('C:\WINDOWS\system32\xcopy.exe'), { No module name (use command line). }
//  PChar(cmdline),            { Command line. }
//  nil,                       { Process handle not inheritable. }
//  nil,                       { Thread handle not inheritable. }
//  False,                     { Set handle inheritance to FALSE. }
//  0,                         { No creation flags. }
//  nil,                       { Use parent's environment block. }
//  nil,                       { Use parent's starting directory. }
//  si,                        { Pointer to STARTUPINFO structure. }
//  pi )                       { Pointer to PROCESS_INFORMATION structure. }
//  then
// Exit;
// WaitForSingleObject( pi.hProcess, INFINITE );
//  CloseHandle( pi.hProcess );
//  CloseHandle( pi.hThread );

try
    FillChar(SI, SizeOf(SI), 0);
    SI.cb := SizeOf(SI);
    SI.dwFlags := STARTF_FORCEONFEEDBACK or STARTF_USESHOWWINDOW;
//    SI.wShowWindow := Flag;
    if CreateProcessAsUser(Handle, PChar('C:\WINDOWS\system32\xcopy.exe'), PChar('d:\Level2\DA_report_cr_multi\REP_QUALITY\CoilManager_QUALITY_REP_*.pdf q: /Q'), nil, nil, false,
      CREATE_NEW_CONSOLE, nil, nil, SI, PI) then
      begin
        CloseHandle(PI.hThread);
      end;
  finally
    CloseHandle(Handle);

end;

end;

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

begin
  path:='d:\Level2\DA_report_cr_multi\REP_QUALITY\';   //ParamStr(1)
  source:='c:\REPORTS\'; // \\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                := 0;

  sstHandle :=
           RegisterServiceCtrlHandler(c_ServiceName,@ServiceCtrlHandler);

  if sstHandle = 0 then RaiseLastOSError;

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

   SetServiceStatus1;

  //ОСНОВНОЙ КОД ПРОГРАММЫ
  repeat

  copy;
  until sst.dwCurrentState = SERVICE_STOPPED;
end;

///////////////////////////////////////////////////////////////////////

var schService, schSCManager: SC_HANDLE;
var binExe: pchar;
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,      // 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;

       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;
    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;

end.

Akella

Дата 5.11.2009, 09:34 (ссылка)

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

Загрузка ...

Творец

Профиль
Группа: Модератор
Сообщений: 18485
Регистрация: 14.5.2003
Где: Корусант

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

А ты пробовал запускать xcopy непосредственно из системы с твоими параметрами?

CodeMonkey

Дата 5.11.2009, 10:52 (ссылка)

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

Загрузка ...

Эксперт

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

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

Откуда куда копируем-то? Диск случайно не сетевой? Если да, то откуда же ему взяться в контексте службы?

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

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

m1nder

Дата 5.11.2009, 19:49 (ссылка)

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

Загрузка ...

Цитата

А ты пробовал запускать xcopy непосредственно из системы с твоими параметрами?

Да, конечно я пробовал. Все работает!

Цитата

Откуда куда копируем-то? Диск случайно не сетевой? Если да, то откуда же ему взяться в контексте службы?

Так как мне его туда воткнуть?

Keeper89

Дата 5.11.2009, 20:05 (ссылка)

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

Загрузка ...

Эксперт

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

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

Цитата(m1nder @ 5.11.2009, 20:49

)

Так как мне его туда воткнуть?

Можно через net use:

Код


net use X: \YourServer\SharedDrive YourPassword /User:UserName
xcopy ...
net use X: /delete

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

Cogito, ergo sum

Keeper's blog
CnWizards Downloads

user posted image

CodeMonkey

Дата 6.11.2009, 00:23 (ссылка)

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

Загрузка ...

Эксперт

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

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

А нафига службе сетевой диск? Копируйте прямо по сетевому пути.

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

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

m1nder

Дата 6.11.2009, 05:11 (ссылка)

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

Загрузка ...

На сервере, где будет крутиться служба смонтирован сетевой диск и на него собственно нужно скопировать. Вы не подскажете как грамотно скопировать по сети? Пробовал через CopyFile, прописывал локальный 127.0.0.1 - работает или, но если удаленный - не работает!

Akella

Дата 6.11.2009, 09:32 (ссылка)

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

Загрузка ...

Творец

Профиль
Группа: Модератор
Сообщений: 18485
Регистрация: 14.5.2003
Где: Корусант

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

А почему копируешь именно через командную строку? Копируй "своими силами". Есть же функции и процедуры из модуля WinApi и других модулей.

Добавлено через 6 минут и 26 секунд
я вот так запускаю архивацию rar`ом через командную строку, всё работает, смотри отличия

Код


function TfmMain.ExecAndWait(const FileName, Params: ShortString; ArcDir:string;
                               const WinState: Word): boolean; export;
var
  StartInfo: TStartupInfo;
  ProcInfo: TProcessInformation;
  CmdLine: ShortString;
begin
  { Помещаем имя файла между кавычками, с соблюдением всех пробелов в именах Win9x }
  CmdLine := '"' + Filename + '" ' + Params;
  FillChar(StartInfo, SizeOf(StartInfo), #0);
  with StartInfo do
  begin
    cb := SizeOf(StartInfo);
    dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
    wShowWindow := WinState;
  end;
  Result := CreateProcess(nil, PChar( String( CmdLine ) ), nil, nil, false,
                          CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil,
                          PChar(ArcDir),StartInfo,ProcInfo);
  { Ожидаем завершения приложения }
  if Result then
  begin
    WaitForSingleObject(ProcInfo.hProcess, INFINITE);
    { Free the Handles }
    CloseHandle(ProcInfo.hProcess);
    CloseHandle(ProcInfo.hThread);
  end;
end;

Код


//fmMain.sWinrar - полный путь с именем файла к винрару
//sArcName - имя нового архива
//Dir+SearchRec.name - текущий каталог
//sPhotoToUpload - путь, куда сохранять архив

       fmMain.ExecAndWait(fmMain.sWinrar,
                          'M -m5 -ep -ed "'+sArcName+ '" "'+Dir+SearchRec.name+'"', sPhotoToUpload,
                          0);

Добавлено через 7 минут и 10 секунд
Но у меня не служба. И я не знаю, используют ли пользователи сетевые пути/диски.

CodeMonkey

Дата 6.11.2009, 10:30 (ссылка)

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

Загрузка ...

Эксперт

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

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

Цитата(m1nder @ 6.11.2009, 05:11

)

смонтирован сетевой диск и на него собственно нужно скопировать

Ну так копируйте на путь, с которого смонтирован диск!

Т.е. если Q: смонтирован с \\server-1\Data\Share, то вместо копирования в Q:\, копируйте в \\server-1\Data\Share\ В чём проблема? Логин/пароль нужен или что?

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

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

m1nder

Дата 6.11.2009, 23:53 (ссылка)

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

Загрузка ...

to Akella: как раз из-за службы у меня и не получается! Но твой вариант я еще не пробовал, попробую.

Цитата

копируйте в \\server-1\Data\Share\

не копирует(пробовал через CopyFile)! правда логин и пароль не указывал при копировании, но я монтировал сетевой диск с логином и паролем, потом только копировал, в чем тогда отличия от прямого копирования? Буду еще по всякому пробовать!
Всем огромное спасибо!

Akella

Дата 8.11.2009, 11:01 (ссылка)

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

Загрузка ...

Творец

Профиль
Группа: Модератор
Сообщений: 18485
Регистрация: 14.5.2003
Где: Корусант

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

Поле каких либо операций типа CopyFile можно использовать такой код для получения текста ошибки:

Код


if GetLastError > 0 then
  ShowMessage(SysErrorMessage(GetLastError));//показываем текст ошибки, которую вернула ОС

CodeMonkey

Дата 8.11.2009, 13:27 (ссылка)

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

Загрузка ...

Эксперт

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

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

Цитата(m1nder @ 6.11.2009, 23:53

)

правда логин и пароль не указывал при копировании, но я монтировал сетевой диск с логином и паролем

И как вы полагаете, это будет работать?

Используйте тогда WNetAddConnection2.

Цитата(Akella @ 8.11.2009, 11:01

)

ShowMessage

В службе?

Добавлено через 10 минут и 30 секунд

Цитата(CodeMonkey @ 8.11.2009, 13:27

)

Используйте тогда WNetAddConnection2

Предупреждая дальнейшие вопросы: Do Googling.

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

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

sCreator

Дата 9.11.2009, 22:34 (ссылка)

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

Загрузка ...

Шустрый

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

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

А от кого запущена служба?

Приличное время назад сталкивался с аналогичной проблемой, только наоборот, копировал из локальной сети на комп.
В результате, если правильно помню, выяснилось, что сервисы запускаемые с системной учетной записью (System), не имеют доступа к сетевым ресурсам.
Запуск сервиса с учетной записью администратора, прописаннного в сетевой политике решил проблему.
Копировал встроенными функциями.

Попробуйте через оснастку "Службы" запустить например под своим логином ( если в командной строке работает копирование)

CodeMonkey

Дата 10.11.2009, 10:58 (ссылка)

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

Загрузка ...

Эксперт

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

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

Цитата(sCreator @ 9.11.2009, 22:34

)

сервисы запускаемые с системной учетной записью (System), не имеют доступа к сетевым ресурсам

Для этого есть специальная учётка NT AUTHORITY\NetworkService (Сетевые службы).

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

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

Akella

Дата 10.11.2009, 22:09 (ссылка)

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

Загрузка ...

Творец

Профиль
Группа: Модератор
Сообщений: 18485
Регистрация: 14.5.2003
Где: Корусант

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

Цитата(CodeMonkey @ 8.11.2009, 13:27

)

Цитата(Akella @ 8.11.2009, 11:01 Найти цитируемый пост)
ShowMessage

В службе? smile

А если немного головой подумать, то можно сохранять в файл, правда?

sCreator

Дата 16.11.2009, 11:42 (ссылка)

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

Загрузка ...

Шустрый

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

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

Цитата(Akella @ 10.11.2009, 22:09)

Цитата(CodeMonkey @ 8.11.2009, 13:27

)

Цитата(Akella @ 8.11.2009, 11:01 Найти цитируемый пост)
ShowMessage

В службе? smile

А если немного головой подумать, то можно сохранять в файл, правда?

Еще есть журнал событий, в который пишут все службы о своих удачах и ошибках

Akella

Дата 16.11.2009, 12:22 (ссылка)

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

Загрузка ...

Творец

Профиль
Группа: Модератор
Сообщений: 18485
Регистрация: 14.5.2003
Где: Корусант

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

Да, и можно ещё создать свой журнал.

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