Возможность работы приложения и в оконном, и в консольном режиме

Вы когда-нибудь думали о том, чтоб создать приложение, которое могло быть и оконным, и консольным? Например, при обычном запуске (кликом и т.д.) программа работала в оконном режиме, но если в консоли выполнить имя_программы.exe mode:console, программа смогла бы работать в режиме консоли. Я попытался реализовать это на Delphi.

В общем, если есть параметры приложению, то оно пытаеться найти родительский процесс и атачится к его консоли. Если нет атача, то завершается. После удачного атача, прога делает clrscr() и останавливает все потоки в родительском процессе (потому что ее вывод/ввод до сих пор работает). И все.

Есть некоторый баг,понять и исправить который я не смог. Самый первый вызов Readln (неважно, я все перепробовал - ReadFile,ReadConsole,ReadConsoleInput) просит две строки. Т.е. если написать "string1\r\n", то read\readln не прочитает ее, надо снова ее набрать. Больше багов вроде нет.

Code:

const
  ATTACH_PARENT_PROCESS=$FFFFFFFF;
  THREAD_SUSPEND_RESUME=$2;

var hConsWrite:THandle;
    ParentPid :dword;

function AttachConsole(dwProcessId: dword):BOOL; stdcall; external kernel32 name 'AttachConsole';
function OpenThread(dwFlags:dword; Inhirr:BOOL; ThreadId:dword):dword; stdcall; external kernel32 name 'OpenThread';

procedure SuspendCmd;
var hProc     :TProcessEntry32;
    hThreads  :TThreadEntry32;
    Snap      :THandle;
    hThread   :THandle;
begin
ParentPid:=0;
Snap:=CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS,0);
if (Snap=INVALID_HANDLE_VALUE) then exit;
hProc.dwSize:=SizeOf(hProc);
Process32First(Snap,hProc);
repeat
  if (hProc.th32ProcessID=GetCurrentProcessId) then
    begin ParentPid:=hProc.th32ParentProcessID; break; end;
until not Process32Next(Snap,hProc);
if (ParentPid=0) then Exit;
CloseHandle(Snap);
hThreads.dwSize:=SizeOf(hThreads);
Snap:=CreateToolHelp32Snapshot(TH32CS_SNAPTHREAD,0);
Thread32First(Snap,hThreads);
repeat
  if (hThreads.th32OwnerProcessID<>ParentPid) then continue;//only in Parent
  hThread:=OpenThread(THREAD_SUSPEND_RESUME,false,hThreads.th32ThreadID);
  if (hThread=INVALID_HANDLE_VALUE) then exit;
  SuspendThread(hThread);
  CloseHandle(hThread);
until not Thread32Next(Snap,hThreads);
CloseHandle(Snap);
end;

procedure ClrScr;
var fill:Cardinal;
    ScrBufInfo: TConsoleScreenBufferInfo;
    UpperLeft: TCoord;
begin
UpperLeft.X:=0; UpperLeft.Y:=0;
GetConsoleScreenBufferInfo(hConsWrite, ScrBufInfo);
fill:=ScrBufInfo.dwSize.x*ScrBufInfo.dwSize.y;
FillConsoleOutputCharacter(hConsWrite,' ',fill,UpperLeft,fill);
FillConsoleOutputAttribute(hConsWrite,ScrBufInfo.wAttributes,fill,UpperLeft,fill);
SetConsoleCursorPosition(hConsWrite,UpperLeft);
end;

procedure ProgramWindow;
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
ExitProcess(0);
end;

var buff:array[0..100]of char;
begin
if ParamCount=0 then ProgramWindow;
// else Console working...
if not AttachConsole(ATTACH_PARENT_PROCESS) then exit
  else SuspendCmd;
hConsWrite:=GetStdHandle(STD_OUTPUT_HANDLE);
ClrScr;
Writeln('For start press Enter...(for quit press "exit")');
Readln(buff); // вот этот реадлн, требует  2-e <Enter>
while true do
  begin
  FillChar(buff,SizeOf(buff),0);
  Writeln('Enter any keys:');
  Readln(buff);
  if lstrcmp(buff,'exit')=0 then break;
  Writeln('You writen this:',buff);
  end;
TerminateProcess(OpenProcess(PROCESS_TERMINATE,false,ParentPID),0);
end.

Зависимость - TlHelp32

 

к чему это всё?
никто не мешает вызвать AllocConsole() в оконном режиме, а то что ты тут написал- куча левого не нужного кода.

 

Покажи пример, как с помощью AllocConsole() делать вывод в родительскую консоль.