Форум: "Начинающим";
Текущий архив: 2006.09.17;
Скачать: [xml.tar.bz2];
ВнизКак определить 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;
Скачать: [xml.tar.bz2];
Память: 0.49 MB
Время: 0.041 c