Tôi làm cách nào để gọi một ứng dụng khác từ dịch vụ Delphi của mình?

Question

Tôi đã thực hiện một dịch vụ với Delphi. Mỗi khi tôi gọi một ứng dụng khác trong dịch vụ đó, ứng dụng không chạy. Chuyện gì thế?

BTW Tôi đã sử dụng giá treo, vỏ hoặc gọi nó bằng cmd. Không có phương pháp nào trong số này hoạt động.

Đây là mã của tôi:

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. 

Xin xem dòng mã run_procedure;

Nói một cách đơn giản: làm cách nào tôi có thể gọi một ứng dụng khác từ dịch vụ của mình?

Answer 1

ShellExecute/Ex() và CreateProcess() chạy tệp/ứng dụng được chỉ định trong cùng một phiên làm quy trình gọi điện. Một dịch vụ luôn chạy trong phiên 0.

Trong XP và trước đó, người dùng đầu tiên đăng nhập cũng chạy trong phiên 0, do đó dịch vụ có thể chạy một quy trình tương tác và có thể xem được người dùng tương tác đó, nhưng chỉ khi dịch vụ được đánh dấu là tương tác (thuộc tính TService.Interactive là đúng). Nếu nhiều người dùng đăng nhập, họ chạy trong phiên 1+ và do đó không thể thấy các quy trình tương tác được chạy bởi các dịch vụ.

Windows Vista đã giới thiệu một tính năng mới có tên là "Session 0 Isolation". Người dùng tương tác không còn chạy trong phiên 0 nữa, họ luôn chạy trong phiên 1+ và phiên 0 không tương tác chút nào (thuộc tính TService.Interactive không còn hiệu lực). Tuy nhiên, để giúp di chuyển các dịch vụ cũ, nếu một dịch vụ chạy một quá trình tương tác cố gắng hiển thị GUI trên phiên 0, Windows sẽ nhắc người dùng đã đăng nhập hiện tại, nếu có, chuyển sang một máy tính riêng biệt. . Trong Windows 7 trở đi, sự hỗ trợ cũ đó đã biến mất.

Trong tất cả các phiên bản trên Windows từ 2000 trở đi, cách chính xác để chạy quy trình tương tác từ dịch vụ và người dùng tương tác có thể xem được là sử dụng để chạy quy trình mới trong phiên và máy tính để bàn của người dùng được chỉ định. Có rất nhiều ví dụ chi tiết có sẵn trên MSDN, StackOverflow và trên toàn bộ Web, vì vậy tôi sẽ không nhắc lại chúng ở đây.

Answer 2

Dịch vụ chạy trong một phiên khác từ người dùng tương tác. Các dịch vụ chạy trong phiên 0. Các quy trình phiên 0 không có quyền truy cập vào màn hình tương tác. Điều này có nghĩa là bất kỳ nỗ lực nào để hiển thị một quá trình tương tác trong phiên 0 đều bị thất bại. Bạn đang cố tạo một quy trình Notepad tương tác.

Có nhiều cách để khởi chạy quy trình trên máy tính để bàn tương tác từ phiên: Launching an interactive process from Windows Service in Windows Vista and later. Như bạn sẽ hiểu sau khi đọc bài viết đó, những gì bạn đang cố gắng làm là không tầm thường.