| Joker-jar |
25.05.2007 12:48 |
Возможность работы приложения и в оконном, и в консольном режиме
Вы когда-нибудь думали о том, чтоб создать приложение, которое могло быть и оконным, и консольным? Например, при обычном запуске (кликом и т.д.) программа работала в оконном режиме, но если в консоли выполнить имя_программы.exe mode:console, программа смогла бы работать в режиме консоли. Я попытался реализовать это на Delphi.
В общем, если есть параметры приложению, то оно пытаеться найти родительский процесс и атачится к его консоли. Если нет атача, то завершается. После удачного атача, прога делает clrscr() и останавливает все потоки в родительском процессе (потому что ее вывод/ввод до сих пор работает). И все.
Есть некоторый баг,понять и исправить который я не смог. Самый первый вызов Readln (неважно, я все перепробовал - ReadFile,ReadConsole,ReadConsoleInput) просит две строки. Т.е. если написать "string1\r\n", то read\readln не прочитает ее, надо снова ее набрать. Больше багов вроде нет.
Код:
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 |
