Архив исходников программ, модулей и компонентов на Delphi


Начальная страница

Поиск по базе



Операционная система
Настройка приложения
Взаимодействия приложений
Файлы и директории
Строки и символы
Математика
Базы данных
Интернет и сеть
Мультимедиа
Аппаратная часть
VCL
Другие разделы [0]
 

Количество записей в базе - 537
Сегодня добавлено – 0

Управление приложением



Вернуться к списку функций
 Копирование текста из чужого консольного окна в файл

 Прислал: Fktrc (Кемерово) ( 30 июня 2006 г. )
©  Компиляция разных статей из Интернет, а представленный исходник - разработка автора.
 Описание:
Ну это не процедура, а готовая программа. Просто сайт не допускает указания слова program в заголовке.
Однажды потребовалось отслеживать содержимое чужого консольного окна, причем программа могла быть запущена откуда угодно, а не только из моей программы. Хорошо, что в WinXP появилась такая полезная функция, как AttachConsole.

 Зависимости:
Windows, SysUtils

 Ограничения:
Проверено в D5. Работать будет только в Windows XP.

 Исходный текст:
{ **** UBPFD *********** by http://kladovka.net.ru/delphibase/ ****
>> Копирование текста из чужого консольного окна в файл

Ну это не процедура, а готовая программа. Просто сайт не допускает указания слова program в заголовке.
Однажды потребовалось отслеживать содержимое чужого консольного окна, причем программа могла быть запущена откуда угодно, а не только из моей программы. Хорошо, что в WinXP появилась такая полезная функция, как AttachConsole.

Зависимости: Windows, SysUtils
Автор:       Fktrc, delpher@inbox.ru, Кемерово
Copyright:   Компиляция разных статей из Интернет, а представленный исходник - разработка автора.
Дата:        30 июня 2006 г.
***************************************************************** }

program ScreenConsoleBuffer;

uses
   Windows, SysUtils;

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 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(const 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');

  Wnd := FindWindow(nil, '{C:\} - Far'); // Текст заголовка должен быть записан сюда полностью

  GetWindowThreadProcessId(Wnd, @mProcessID); // получаем по хэндлу окна ИД процесса, чтобы прицепиться к консоли

  if AttachConsole(mProcessID) then begin // функция присутствует только в WinXP, так что...
    Hcwnd:=GetStdHandle(STD_OUTPUT_HANDLE);
    GetConsoleScreenBufferInfo (Hcwnd, BufInfo);
    GetMem(lpCh, BufInfo.dwMaximumWindowSize.Y*BufInfo.dwMaximumWindowSize.X);
    try
      for i:=0 to BufInfo.dwMaximumWindowSize.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.Y*BufInfo.dwMaximumWindowSize.X);
    end;
  end;
end.


Вернуться к списку функций

Наверх ▲