Текущий архив: 2006.09.17;
Скачать: CL | DM;

Вниз

Как определить Handle у Моего сервиса???   Найти похожие ветки 

← →
Kacnep ©   (2006-08-24 11:03) [0]

Ув. господа написал свой сервис.
По приходу некоего сообщения из сети он должен выполнять некий скрипт.
Команда выполнения скрипта для обычной программы с формой
   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.

---

← →
Сергей М. ©   (2006-08-24 11:07) [1]

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

---

← →
Kacnep ©   (2006-08-24 12:03) [2]

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

---

← →
Сергей М. ©   (2006-08-24 12:08) [3]

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


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

---

← →
Kacnep ©   (2006-08-24 12:39) [4]

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

 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:46) [5]

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


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

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

Win32Check(CreateProcess(..));

---

← →
Kacnep ©   (2006-08-24 13:49) [6]

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

А теперь такой вопрос.
На сервере Вынь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 14:01) [7]

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

см. OpenProcessToken + AdjustTokenPrivelegies

---

← →
Kacnep ©   (2006-08-24 14:02) [8]

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

---

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

Текущий архив: 2006.09.17;
Скачать: CL | DM;

Наверх

Память: 0.5 MB
Время: 0.027 c