Jak mogę połączyć się z inną aplikacją z mojej usługi Delphi?

Question

Zrobiłem usługę z Delphi. Za każdym razem, gdy wywołuję inną aplikację w tej usłudze, aplikacja nie działa. Co jest nie tak?

BTW Użyłem shellexecute, shellopen lub wywołanie go z cmd. Żadna z tych metod nie działa.

To jest mój kod:

program roro_serv; 

uses 
    SvcMgr, 
    Unit1 in 'Unit1.pas' {Service1: TService}, 
    ping in 'ping.pas'; 

{$R *.RES} 

begin 
    Application.Initialize; 
    Application.CreateForm(TService1, Service1); 
    Application.Run; 
end. 

    unit Unit1; 

interface 

uses 
    Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs, 
    ExtCtrls, DB, MemDS, DBAccess, MyAccess, Menus, forms, IniFiles, 
    ComCtrls, wininet, Variants, shellapi, 
    FileCtrl, ExtActns, StdCtrls, ShellCtrls; 

type 
    TService1 = class(TService) 
    Timer1: TTimer; 
    procedure Timer1Timer(Sender: TObject); 
    procedure ServiceExecute(Sender: TService); 
    procedure ServiceStop(Sender: TService; var Stopped: Boolean); 
    procedure ServiceStart(Sender: TService; var Started: Boolean); 
    private 
    { Private declarations } 
    public 
    function GetServiceController: TServiceController; override; 
    { Public declarations } 
    procedure run_procedure; 
    procedure log(text_file, atext : string); 
    procedure loginfo(text : string); 
    function CheckUrl(url: string): boolean; 
    procedure execCMD(CommandLine, Work: string); 
    function DoDownload(FromUrl, ToFile: String): boolean; 
    end; 

var 
    Service1: TService1; 
    iTime : integer; 
    limit_time : integer = 2; 
    myini : TiniFile; 
    default_exe_path : string = ''; 
    default_log_path : string = ''; 
    appdir : String = ''; 

implementation 

{$R *.DFM} 

uses ping; 

function TService1.CheckUrl(url: string): boolean; 
var 
hSession, hfile, hRequest: hInternet; 
dwindex,dwcodelen :dword; 
dwcode:array[1..20] of char; 
res : pchar; 
begin 
if pos('http://',lowercase(url))=0 then 
url := 'http://'+url; 
Result := false; 
hSession := InternetOpen('InetURL:/1.0', 
INTERNET_OPEN_TYPE_PRECONFIG,nil, nil, 0); 
if assigned(hsession) then 
begin 
hfile := InternetOpenUrl(
hsession, 
pchar(url), 
nil, 
0, 
INTERNET_FLAG_RELOAD, 
0); 
dwIndex := 0; 
dwCodeLen := 10; 
HttpQueryInfo(hfile, HTTP_QUERY_STATUS_CODE, 
@dwcode, dwcodeLen, dwIndex); 
res := pchar(@dwcode); 
result:= (res ='200') or (res ='302'); 
if assigned(hfile) then 
InternetCloseHandle(hfile); 
InternetCloseHandle(hsession); 
end; 
end; 

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

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

procedure TService1.Timer1Timer(Sender: TObject); 
begin 
iTime:=iTime+1; 
if iTime=15 then // (limit_time*60) then 
    begin 
     itime:=1; 
     run_procedure; 
    end; 
// loginfo('Defaultlog : '+default_log_path+'; exe : '+default_exe_path); 
end; 

procedure TService1.ServiceExecute(Sender: TService); 
begin 
Timer1.Enabled := True; 
while not Terminated do 
ServiceThread.ProcessRequests(True); 
Timer1.Enabled := False; 
end; 

procedure TService1.run_procedure; 
var 
i : integer; 
sUrl, sLogFile, sAction, sAct_param : String; 
begin 
for i:=0 to 20 do 
    begin 
    sLogFile:=default_log_path+myini.ReadString('logs', 'log_file'+intTostr(i), ''); 
    if fileexists(slogfile) then 
     begin 
     loginfo(slogfile+' tersedia'); 
     sAction:=myini.ReadString('logs', 'action'+intTostr(i), ''); 
      if ((trim(sAction)<>'') and (fileexists(default_exe_path+sAction))) then 
       begin 
        // this line is don't work in servcie 
        ShellExecute(Application.Handle, 'open', 'c:\Windows\notepad.exe', nil, nil, SW_SHOWNORMAL); 
        sAct_param:=myini.ReadString('logs', 'action_prm'+intTostr(i), ''); 
        // this line is don't work in servcie 
        execCMD(sAction+' '+sAct_param, default_exe_path); 
        loginfo(sAction+' '+sAct_param+' defpath : '+default_exe_path); 
        // this loginfo works 
       end; 
     end else 
     begin 

     end; 

    end; 
end; 

procedure TService1.log(text_file, atext: string); 
var 
logFile : TextFile; 
begin 
AssignFile(LogFile, text_file); 
if FileExists(text_file) then 
Append(LogFile) else rewrite(LogFile); 
WriteLn(logFile, aText); 
CloseFile(LogFile); 
end; 

procedure TService1.loginfo(text: string); 
begin 
log(ChangeFileExt(application.exename, '.log'), formatdateTime('dd-mm-yyyy hh:nn:ss ', now)+ 
text); 
end; 

procedure TService1.ServiceStop(Sender: TService; var Stopped: Boolean); 
begin 
myini.Free; 
end; 

procedure TService1.execCMD(CommandLine, Work: string); 
var 
SA: TSecurityAttributes; 
SI: TStartupInfo; 
PI: TProcessInformation; 
StdOutPipeRead, StdOutPipeWrite: THandle; 
WorkDir: string; 
begin 
with SA do begin 
nLength := SizeOf(SA); 
bInheritHandle := True; 
lpSecurityDescriptor := nil; 
end; 
CreatePipe(StdOutPipeRead, StdOutPipeWrite, @SA, 0); 
try 
with SI do 
begin 
FillChar(SI, SizeOf(SI), 0); 
cb := SizeOf(SI); 
dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES; 
wShowWindow := SW_HIDE; 
hStdInput := GetStdHandle(STD_INPUT_HANDLE); // don't redirect stdin 
hStdOutput := StdOutPipeWrite; 
hStdError := StdOutPipeWrite; 
end; 
WorkDir := Work; 
CreateProcess(nil, PChar('cmd.exe /C ' + CommandLine), 
nil, nil, True, 0, nil, 
PChar(WorkDir), SI, PI); 
CloseHandle(StdOutPipeWrite); 
finally 
CloseHandle(StdOutPipeRead); 
end; 
end; 

procedure TService1.ServiceStart(Sender: TService; var Started: Boolean); 
begin 
appdir:=ExtractFileDir(Application.ExeName); 
myini:=TiniFile.Create(ExtractFileDir(application.ExeName)+'\setting.ini'); 
limit_time:=myini.ReadInteger('setting', 'limit_time', 0); 
default_exe_path:=myini.ReadString('setting', 'default_exe_path',''); 
if trim(default_exe_path)='' then default_exe_path:=appdir+'\'; 

default_log_path:=myini.ReadString('setting', 'default_log_path',''); 
if trim(default_log_path)='' then default_log_path:=appdir+'\logs\'; 

end; 

function TService1.DoDownload(FromUrl, ToFile: String): boolean; 
begin 
{ with TDownloadURL.Create(self) do 
    try 
    URL:=FromUrl; 
    FileName := ToFile; 
    ExecuteTarget(nil) ; 
    finally 
    Free; 
    end; } 
end; 

end. 

proszę zobaczyć linię kodu run_procedure;

Krótko mówiąc: jak mogę połączyć się z inną aplikacją z mojej usługi?

Answer 1

ShellExecute/Ex() i CreateProcess() uruchomić określony plik/aplikację w tej samej sesji, co proces wywołujący. Usługa zawsze działa w sesji 0.

W XP i wcześniejszych, pierwszy użytkownik, który się loguje, również pracuje w sesji 0, więc usługa może uruchomić proces interaktywny i udostępnić go internaucie, ale tylko wtedy, gdy usługa jest oznaczona jako interaktywna (właściwość TService.Interactive jest prawdziwa). Jeśli zalogowanych jest wielu użytkowników, działają one w sesji 1+, a zatem nie widzą interaktywnych procesów uruchamianych przez usługi.

System Windows Vista wprowadził nową funkcję o nazwie "Session 0 Isolation". Interaktywni użytkownicy w ogóle nie działają w sesji 0, zawsze działają w sesji 1+, a sesja 0 w ogóle nie jest interaktywna (właściwość TService.Interactive nie ma już żadnego efektu). Aby jednak pomóc w migracji starszych usług, jeśli usługa uruchamia interaktywny proces, który próbuje wyświetlić graficzny interfejs użytkownika w sesji 0, system Windows wyświetla bieżący zalogowany użytkownik, jeśli taki istnieje, aby przełączyć się na oddzielny pulpit, który tymczasowo powoduje, że interfejs GUI jest widoczny . W systemie Windows 7 ta starsza obsługa już nie istnieje.

We wszystkich wersjach systemu Windows od 2000 roku prawidłowym sposobem uruchomienia interaktywnego procesu z usługi i udostępnienia go interakcyjnemu użytkownikowi jest użycie w celu uruchomienia nowego procesu w sesji i na komputerze określonego użytkownika. Istnieje wiele szczegółowych przykładów dostępnych na MSDN, StackOverflow i w całej sieci, więc nie zamierzam ich tutaj powtarzać.

Answer 2

Usługi są uruchamiane w innej sesji niż użytkownik interaktywny. Usługi działają w sesji 0. Procesy sesji 0 nie mają dostępu do interaktywnego pulpitu. Oznacza to, że każda próba wyświetlenia interaktywnego procesu w sesji 0 jest skazana na niepowodzenie. Próbujesz utworzyć proces Notatnika, który jest interaktywny.

Istnieją sposoby na uruchomienie procesu na interaktywnym pulpicie z sesji: Launching an interactive process from Windows Service in Windows Vista and later. Jak zrozumiesz po przeczytaniu tego artykułu, to, co próbujesz zrobić, nie jest banalne.