Delphi 7 で標準の Windows アプリを作成しています。
コンソール アプリを作成している場合は、次のコマンドを呼び出して、コマンド ラインまたは出力ファイルに出力できます。
writeln('Some info');
コマンドラインから起動した標準の GUI アプリからこれを行うと、エラーが発生します。
I/O Error 105
この問題には簡単な解決策が必要です。基本的に、アプリに GUI モードと非 GUI モードの 2 つのモードを持たせたいと考えています。cmdウィンドウに書き戻すことができるように正しく設定するにはどうすればよいですか?
この質問は、私が達成しようとしていたものと非常に似ています (まったく同じではないにしても)。アプリが cmd.exe から実行されたかどうかを検出し、出力を親コンソールに送信したかったのです。そうしないと、GUI が表示されます。ここでの回答は、私の問題を解決するのに役立ちました。実験として思いついたコードは次のとおりです。
ParentChecker.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>
エラー 105を回避するには、 AllocConsoleを呼び出します。
GUI サブシステム アプリケーションをその親プロセスのコンソールに接続するための信頼できる方法はありません。そうしようとすると、2 つのアクティブなプロセスが同じコンソールを共有することになります。これではトラブルが後を絶ちません。
別の方法としては、bummi が提案するように、実行可能ファイルを 1 つだけ保持しながら、GUI モードで実行するように求められた場合にコンソールを解放するコンソール アプリを用意することです。これはより良いアプローチですが、GUI モードで実行したい場合、コンソール ウィンドウが点滅して閉じてしまいます。
私が Stack Overflow で遭遇した主題に関する最良の議論は、Rob Kennedy の見事な回答です。
あなたがコメントで言ったことから、あなたにとって最良の選択肢は2つの別々の実行可能ファイルを作成することだと思います. 1 つは GUI サブシステム用、もう 1 つはコンソール サブシステム用です。これは、次の方法で行われます。
はい、複数の実行可能ファイルを出荷する必要があります。ただし、そうすることで、ユーザーに最高のエクスペリエンスが提供されます。
あなたが何を達成しようとしているのかよくわかりません。
私が質問を理解したように、1つの方法は
program Project1;
{$APPTYPE CONSOLE}
uses
Forms, Classes, Windows,
Unit1 in 'Unit1.pas' { Form1 } ;
{$R *.res}
var
Finished: Boolean;
Input: String;
function IsConsoleMode(): Boolean;
var
SI: TStartupInfo;
begin
SI.cb := SizeOf(TStartupInfo);
GetStartupInfo(SI);
Result := ((SI.dwFlags and STARTF_USESHOWWINDOW) = 0);
end;
procedure HandleInput;
begin
Finished := Input = 'quit';
if not Finished then
begin
Writeln('Echo: ' + Input);
end
else
Writeln('Bye');
end;
begin
if IsConsoleMode then
begin
Finished := false;
Writeln('Welcome to console mode');
while not Finished do
begin
readln(Input);
HandleInput;
end;
end
else
begin
Writeln('Entering GUI Mode');
FreeConsole;
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TForm1, Form1);
Application.Run;
end;
end.
上記のように、AttachConsole は動作しているように見えますが、ENTER を待ちます。
ただし、このプログラムは依然として win prog であり、dos が認識する限りコンソール プログラムではないため、cmd は起動後に次のコマンドに進みます。
test.exe & dir
最初にディレクトリのリストを表示し、次にtest.exeからの出力を表示します
start /w test.exe & dir
動作し、ENTER キーで一時停止しません
ところで、上記の提案: PostMessage(GetCurrentProcess,$0101,$0D,0); ENTER をしますが、ボン音を出しています。
問題全体に関するこの非常に完全な記事を見つけました：http://www.boku.ru/2016/02/28/posting-to-console-from-gui-app/
AttachConsole を実行するユニットを作成し、例外ハンドラーをフックしてメッセージをコンソールにミラーリングしました。
これを使用するには、コードで ATTACH を呼び出すだけです。-console などのコマンドライン オプションを付けることをお勧めします。
if FindCmdLineSwitch('console',true) then AttachConsole(true,true);
これは GUI アプリケーション用です。これを使用する場合は、START /W を使用してプログラムを起動する必要があります。コマンドライン/バッチでブロックされることが予想される場合などです。start /w myprogram.exe -console
便利な利点の 1 つは、必要に応じてコンソールを使用してスタンドアロンで起動し、コンソールですべてのエラー メッセージを確認できることです。
unit ConsoleConnector;
// Connects the/a console to a GUI program
// Can hook exception handler to mirror messages to console.
// To use it, you only need to call ATTACH
// best to make attaching a commandline option e.g -console
// if FindCmdLineSwitch('console',true) then AttachConsole(true,true);
// When using this, you will use START to launch your program e.g.
// start /w myprogram.exe -console
// creates Console var at end in initialise/finalise - you might want to do this explicitly in your own program instead.
// see: http://www.boku.ru/2016/02/28/posting-to-console-from-gui-app/
//sjb 18Nov16
interface
uses sysutils,forms;
type
TConsoleConnector = class
private
OldExceptionEvent:TExceptionEvent;
Hooked:boolean;
BlockApplicationExceptionHandler:boolean; //errors ONLY to console, no error messageboxes blocking program
procedure DetachErrorHandler;
procedure GlobalExceptionHandler(Sender: TObject; E: Exception);
procedure HookExceptionHandler;
public
IsAttached:boolean;
function Attach(
CreateIfNeeded:boolean=true; //Call ALLOCCONSOLE if no console to attach to
HookExceptions:boolean=false; //Hook Application.OnException to echo all unhandled exceptions to console
OnlyToConsole:boolean=false // Suppresses exception popups in gui, errors only go to console
):boolean;
procedure Detach; //detach and unhook
procedure writeln(S:string); //only writes if console is attached
procedure ShowMessage(S:string); //Popup ShowMessage box and mirror to console. Obeys OnlyToConsole
end;
var Console:TConsoleConnector;
implementation
uses Windows,dialogs;
//winapi function
function AttachConsole(dwProcessId: Int32): boolean; stdcall; external kernel32 name 'AttachConsole';
function TConsoleConnector.Attach(CreateIfNeeded:boolean=true;HookExceptions:boolean=false;OnlyToConsole:boolean=false):boolean;
begin
IsAttached:=AttachConsole(-1);
if not IsAttached and CreateIfNeeded
then begin
IsAttached:=AllocConsole;
end;
result:=IsAttached;
if HookExceptions then HookExceptionHandler;
end;
procedure TConsoleConnector.Detach;
begin
FreeConsole;
IsAttached:=false;
DetachErrorHandler;
end;
procedure TConsoleConnector.WriteLn(S:string);
begin
if IsAttached then system.writeln(S);
end;
procedure TConsoleConnector.ShowMessage(S:string);
begin
self.Writeln(S);
if BlockApplicationExceptionHandler then exit;
dialogs.ShowMessage(S);
end;
procedure TConsoleConnector.GlobalExceptionHandler(Sender: TObject; E: Exception);
begin
self.Writeln(E.Message);
if BlockApplicationExceptionHandler then exit;
if assigned(OldExceptionEvent) //i.e there was an old event before we hooked it
then OldExceptionEvent(Sender,E)
else Application.ShowException(E);
end;
procedure TConsoleConnector.HookExceptionHandler;
begin
OldExceptionEvent:=Application.OnException;
Application.OnException:=GlobalExceptionHandler;
Hooked:=true;
end;
procedure TConsoleConnector.DetachErrorHandler;
begin
if Hooked //I have hooked it
then begin
Application.OnException:=OldExceptionEvent;
OldExceptionEvent:=nil;
Hooked:=false;
end;
end;
initialization
Console:=TconsoleConnector.create;
finalization
Console.Detach;
Console.Destroy;
end.
実行中のスクリプトを使用して、このトピックをレポートにまとめました。
2 番目のバックアップとしてhttp://www.softwareschule.ch/download/maxbox_starter70.pdf :
https://www.slideshare.net/maxkleiner1/nogui-maxbox-starter70
メイン ルーチンには、writeline から分離するためのネイティブな writeline があります。
for it:=1 to 50 do if IsPrime(it) then NativeWriteln(IntToStr(it)+' is prime');