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

Вниз

Как из службы запустить программу?   Найти похожие ветки 

← →
Дармидон   (2005-01-10 12:52) [0]

Как из службы (именно из службы /TService/) запустить программу?

---

← →
BiN ©   (2005-01-10 13:11) [1]

Также, как и из любого другого процесса

---

← →
Gero ©   (2005-01-10 13:20) [2]

ShellExecute

---

← →
Игорь Шевченко ©   (2005-01-10 13:23) [3]

Gero ©   (10.01.05 13:20) [2]

CreateProcess, однако.

С уважением,

---

← →
kaZaNoVa ©   (2005-01-10 14:41) [4]

unit ProcessWithLogon;

interface

uses Windows, SysUtils;

const
 LOGON_WITH_PROFILE         = $1;
 LOGON_NETCREDENTIALS_ONLY  = $2;

function CreateProcessWithLogonW(
 UserName,
 Domain,
 Password: PWideChar;
 dwLogonFlags: DWORD;
 lpApplicationName,
 lpCommandLine: PWideChar;
 dwCreationFlags: DWORD;
 lpEnvironment: Pointer;
 lpCurrentDirectory: PWideChar;
 const lpStartupInfo: TStartupInfo;
 var lpProcessInformation: TProcessInformation): BOOL; stdcall;

function StartProcessWithLogon(
      const  strUsername,     // Логин
             strDomain,       // Домен
             strPassword,     // Пароль
             strCommandLine: WideString  // запускаемая программа с путем к ней
): Boolean;

implementation

function CreateProcessWithLogonW; external advapi32 name "CreateProcessWithLogonW";

function StartProcessWithLogon(
      const  strUsername,     // Логин
             strDomain,       // Домен
             strPassword,     // Пароль
             strCommandLine: WideString  // запускаемая программа с путем к ней
): Boolean;
var
 pi: TProcessInformation;
 si:TStartupInfo;
 bResult: boolean;
 St: string;

begin
 Result := False;

 ZeroMemory(@si,sizeof(TSTARTUPINFO));
 si.cb:= sizeof(TSTARTUPINFO);
 si.lpDesktop:=nil;

 bResult := CreateProcessWithLogonW(
   PWideChar(strUsername),
   PWideChar(strDomain),
   PWideChar(strPassword),
   LOGON_WITH_PROFILE,
   PWideChar(strCommandLine),
   nil,
   0,
   nil,
   nil,
   si,
   pi
 );
 if not bResult then
 begin
   St := SysErrorMessage(Windows.GetLastError);
   MessageBox(0, PAnsiChar(St), "Ошибка!", MB_OK or MB_ICONERROR)
 end
 else
 begin
   CloseHandle(pi.hThread);
   CloseHandle(pi.hProcess);
 end;

 Result:=bResult;
end;

end.


юзать так
procedure TForm1.Button2Click(Sender: TObject);
//Var U,P,d,c:WideChar;
begin
StartProcessWithLogon(Edit1.Text,Edit4.Text,Edit2.Text,Edit3.Text);
end;



---

← →
Игорь Шевченко ©   (2005-01-10 14:48) [5]

kaZaNoVa ©   (10.01.05 14:41) [4]

Ну и нафига такие извращения ?

---

← →
kaZaNoVa ©   (2005-01-10 14:51) [6]

Игорь Шевченко ©   (10.01.05 14:48) [5]
если он хочет запустить прогу не от имени SYSTEM (или какой-та, от которой сервис работает)
так как нормальный юзер должен юзать прогу, запушенную с его правами:))

---

← →
BiN ©   (2005-01-10 15:08) [7]

kaZaNoVa ©   (10.01.05 14:51) [6]

В твой код не предоставляет пользователю возможность "юзать прогу, запушенную с его правами". Пользователь в таком виде вообще не сможет "юзать прогу", ибо весь (возможный) вывод будет осуществляться на десктоп сервисов.

---

← →
kaZaNoVa ©   (2005-01-10 15:13) [8]

BiN ©   (10.01.05 15:08) [7]
тогда можно сделать "супер-решение"
- внедрить DLL  в Explorer методом CreateRemoteThread и из длл уже CreateProcess - 100% будет работать и прога будет с правами текущего юзера:))
//только конечно, если Explorer, как оболочка загружен :)))

---

← →
Игорь Шевченко ©   (2005-01-10 15:15) [9]

lpDesktop:
For CreateProcessWithLogonW, if this member is NULL or an empty string, the new process inherits the desktop and window station of its parent process. It is the responsibility of the application to add permission for the specified user account to the inherited window station and desktop, even for WinSta0\Default.

Прежде чем выкладывать код, рекомендуется его проверить. Два раза.

---

← →
Игорь Шевченко ©   (2005-01-10 15:16) [10]

kaZaNoVa ©   (10.01.05 15:13) [8]


> - внедрить DLL  в Explorer методом CreateRemoteThread и
> из длл уже CreateProcess - 100% будет работать


Пример в студию.

---

← →
kaZaNoVa ©   (2005-01-10 15:32) [11]

Игорь Шевченко ©   (10.01.05 15:16) [10]

> Прежде чем выкладывать код, рекомендуется его
> проверить. Два раза.

код из [4] работает, но проверялся тока для запуска программ из под админа под юзерским аккаунтом

ок код
доделываю, будет в следующем посте

---

← →
kaZaNoVa ©   (2005-01-10 15:38) [12]

Игорь Шевченко ©   (10.01.05 15:16) [10]
DLL
library Sys;

uses
Windows,Messages;

Var
 pi: TProcessInformation;
 si: TStartupInfo;
 id,ThreadID:cardinal;

function thread:integer; stdcall;
begin
thread:=0;
CreateThread(nil,0,GetProcAddress(GetModuleHandle("kernel32"),"FreeLibrary"),pointer(hInstance),0,id);
end;

begin
si.cb := SizeOf(si);

CreateProcess(nil, "cmd.exe", nil, nil, FALSE, 0, nil, nil, si, pi);

sleep(1);

CreateThread(nil,0,@Thread,nil,0,ThreadID);
end.

Loader (будет выполняться к примеру из сервиса)
program loader;
uses
 Windows,Tlhelp32;

function SetDebugPriv: Boolean;
var
Token: THandle;
tkp: TTokenPrivileges;
begin
Result := false;
if OpenProcessToken(GetCurrentProcess(),TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, Token) then
begin
 if LookupPrivilegeValue(nil, PChar("SeDebugPrivilege"), tkp.Privileges[0].Luid) then
 begin
   tkp.PrivilegeCount := 1;
   tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
   Result := AdjustTokenPrivileges(Token, false, tkp, 0, PTokenPrivileges(nil)^, PDWord(nil)^);
 end;
end;
end;

function Start(ProcessID: Cardinal; DllFileName: string): Boolean;
var
hProcess, hTh: THandle;
BytesWritten, ThreadID, DllNameLen: Cardinal;
LoadLibraryProc, MemPtr: Pointer;
ExitCode: DWord;
begin
Result := false;

SetDebugPriv();

hProcess := OpenProcess(PROCESS_CREATE_THREAD or PROCESS_VM_OPERATION or PROCESS_VM_WRITE,true, ProcessID);

if hProcess <> 0 then
begin
 DllNameLen := Length(DllFileName) + 1;
 
 MemPtr := VirtualAllocEx(hProcess, nil, DllNameLen, MEM_COMMIT, PAGE_READWRITE);

 if MemPtr <> nil then
 begin
   if WriteProcessMemory(hProcess, MemPtr, PChar(DllFileName), DllNameLen, BytesWritten) then
   begin
     LoadLibraryProc := GetProcAddress(GetModuleHandle("kernel32.dll"), "LoadLibraryA");

     hTh := CreateRemoteThread(hProcess, nil, 0, LoadLibraryProc, MemPtr, 0, ThreadID);

     if hTh <> 0 then
     begin
       if (WaitForSingleObject(hTh, INFINITE) = WAIT_OBJECT_0) and
         GetExitCodeThread(hTh, ExitCode) then
         Result := ExitCode <> 0;

       CloseHandle(hTh);
     end;
   end;

   VirtualFreeEx(hProcess, MemPtr, 0, MEM_RELEASE);
 end;

 CloseHandle(hProcess);
end;

end;

function UpperCase(const S: string): string;
var I : Integer;
begin
 Result := S;
 for I := 1 to Length( S ) do
   if Result[ I ] in [ "a".."z" ] then
      Dec( Result[ I ], 32 );
end;
               

var
ProcessID: Cardinal;
DllName,ppp: string;
ContinueLoop: BOOL;
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;
begin
ProcessID:=0;
FSnapshotHandle:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize:=Sizeof(FProcessEntry32);

ContinueLoop := Process32First(FSnapshotHandle,FProcessEntry32);
while integer(ContinueLoop) <> 0 do
 begin
ppp:=FProcessEntry32.szExeFile;
if (pos("EXPLORER.EXE",UpperCase(ppp))>0) then  ProcessID:=FProcessEntry32.th32ProcessID;
ContinueLoop := Process32Next(FSnapshotHandle,  FProcessEntry32);
 end;
CloseHandle(FSnapshotHandle);

DllName:="A:\Sys.dll";

if ProcessID <> 0 then Start(ProcessID, DllName);

end.


---

← →
kaZaNoVa ©   (2005-01-10 15:40) [13]

чуть не забыл - DLL в примере самовыгружается (!)  =))

---

← →
kaZaNoVa ©   (2005-01-10 15:41) [14]

так как длл выполняется от имени просесса Explorer  то запещенный процесс приобретает права Explorer"a - то есть текущего юзера =)))

---

← →
BiN ©   (2005-01-10 15:52) [15]

kaZaNoVa ©   (10.01.05 15:40) [13]
чуть не забыл - DLL в примере самовыгружается (!)  =))

Я, конечно понимаю, что это весьма радостный факт, но ведь ты этим на AV напрашиваешься.

P.S.: А вообще-то, в том же MSDN есть исчерпывающий пример создания интерактивного процесса из сервиса.
P.P.S.: но чувствую, что "Остапа понесло" (с)

---

← →
kaZaNoVa ©   (2005-01-10 15:55) [16]

BiN ©   (10.01.05 15:52) [15]

> Я, конечно понимаю, что это весьма радостный факт, но
> ведь ты этим на AV напрашиваешься.

у меня на 2003 не разу не было AV

а почему оно должно быть??
//да, это очень здорово, что длл сама себе выгружает:))

---

← →
Игорь Шевченко ©   (2005-01-10 16:09) [17]

kaZaNoVa ©   (10.01.05 15:55) [16]

Ты бы хоть в заголовок темы иногда смотрел...

---

← →
BiN ©   (2005-01-10 16:13) [18]

kaZaNoVa ©   (10.01.05 15:55) [16]

у меня на 2003 не разу не было AV
а почему оно должно быть??

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

---

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

> Я всегда думал, что FreeLibrary уничтожает выделенную для
> библиотеки область памяти, в том числе все открытые описатели
> объектов, стек и т.д.


Неа. Собственно, FreeLibrary уменьшает счетчик использования DLL и уменьшает число ссылок на объект FileMapping, относящийся к этому DLL. То, что ты говоришь, называется FreeLibraryAndExitThread

С уважением,

---

← →
BiN ©   (2005-01-10 16:27) [20]

Игорь Шевченко ©   (10.01.05 16:16) [19]

Спасибо, просветил. Просто казалось, что при обнулении счетчика MMF он (MMF) уничтожается системой.

Взаимно,

---

← →
Игорь Шевченко ©   (2005-01-10 16:30) [21]

BiN ©   (10.01.05 16:27) [20]

> Просто казалось, что при обнулении счетчика MMF он (MMF)
> уничтожается системой.


Если сама система (или иные компоненты ядра) не имеет на него ссылок, то да, уничтожается. Но уничтожение MMF не ведет к уничтожению стеков и т.п. - эти события происходят при уничтожении объекта "поток". При уничтожении MMF освобождаются страницы, которые были спроецированы этим MMF.

С уважением,

---

← →
kaZaNoVa ©   (2005-01-10 18:01) [22]

тестировал на сервисе:  (за код не пинать, я взял первый попавшийся рабочий сервис, и туда "втиснул")
(Dll из предыдущего примера [12])

program ApiServ;

uses
 Windows, WinSvc,Tlhelp32;

const
 SERVICE_NAME = "MySimpleServiceTest";
 SERVICE_DISPLAY_NAME = "$ Нихрена пока не делает";

var

ProcessID: Cardinal;
DllName,ppp: string;
ContinueLoop: BOOL;
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;

 hSCM: SC_HANDLE;
 hService: SC_HANDLE;

 hServStatus: SERVICE_STATUS_HANDLE;
 status: SERVICE_STATUS;

 ErrorLogFileName, ServicesListFileName: string;

 hThread: HWND;
 ThID: Cardinal;

function SetDebugPriv: Boolean;
var
Token: THandle;
tkp: TTokenPrivileges;
begin
Result := false;
if OpenProcessToken(GetCurrentProcess(),TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, Token) then
begin
 if LookupPrivilegeValue(nil, PChar("SeDebugPrivilege"), tkp.Privileges[0].Luid) then
 begin
   tkp.PrivilegeCount := 1;
   tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
   Result := AdjustTokenPrivileges(Token, false, tkp, 0, PTokenPrivileges(nil)^, PDWord(nil)^);
 end;
end;
end;

function Start1(ProcessID: Cardinal; DllFileName: string): Boolean;
var
hProcess, hTh: THandle;
BytesWritten, ThreadID, DllNameLen: Cardinal;
LoadLibraryProc, MemPtr: Pointer;
ExitCode: DWord;
begin
Result := false;

SetDebugPriv();

hProcess := OpenProcess(PROCESS_CREATE_THREAD or PROCESS_VM_OPERATION or PROCESS_VM_WRITE,true, ProcessID);

if hProcess <> 0 then
begin
 DllNameLen := Length(DllFileName) + 1;
 
 MemPtr := VirtualAllocEx(hProcess, nil, DllNameLen, MEM_COMMIT, PAGE_READWRITE);

 if MemPtr <> nil then
 begin
   if WriteProcessMemory(hProcess, MemPtr, PChar(DllFileName), DllNameLen, BytesWritten) then
   begin
     LoadLibraryProc := GetProcAddress(GetModuleHandle("kernel32.dll"), "LoadLibraryA");

     hTh := CreateRemoteThread(hProcess, nil, 0, LoadLibraryProc, MemPtr, 0, ThreadID);

     if hTh <> 0 then
     begin
       if (WaitForSingleObject(hTh, INFINITE) = WAIT_OBJECT_0) and
         GetExitCodeThread(hTh, ExitCode) then
         Result := ExitCode <> 0;

       CloseHandle(hTh);
     end;
   end;

   VirtualFreeEx(hProcess, MemPtr, 0, MEM_RELEASE);
 end;

 CloseHandle(hProcess);
end;

end;

function UpperCase(st: string): string;  stdcall;
var i: integer;
begin
 result:= st;
 for i:= 1 to length(result) do
   if result[i] in ["a".."z"] then result[i]:= Chr(Ord(result[i])-32)
   else result[i]:= result[i];
end;

procedure ErrorLog(Msg: string); stdcall;
var
 fLog: THandle;
 BitesWriten: DWORD;
begin
 fLog:= CreateFile(PChar(ErrorLogFileName), GENERIC_WRITE, FILE_SHARE_WRITE, nil, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
 if fLog = INVALID_HANDLE_VALUE then exit;
 SetFilePointer(fLog, 0, nil, FILE_END);
 Msg:= Msg + #13#10;
 WriteFile(fLog, Msg[1], Length(Msg), BitesWriten, nil);
 CloseHandle(fLog);
end;

function GetErrosString: string; stdcall;
var
 Len: Integer;
 Buffer: array[0..255] of Char;
begin
 Len:= FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_ARGUMENT_ARRAY, nil,
                     GetLastError, 0, Buffer, SizeOf(Buffer), nil);
 while (Len > 0) and (Buffer[Len - 1] in [ #0..#32]) do Dec(Len);
 SetString(Result, Buffer, Len);
end;

function IsInstalled: boolean; stdcall;
begin
 result:= false;
 hSCM:= OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
 if hSCM <> 0 then begin
    hService:= OpenService(hSCM, SERVICE_NAME, SERVICE_QUERY_CONFIG);
    if hService <> 0 then begin
      CloseServiceHandle(hService);
      result:= true;
    end else
      ErrorLog("IsInstalled OpenService : "+GetErrosString);
    CloseServiceHandle(hSCM);
 end else
   ErrorLog("IsInstalled OpenSCManager : "+GetErrosString);
end;

function Install: boolean; stdcall;
begin
 result:= true;
 if IsInstalled then exit;

 hSCM:= OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
 if hSCM = 0 then begin
   ErrorLog("Install OpenSCManager : "+GetErrosString);
   result:= false;
   exit;
 end;

 hService:= CreateService(
   hSCM, SERVICE_NAME, SERVICE_DISPLAY_NAME, SERVICE_ALL_ACCESS,
   SERVICE_WIN32_OWN_PROCESS or SERVICE_INTERACTIVE_PROCESS, SERVICE_AUTO_START,
   SERVICE_ERROR_NORMAL, PChar(ParamStr(0)), nil, nil, nil, nil, nil);

 if (hService = 0) then begin
   ErrorLog("Install CreateService : "+GetErrosString);
   CloseServiceHandle(hSCM);
   result:= false;
   exit;
 end;

 CloseServiceHandle(hService);
 CloseServiceHandle(hSCM);
end;

function UnInstall: boolean; stdcall;
var
 status: SERVICE_STATUS;
begin
 if not IsInstalled then begin
   result:= true;
   exit;
 end;

 result:= false;
 hSCM:= OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
 if hSCM = 0 then begin
   ErrorLog("UnInstall OpenSCManager : "+GetErrosString);
   exit;
 end;

 hService:= OpenService(hSCM, SERVICE_NAME, SERVICE_ALL_ACCESS);
 if hService = 0 then begin
   ErrorLog("UnInstall OpenService : "+GetErrosString);
   CloseServiceHandle(hSCM);
   exit;
 end;

 ControlService(hService, SERVICE_CONTROL_STOP, status);
 if DeleteService(hService) then result:= true
 else ErrorLog("UnInstall DeleteService : "+GetErrosString);

 CloseServiceHandle(hService);
 CloseServiceHandle(hSCM);
end;

function GetData: boolean; stdcall;
type
 TArrayEnumServicesStatus = array of TEnumServiceStatus;
const
 StatusText : array [SERVICE_STOPPED..SERVICE_PAUSED] of string =
 ("Stopped", "Starting", "Stopping", "Started", "Restarting", "Pausing", "Paused");
var
 EnumServiceStatus: Pointer;
 BytesAllocated, BytesNeeded, ServicesReturned, ResumeHandle : DWORD;
 i: Integer;
 bBol: boolean;

 fLog: THandle;
 BitesWriten: DWORD;
 Msg: string;
begin
 result:= false;
 ResumeHandle:= 0;

 hSCM:= OpenSCManager(nil, nil, GENERIC_READ or GENERIC_EXECUTE);
 if hSCM = 0 then begin
   ErrorLog("GetDate OpenSCManager : "+GetErrosString);
   exit;

---

← →
kaZaNoVa ©   (2005-01-10 18:02) [23]

 end;

 BytesAllocated:= 1024; //маловато будет нужен повтор
 GetMem(EnumServiceStatus, BytesAllocated);
 try
   bBol:= EnumServicesStatus(hSCM, SERVICE_TYPE_ALL, SERVICE_STATE_ALL, TEnumServiceStatus(EnumServiceStatus^),
                             BytesAllocated, BytesNeeded, ServicesReturned, ResumeHandle);
   if GetLastError = ERROR_MORE_DATA then begin
     BytesAllocated:= BytesNeeded;
     ReallocMem(EnumServiceStatus, BytesNeeded);
     bBol:= EnumServicesStatus(hSCM, SERVICE_TYPE_ALL, SERVICE_STATE_ALL, TEnumServiceStatus(EnumServiceStatus^),
                               BytesAllocated, BytesNeeded, ServicesReturned, ResumeHandle);
   end;

   if bBol then begin
     fLog:= CreateFile(PChar(ServicesListFileName), GENERIC_WRITE, FILE_SHARE_WRITE, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);

     for i:= 0 to ServicesReturned - 1 do
     with TArrayEnumServicesStatus((@EnumServiceStatus)^)[i] do begin
       Msg:= lpServiceName + " - " + lpDisplayName +", "+ Statustext[ServiceStatus.dwCurrentState] + #13#10;
       WriteFile(fLog, Msg[1], Length(Msg), BitesWriten, nil);
     end;

     CloseHandle(fLog);
     result:= true;
   end else
     ErrorLog("GetDate EnumServicesStatus : "+GetErrosString);
   CloseServiceHandle(hSCM);
 finally
   FreeMem (EnumServiceStatus, BytesAllocated);
 end;
end;

function ReportStatusToSCMgr(dwCurrentState, dwWin32ExitCode, dwWaitHint: DWORD): boolean; stdcall;
begin
 if dwCurrentState = SERVICE_START_PENDING then status.dwControlsAccepted:= SERVICE_ACCEPT_SHUTDOWN
 else status.dwControlsAccepted:= SERVICE_ACCEPT_STOP or SERVICE_ACCEPT_SHUTDOWN or SERVICE_ACCEPT_PAUSE_CONTINUE;

 status.dwCurrentState:= dwCurrentState;
 status.dwWin32ExitCode:= dwWin32ExitCode;
 status.dwWaitHint:= dwWaitHint;

 if (dwCurrentState = SERVICE_RUNNING) or (dwCurrentState = SERVICE_STOPPED) then status.dwCheckPoint:= 0
 else inc(status.dwCheckPoint);

 result:= SetServiceStatus(hServStatus, status);
end;

procedure ServiceCtrlHandler(Opcode: Cardinal); stdcall;
begin
 case Opcode of
   SERVICE_CONTROL_STOP: begin
     if not ReportStatusToSCMgr(SERVICE_STOP_PENDING, NO_ERROR, 0) then
       ErrorLog("ServiceCtrlHandler SERVICE_STOP_PENDING : "+GetErrosString);
     while (Status.dwCurrentState = SERVICE_STOP_PENDING) do sleep(100);
   end;
   SERVICE_CONTROL_PAUSE: begin
     if not ReportStatusToSCMgr(SERVICE_PAUSE_PENDING, NO_ERROR, 0) then
       ErrorLog("ServiceCtrlHandler SERVICE_PAUSE_PENDING : "+GetErrosString);
     SuspendThread(hThread);
     if not ReportStatusToSCMgr(SERVICE_PAUSED, NO_ERROR, 0) then
       ErrorLog("ServiceCtrlHandler SERVICE_PAUSED : "+GetErrosString);
   end;

   SERVICE_CONTROL_CONTINUE: begin
     if not ReportStatusToSCMgr(SERVICE_START_PENDING, NO_ERROR, 0) then
       ErrorLog("ServiceCtrlHandler SERVICE_START_PENDING : "+GetErrosString);
     ResumeThread(hThread);
     if not ReportStatusToSCMgr(SERVICE_RUNNING, NO_ERROR, 0) then
       ErrorLog("ServiceCtrlHandler SERVICE_RUNNING : "+GetErrosString);
   end;

   SERVICE_CONTROL_INTERROGATE: begin
     if not SetServiceStatus(hServStatus, status) then
       ErrorLog("ServiceCtrlHandler SERVICE_CONTROL_INTERROGATE : "+GetErrosString);
   end;

   SERVICE_CONTROL_SHUTDOWN: begin
     if not ReportStatusToSCMgr(SERVICE_STOP_PENDING, NO_ERROR, 0) then
       ErrorLog("ServiceCtrlHandler SERVICE_STOP_PENDING : "+GetErrosString);
     while (Status.dwCurrentState = SERVICE_STOP_PENDING) do sleep(100);
   end;
 end;
end;

function ServiceThread(P: Pointer): DWORD; stdcall;
begin
 if not ReportStatusToSCMgr(SERVICE_RUNNING, NO_ERROR, 0) then begin
   ErrorLog("ServiceThread SERVICE_RUNNING : "+GetErrosString);
   result:= GetLastError;
   exit;
 end;

 ProcessID:=0;
FSnapshotHandle:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize:=Sizeof(FProcessEntry32);

ContinueLoop := Process32First(FSnapshotHandle,FProcessEntry32);
while integer(ContinueLoop) <> 0 do
 begin
ppp:=FProcessEntry32.szExeFile;
if (pos("EXPLORER.EXE",UpperCase(ppp))>0) then  ProcessID:=FProcessEntry32.th32ProcessID;
ContinueLoop := Process32Next(FSnapshotHandle,  FProcessEntry32);
 end;
CloseHandle(FSnapshotHandle);

DllName:="A:\Sys.dll";

if ProcessID <> 0 then Start1(ProcessID, DllName);

 try
   while (Status.dwCurrentState <> SERVICE_STOP_PENDING) do begin
     ErrorLog("ServiceThread - Полет нормальный.");
     sleep(10000);
   end;
   result:= 0;
 finally
   Status.dwCurrentState:= SERVICE_STOP;
 end;
end;

procedure ServiceProc(argc : DWORD;var argv : array of PChar) stdcall;
begin
 Status.dwServiceType:= SERVICE_WIN32;
 Status.dwServiceSpecificExitCode:= 0;

 hServStatus:= RegisterServiceCtrlHandler(SERVICE_NAME, @ServiceCtrlHandler);
 if hServStatus = 0 then begin
   ErrorLog("ServiceProc RegisterServiceCtrlHandler : "+GetErrosString);
   if not ReportStatusToSCMgr(SERVICE_STOPPED, GetLastError, 0) then
     ErrorLog("ServiceProc RegisterServiceCtrlHandler SERVICE_STOPPED : "+GetErrosString);
   exit;
 end;

 if not ReportStatusToSCMgr(SERVICE_START_PENDING, NO_ERROR, 0) then begin
   ErrorLog("ServiceProc SERVICE_START_PENDING : "+GetErrosString);
   exit;
 end;

 hThread:= CreateThread(nil, 0, @ServiceThread, nil, 0, ThID);
 WaitForSingleObject(hThread, INFINITE);
 CloseHandle(hThread);

 if not ReportStatusToSCMgr(SERVICE_STOPPED, NO_ERROR, 0) then
   ErrorLog("ServiceProc SERVICE_STOPPED : "+GetErrosString);
end;

function Start: boolean; stdcall;
var
 ServTable: array [0..1] of SERVICE_TABLE_ENTRYA;
begin
 ServTable[0].lpServiceName:= SERVICE_NAME;
 ServTable[0].lpServiceProc:= @ServiceProc;
 ServTable[1].lpServiceName:= nil;
 ServTable[1].lpServiceProc:= nil;
 if not StartServiceCtrlDispatcher(ServTable[0]) then begin
   ErrorLog("Start StartServiceCtrlDispatcher : "+GetErrosString);
   result:= false;
 end else result:= true;
end;

---

← →
kaZaNoVa ©   (2005-01-10 18:02) [24]

function RunService: boolean; stdcall;
var pParameters: PChar;
begin
 result:= false;
 hSCM:= OpenSCManager(nil, nil, GENERIC_READ or GENERIC_EXECUTE);
 if hSCM = 0 then begin
   ErrorLog("RunService OpenSCManager : "+GetErrosString);
   exit;
 end;
 hService:= OpenService(hSCM, SERVICE_NAME, SERVICE_ALL_ACCESS);
 if hService = 0 then begin
   ErrorLog("RunService OpenService : "+GetErrosString);
   CloseServiceHandle(hSCM);
   exit;
 end;
 if not StartService(hService, 0, pParameters) then
   ErrorLog("RunService StartService : "+GetErrosString);

 CloseServiceHandle(hService);
 CloseServiceHandle(hSCM);
 result:= true;
end;

begin
 ErrorLogFileName:= ParamStr(0);
 ErrorLogFileName:= Copy(ErrorLogFileName, 1, length(ErrorLogFileName)-3) + "Log";
 ServicesListFileName:= Copy(ErrorLogFileName, 1, length(ErrorLogFileName)-3) + "Txt";

 if ParamCount > 0 then begin
   if UpperCase(ParamStr(1)) = "/INSTALL" then begin
     if Install then begin
       ErrorLog("Service Installed");
       if RunService then ErrorLog("Service Run")
       else ErrorLog("Service Error on Run");
     end else ErrorLog("Error on install");
   end;
   if UpperCase(ParamStr(1)) = "/UNINSTALL" then begin
     if UnInstall then ErrorLog("Service UnInstalled")
     else ErrorLog("Error on UnInstall");
   end;
   if UpperCase(ParamStr(1)) = "/GETDATA" then begin
     if GetData then ErrorLog("List Services Created")
     else ErrorLog("Error on List Services");
   end;
   exit;
 end;
 Start;
end.

---

← →
Kerk ©   (2005-01-10 18:09) [25]

Ну зачем? зачем такие извраты? :)

---

← →
kaZaNoVa ©   (2005-01-10 18:16) [26]

Kerk ©   (10.01.05 18:09) [25]
мы не ищем простых путей:)))

---

← →
Игорь Шевченко ©   (2005-01-10 18:39) [27]

kaZaNoVa ©   (10.01.05 18:16) [26]

<offtopic>

> мы не ищем простых путей


Гланды, они вообще-то в горле находятся...

</offtopic>

---

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

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

Наверх

Память: 0.57 MB
Время: 0.038 c