这个问题与我试图完成的事情非常相似(如果不完全相同)。我想检测我的应用程序是否是从 cmd.exe 执行的并将输出发送到父控制台,否则它将显示 gui。这里的答案帮助我解决了我的问题。这是我作为实验想出的代码:
家长检查器.dpr
program ParentChecker;
uses
Vcl.Forms,
SysUtils,
PsAPI,
Windows,
TLHelp32,
Main in 'Main.pas' {frmParentChecker};
{$R *.res}
function AttachConsole(dwProcessID: Integer): Boolean; stdcall; external 'kernel32.dll';
function FreeConsole(): Boolean; stdcall; external 'kernel32.dll';
function GetParentProcessName(): String;
const
BufferSize = 4096;
var
HandleSnapShot: THandle;
EntryParentProc: TProcessEntry32;
CurrentProcessId: THandle;
HandleParentProc: THandle;
ParentProcessId: THandle;
ParentProcessFound: Boolean;
ParentProcPath: String;
begin
ParentProcessFound:=False;
HandleSnapShot:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
if HandleSnapShot<>INVALID_HANDLE_VALUE then
begin
EntryParentProc.dwSize:=SizeOf(EntryParentProc);
if Process32First(HandleSnapShot,EntryParentProc) then
begin
CurrentProcessId:=GetCurrentProcessId();
repeat
if EntryParentProc.th32ProcessID=CurrentProcessId then
begin
ParentProcessId:=EntryParentProc.th32ParentProcessID;
HandleParentProc:=OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,False,ParentProcessId);
if HandleParentProc<>0 then
begin
ParentProcessFound:=True;
SetLength(ParentProcPath,BufferSize);
GetModuleFileNameEx(HandleParentProc,0,PChar(ParentProcPath),BufferSize);
ParentProcPath:=PChar(ParentProcPath);
CloseHandle(HandleParentProc);
end;
Break;
end;
until not Process32Next(HandleSnapShot,EntryParentProc);
end;
CloseHandle(HandleSnapShot);
end;
if ParentProcessFound then Result:=ParentProcPath
else Result:='';
end;
function IsPrime(n: Integer): Boolean;
var
i: Integer;
begin
Result:=False;
if n<2 then Exit;
Result:=True;
if n=2 then Exit;
i:=2;
while i<(n div i + 1) do
begin
if (n mod i)=0 then
begin
Result:=False;
Exit;
end;
Inc(i);
end;
end;
var
i: Integer;
ParentName: String;
begin
ParentName:=GetParentProcessName().ToLower;
Delete(ParentName,1,ParentName.LastIndexOf('\')+1);
if ParentName='cmd.exe' then
begin
AttachConsole(-1);
Writeln('');
for i:=1 to 100 do if IsPrime(i) then Writeln(IntToStr(i)+' is prime');
FreeConsole();
end
else
begin
Application.Initialize;
Application.MainFormOnTaskbar:=True;
Application.CreateForm(TfrmParentChecker, frmParentChecker);
frmParentChecker.Label1.Caption:='Executed from '+ParentName;
Application.Run;
end;
end.
Main.pas(带标签的表单):
unit Main;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, RzLabel;
type
TfrmParentChecker = class(TForm)
Label1: TLabel;
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmParentChecker: TfrmParentChecker;
implementation
{$R *.dfm}
end.
这允许我从命令提示符运行我的 GUI 应用程序,并将输出显示到启动我的应用程序的同一控制台。否则,它将运行应用程序的完整 GUI 部分。
控制台窗口的输出示例:
I:\Delphi\Tests and Demos\ParentChecker\Win32\Debug>start /wait ParentChecker.exe
2 is prime
3 is prime
5 is prime
7 is prime
11 is prime
13 is prime
17 is prime
19 is prime
23 is prime
29 is prime
31 is prime
37 is prime
41 is prime
43 is prime
47 is prime
53 is prime
59 is prime
61 is prime
67 is prime
71 is prime
73 is prime
79 is prime
83 is prime
89 is prime
97 is prime
I:\Delphi\Tests and Demos\ParentChecker\Win32\Debug>