
06.04.2009, 21:45
|
 |
Активный
|
|
Регистрация: 22.09.2007
Адрес: SPb
Сообщения: 228
Версия Delphi: 7, 2009, XE2
Репутация: 70
|
|
Можно использовать AttachConsole, но эта функция есть только в Windows XP и выше.
Вот готовая программа на WinAPI, котороя ловит окно по его названию и создает текстовый файл с содержимым этого окна.
Код:
program uAttachConsole;
uses
Windows;
const
_WIN32_WINNT = $0501;
type
TAttachConsole = function (dwProcessId: DWORD): LongBOOL stdcall;
var
AttachConsole: TAttachConsole;
mProcessID, Wnd, Hcwnd, chRead: Cardinal;
BufInfo: _CONSOLE_SCREEN_BUFFER_INFO;
lpCh: PChar;
Coord: _COORD;
i: Integer;
function FileExists(const FileName: string): Boolean;
var
FindData: TWin32FindData;
F: THandle;
begin
F:= FindFirstFile(PChar(FileName), FindData);
Result:= (F <> INVALID_HANDLE_VALUE);
if Result then FindClose(F);
end;
function ChangeFileExt(const FName, newExt: string): string;
var
i, x, e: integer;
begin
e:= Length(FName); x:= e;
for i:= e downto 1 do
if FName[i] = '.' then
begin
x:= i - 1;
break;
end;
Result:= Copy(FName, 1, x) + newExt;
end;
function OpenFile(var fLog: TextFile; const LogFileName: String;
const IsErase: Boolean = False): Boolean;
{var
TmpStr: String; }
begin
{$I-}
AssignFile(fLog, LogFileName);
Result := IOResult = 0;
if Result then begin
if IsErase or (not FileExists (LogFileName)) then
Rewrite(fLog)
else
Append(fLog);
Result := IOResult = 0;
end;
{$I+}
end;
function WriteLnStr(var fLog: TextFile; const fStr: string): boolean;
begin
{$I-}
Writeln (fLog, fStr);
Result := IOResult = 0;
if Result then begin
Flush (fLog);
Result := IOResult = 0;
end;
{$I+}
end;
procedure CloseFile(var fLog: TextFile);
begin
{$I-}
Flush(fLog);
System.CloseFile(fLog);
{$I+}
end;
function StrFile(const fStr, fFileName: String;
const IsErase: Boolean = False): Boolean;
var
fLog: TextFile;
begin
Result := OpenFile(fLog, fFileName, IsErase);
if Result then begin
try
Result := WriteLnStr(fLog, fStr);
finally
CloseFile(fLog);
end;
end;
end;
begin
@AttachConsole:= GetProcAddress(GetModuleHandle('kernel32.dll'), 'AttachConsole');
if @AttachConsole = nil then
begin
MessageBox(0, 'Программа работает только под Windows XP и выше!', 'Error', 16);
Halt(1);
end;
// Wnd:= FindWindow(nil, 'Командная строка');
Wnd:= FindWindow(nil, 'C:\WINDOWS\system32\cmd.exe');
GetWindowThreadProcessId(Wnd, @mProcessID);
if AttachConsole(mProcessID) then begin
Hcwnd:= GetStdHandle(STD_OUTPUT_HANDLE);
GetConsoleScreenBufferInfo(Hcwnd, BufInfo);
GetMem(lpCh, BufInfo.dwMaximumWindowSize.X+1);
try
for i:=0 to BufInfo.dwSize.Y-1 do begin
Coord.X := 0;
Coord.Y := i;
ReadConsoleOutputCharacter(Hcwnd, lpCh, BufInfo.dwMaximumWindowSize.X, Coord, chRead);
StrFile(lpCh, ChangeFileExt(ParamStr(0), '.log'), False);
end;
finally
FreeMem(lpCh, BufInfo.dwMaximumWindowSize.X+1);
end;
end;
Halt(0);
end.
__________________
Начинающий программист уверен, что в 1 килобайте 1000 байт.
Законченный программист уверен, что в 1 километре 1024 метра.
|