| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Как определить Handle у Моего сервиса??? [D6, 2000, XP, 2003]

Kacnep ©   (2006-08-24 11:03:00) 

Ув. господа написал свой сервис.
По приходу некоего сообщения из сети он должен выполнять некий скрипт.
Команда выполнения скрипта для обычной программы с формой
   ShellExecute(Application.Handle,'open',scr,nil,nil,SW_ShowNormal);
а что вместо Application.Handleдля сервиса втыкать?
Спасибо.

unit u_Main;

interface

uses
 Windows,
 Messages,
 SysUtils,
 Classes,
 SvcMgr,
 IniFiles,
 IdCmdTCPServer,
 IdCommandHandlers,
 ShellApi, IdBaseComponent, IdComponent, IdCustomTCPServer, IdTCPServer;

type
 Tf_Main = class(TService)
   id_Srv: TIdCmdTCPServer;
   procedure ServiceStart(Sender: TService; var Started: Boolean);
   procedure ServiceStop(Sender: TService; var Stopped: Boolean);
   procedure id_SrvCommandHandlers0Command(ASender: TIdCommand);
 private
   FIP:TStringList;
   FScript:string;
   procedure AddL(LogString: String);
   procedure AddLog(LogString: String; const LogFileName: string);
   function GetAppVersion: string;
   function StartServer: Boolean;
   function StopServer: Boolean;
   { Private declarations }
 public
   function GetServiceController: TServiceController; override;
   { Public declarations }
 end;

const
 c_Log='Service.log';
 c_Ini='srvAdmin.ini';

var
 f_Main: Tf_Main;
 Log,Ini:TFileName;

implementation

{$R *.DFM}

function Tf_Main.GetAppVersion:string;
var
 InfoSize,puLen:DWord;
 Pt:PChar;
 InfoPtr:Pointer;
 s:string;
begin
 result:='';
 s:=paramstr(0);
 InfoSize:=GetFileVersionInfoSize(PChar(s),puLen);
 if InfoSize>0 then begin
   Pt:=AllocMem(InfoSize);
   GetFileVersionInfo(PChar(s),puLen,InfoSize,Pt);
   VerQueryValue(Pt,'\VarFileInfo\Translation',InfoPtr,puLen);
   s:=IntToHex(MakeLong(HiWord(Longint(InfoPtr^)),LoWord(Longint(InfoPtr^))),8);
   VerQueryValue(Pt,PChar('StringFileInfo\'+s+'\FileVersion'),InfoPtr,puLen); //ProductName
   if puLen>1 then result:=StrPas(Pchar(InfoPtr));
   FreeMem(Pt,InfoSize);
 end;
end;

procedure Tf_Main.AddLog(LogString: String; const LogFileName: string);
var
F: TFileStream;
PStr: PChar;
LengthLogString: integer;
begin
//  if not chb_Log.Checked then Exit;
LogString:='['+DateTimeTostr(Now)+'] '+LogString + #13#10;
LengthLogString:= Length(LogString);
PStr:= StrAlloc(LengthLogString + 1);
StrPCopy(PStr, LogString);
 try
   try
     if FileExists(LogFileName) then
       F:=TFileStream.Create(LogFileName, fmOpenWrite)//fmOpenWrite
     else F:= TFileStream.Create(LogFileName, fmCreate);
     try
       F.Position:= F.Size;
       F.Write(PStr^, LengthLogString);
     finally
       F.Free;
     end;
   except
   end;
 finally
   StrDispose(PStr);
 end;//finally
end;

procedure Tf_Main.AddL(LogString: String);
begin
 AddLog(LogString,Log);
end;

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

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

procedure Tf_Main.id_SrvCommandHandlers0Command(ASender: TIdCommand);
var
 scr:array[0..800] of char;
begin
 AddL(ASender.Context.Connection.Socket.Binding.PeerIP+' -> Shutdown');
 if (FIP.Count>0) and (FIP.IndexOf(ASender.Context.Connection.Socket.Binding.PeerIP)>-1) then begin
//  if ASender.Params.Count<2 then
//    ASender.Context.Connection.IOHandler.WriteLn('Команда без аутентификации!')
//  else begin
   AddL('Execute Shutdown! '+FScript);
   FScript:=trim(FScript)+' ';
   FScript:=trim(copy(FScript,1,pos(' ',FScript)));
   StrPCopy(scr,FScript);
   ShellExecute(Application.Handle,'open',scr,nil,nil,SW_ShowNormal);
   ASender.Context.Connection.Disconnect;
 end;//if
end;

function Tf_Main.StopServer: Boolean;
begin
 id_Srv.Active:=false;
 //id_Srv.Bindings.Clear;
 Result:=not id_Srv.Active;
 if result then AddL('Server stopped')
 else AddL('Server not stopped');
end;

function Tf_Main.StartServer: Boolean;
begin
{  if not StopServer then begin
   AddL('Error stopping server');
   Result := false;
   exit;
 end;}
//  id_Srv.Bindings.Clear; // bindings cannot be cleared until TidTCPServer is inactive
 id_Srv.DefaultPort:=9999;
 try
   id_Srv.TerminateWaitTime:=100;
   id_Srv.Active:=true;
   result:=id_Srv.Active;
   AddL('Server started');
 except
   on E : Exception do begin
     AddL('Server not started');
     AddL(E.Message);
     Result:=false;
   end;
 end;
end;

procedure Tf_Main.ServiceStart(Sender: TService; var Started: Boolean);
var
 sl_Tmp:TStringList;
 s:string;
 i:integer;
begin
 Started:=FALSE;
 Ini:=ExtractFilePath(paramstr(0))+c_Ini;
 Log:=ExtractFilePath(paramstr(0))+c_Log;
 AddL('Service is starting... '+GetAppVersion);
//  FMyThread:=nil;
//  FMyThread:=TMyThread.Create(TRUE);
//  FMyThread.Resume;
 FIP:=TStringList.Create;
 sl_Tmp:=TStringList.Create;
 try
   with TIniFile.Create(Ini) do begin
     FScript:=ReadString('Script','File','');
     ReadSection('IPs',sl_Tmp);
     for i:=0 to sl_Tmp.Count-1 do begin
       s:=trim(ReadString('IPs',sl_Tmp.Strings[i],''));
       if s<>'' then FIP.Add(s);
     end;
     Free;
   end;// WIth
 finally
   FreeAndNil(sl_Tmp);
 end;
 if not StartServer then
   AddL('Error starting server')
 else AddL('Server started successfully!');

//запуститьь поток с сервером
 AddL('Service is started.');
 Started:=TRUE;
end;

procedure Tf_Main.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
 AddL('Service is stoping... ');
 if not StopServer then AddL('Error stopping server');
//if FMyThread<>nil then
//begin
//  FMyThread.Terminate;
//  FMyThread.WaitFor;
//end;
 FreeAndNil(FIP);
 AddL('Service is stoped.');
 Stopped:=TRUE;
end;

end.

---

Kacnep   (2006-08-24 14:02:00) [1]

Спасибо! Буду искать!

---

Сергей М.   (2006-08-24 14:01:00) [2]

Скорей всего у запускаемого тобой процесса нет shutdown-привелегий.

см. OpenProcessToken + AdjustTokenPrivelegies

---

Kacnep   (2006-08-24 13:49:00) [3]

Все заработало! Спасибо за помощь!

А теперь такой вопрос.
На сервере Вынь2003 никто не залогинен.
Сервис запущен.
Скрипт который он якобы запускает выполняет команду shutdown /s /f
Но почему то не вырубается.
Подозреваю что скрипт должен все таки выполняться под каким то экаунтом?
Или этого достаточно
       if not CreateProcess(nil,PChar(FScript),nil,nil,true,0,{false,normal_priority_class,}ni l,nil,PMSI,PMPI) then RaiseLastWin32Error;

---

Сергей М.   (2006-08-24 12:46:00) [4]

> в лог Еррор не выдается


Потому что нет исключения.

А вот так будет правильно:

Win32Check(CreateProcess(..));

---

Kacnep   (2006-08-24 12:39:00) [5]

сейчас процедура запуска скрипта выглядит так

 PMSI:TStartupInfo;
 PMPI:TProcessInformation;
begin
 AddL(ASender.Context.Connection.Socket.Binding.PeerIP+' -> Shutdown');
 if (FIP.Count>0) and (FIP.IndexOf(ASender.Context.Connection.Socket.Binding.PeerIP)>-1) then begin
   AddL('Execute Shutdown! '+FScript);
   FillChar(PMSI,sizeof(PMSI),#0);
   PMSI.cb:=sizeof(PMSI);
   FillChar(PMPI,sizeof(PMPI),#0);
   try
     CreateProcess(@FScript[1],nil,nil,nil,false,normal_priority_class,nil,nil,PMSI,P MPI);
     CloseHandle(PMPI.hProcess);
     CloseHandle(PMPI.hThread);
   except
     AddL('Error: '+SysErrorMessage(GetLastError));
   end;

тем не менее файл -точно существующий не выполняется :( в лог Еррор не выдается

2. Меня терзают смутные сомнения как будет выполняться скрипт запущеный процессом если на сервер не войдет ни один пользователь. Т.е. Логона не будет???

---

Сергей М.   (2006-08-24 12:08:00) [6]

> Можете что нить посоветовать?


Вместо ShellExecute используй CreateProcess[AtUser]

---

Kacnep   (2006-08-24 12:03:00) [7]

Ув. Сергей М.
Ф-я ShellExecute с установленым 0м возвращает значение 42 - не описанное в хелпе. Я так подозреваю - успешно выполнилось. Но тем не менее файл или скрипт в общем что должно запускаться - почему то не запускается :(.
Можете что нить посоветовать?
И паузу ставил после выполнения перед дисконектом - бесполезно.

---

Сергей М.   (2006-08-24 11:07:00) [8]

Ничего не надо "втыкать". Просто ноль укажи в кач-ве этого параметра.

---

Наверх