[8shar]

Сообщение от Karsh

Можно использовать 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.

Да!!!
Лед тронулся:

Код:

procedure TForm1.Button9Click(Sender: TObject);
type
   TAttachConsole = function (dwProcessId: DWORD): LongBOOL stdcall;
var
  AttachConsole: TAttachConsole;
  mProcessID, Hcwnd, chRead: Cardinal;
  BufInfo: _CONSOLE_SCREEN_BUFFER_INFO;
  lpCh : PChar;
  Coord: _COORD;
  i: Integer;

  Phwnd:HWND;
  ii:bool;
begin
  Phwnd:=FindWindow(nil,'C:\WINDOWS\system32\cmd.exe');

  @AttachConsole := GetProcAddress(GetModuleHandle('kernel32.dll'), 'AttachConsole');
  GetWindowThreadProcessId(Phwnd,@mProcessID);

  if AttachConsole(mProcessID) then begin
    Hcwnd:=GetStdHandle(STD_OUTPUT_HANDLE);
    GetConsoleScreenBufferInfo (Hcwnd, BufInfo);
    GetMem(lpCh, BufInfo.dwMaximumWindowSize.Y*BufInfo.dwMaximumWindowSize.X);
    Coord.X:=0;
    Coord.Y:=0;
   ii := ReadConsoleOutputCharacter(Hcwnd,lpCh,BufInfo.dwMaximumWindowSize.X,Coord,chRead);

    If ii then Memo1.Lines.Add('yes'); //успешон забрали с консоли
    If not ii then Memo1.Lines.Add('no'); //не забрали с консоли
     Memo1.Lines.Add(lpCh);  //выводим то что забрали

        Memo1.Lines.Add('Phwnd '+IntToStr(Phwnd));
        Memo1.Lines.Add('Hcwnd '+IntToStr(Hcwnd));
  end else Memo1.Lines.Add('Nea');

end;