5
मैंने डेल्फी के साथ एक सेवा की है। हर बार जब मैं उस सेवा में एक और आवेदन कहता हूं तो एप्लिकेशन नहीं चल रहा है। गलत क्या है?मैं अपनी डेल्फी सेवा से एक और आवेदन कैसे कॉल कर सकता हूं?
बीटीडब्ल्यू मैंने शेलेक्सक्यूट, शैलोपेन या इसे cmd के साथ बुलाया है। इनमें से कोई भी तरीका काम नहीं करता है।
यह मेरा कोड है:
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.
कृपया run_procedure कोड लाइन देखते हैं;
बस रखें: मैं अपनी सेवा से एक और एप्लिकेशन कैसे कॉल कर सकता हूं?
"क्या गलत है?" कोई जानकारी नहीं। आपने कोई जानकारी प्रदान नहीं की जो हमें मदद करने की अनुमति दे सकती है। आप सभी ने कहा था "सभी विधि काम नहीं करते हैं"। आपने कोड नहीं दिखाया आपने त्रुटि कोड नहीं दिखाए। आपको दूर जाने, कुछ जानकारी इकट्ठा करने और फिर एक वास्तविक प्रश्न के साथ वापस आने की जरूरत है। –
ठीक है, मैं संपादित करूंगा कि मेरी पोस्ट – AsepRoro
ओएस का संस्करण भी शामिल है जिस पर आपको समस्याएं आ रही हैं। मुझे लगता है कि आप Vista पर चल रहे हैं और चूंकि सेवाएं डेस्कटॉप (सत्र 0) से अलग सत्र पर चल रही हैं, इसलिए आप उस एप्लिकेशन को नहीं देख सकते जिसे आप निष्पादित करने का प्रयास कर रहे हैं। – TLama