Показать сообщение отдельно
  #9  
Старый 06.04.2009, 21:45
Аватар для Karsh
Karsh Karsh вне форума
Активный
 
Регистрация: 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 метра.
Ответить с цитированием