АРХИВ СТАТЕЙ ЖУРНАЛА «МОЙ КОМПЬЮТЕР» ЗА 2002 ГОД

Мысли о Паскале

Все журналы \ Номер 34/205 `2002 от 02.09.2002 \ Мысли о Паскале

Владислав ДЕМЬЯНИШИН nitromanit@mail.ru

(Продолжение, начало см. МК № 46, 51—52, 4, 6—7, 10, 12—13, 16—18, 22, 24, 29 (165, 170—171, 175, 177—178, 181, 183—184, 187—189, 193, 195, 200))

Спрашивали? Отвечаю…

Вот, опять отвечаю на письма читателей. Должен сказать, что они зря времени не теряют: находят себе задачи, пытаются из решить. А когда сталкиваются с трудностями, вполне естественно, что не прочь поискать у кого-нибудь совета. Например, у меня :-).

Вот на два таких письма я и хочу сейчас ответить. И хотя авторы этих писем уже получили мой ответ по электронной почте, я счел возможным поделиться информацией со всеми читателями в надежде, что она им покажется любопытной.

Запуск независимых программ из Pascal-программы

Нужно из Pascal-программы запускать другую программу, и при этом необходимо иметь доступ к динамически распределяемой памяти, а это практически невозможно, так как для большинства запускаемых программ следует освобождать максимум памяти с помощью директивы {$M $4000,0,0}.

Проблема состоит в том, что при запуске Pascal-программы встроенными средствами модуля system.pas изначально устанавливается размер стека и хипа в соответствии с установками директивы $M.

Обойти такое ограничение можно, описав процедуры DOSGetMem и DOSFreeMem и с их помощью запрашивая память непосредственно у MS-DOS. При этом интерфейс этих процедур идентичен интерфейсу стандартных процедур GetMem и FreeMem модуля system.

{$M 4000,0,0}
{$G+}
uses Dos;
const BufSize = 65000;
type TBuf = array [0..BufSize-1] of byte;
    PBuf = ^TBuf;
var List1, List2 : PBuf;
    j : word;

procedure DOSGetMem (var p; size : word); assembler;
asm
 mov ah,48h; mov bx,size; shr bx,4; inc bx; int 21h; jc @err
 mov bx,ax; les di,p; xor ax,ax; stosw; mov ax,bx; stosw; jmp @end
@err:
 les di,p; xor ax,ax; stosw; stosw
@end:
end;

procedure DOSFreeMem (var p; size : word); assembler;
asm
 push ds; lds si,p; lodsw; lodsw; mov es,ax; mov ah,49h
 int 21h; pop ds; les di,p; xor ax,ax; stosw; stosw
end;

begin
SwapVectors;
exec('alchemy.exe','*.bmp -v');
SwapVectors;
List1 := nil;
DOSGetMem (List1, sizeof(TBuf));
if List1 = nil then begin
  writeln('Not enough memory for List1');
  halt;
  end;
List2 := nil;
DOSGetMem(List2, sizeof(TBuf));
if List2 = nil then begin
  writeln('Not enough memory for List2');
  DOSFreeMem(List1, sizeof(TBuf));
  halt;
  end;
{ контрольный выстрел :-)) }
{ инициализируем массив List1 }
for j := 0 to BufSize-1 do List1^[j] := random(255);
{ копируем массив List1 в List2 }
for j := 0 to BufSize-1 do List2^[j] := List1^[j];
DOSFreeMem(List2, sizeof(TBuf));
DOSFreeMem(List1, sizeof(TBuf));
SwapVectors;
exec('alchemy.exe','*.bmp -v');
SwapVectors;
end.

Ну с директивой $M, кажется, все понятно — стек 4000 байт и размер хипа 0 копеек :-).

Директива $G+ нужна для включения компиляции машинных команд процессора i80286.

Что касается процедур DOSGetMem и DOSFreeMem, то они составлены на ассемблере, и лично меня вид их блоков не устраивает, так как мне больше нравится строить ассемблерные команды в столбик. Но исходя из формата статьи пришлось оставить так как есть, что, собственно, вполне допустимо в Turbo Pascal.

Процедура DOSGetMem вызывает документированную функцию MS-DOS по отведению (выделению) блока памяти, размер которого задается в 16-байтовых параграфах в регистре BX. Поэтому в теле процедуры стоит команда установки номера функции в регистр AX —mov ah,48h; младшей половиной AL регистра AX можно пренебречь. Потом идет команда mov bx,size, а за ней shr bx,4 — тем самым мы заносим размер блока в регистр BX и делим его на 16 путем логического сдвига на 4 бита. Затем следует команда inc bx, чтобы получить память с запасом — если запросить, например 1000 байт, то при делении на 16 получится 62 параграфа, и в итоге MS-DOS выделит 62 параграфа по 16 байт, что равно 992 байтам, а нам ведь нужно не меньше 1000 байт. Наконец, команда int 21h вызывает функцию отведения памяти.

В случае неудачного выполнения функции устанавливается флаг переноса, а в регистре AX будет находиться код ошибки: 7 — испорчен управляющий блок памяти; 8 — недостаточно памяти для выполнения функции. Тогда выполнится команда jc @err условного перехода на метку @err, а командами les di,p; xor ax,ax; stosw; stosw сформируется nil-значение указателя p.

В случае успеха получаем номер сегмента выделенного блока памяти в регистре AX и заносим его в указатель p, а смещение устанавливаем равным нулю, так как MS-DOS всегда выравнивает выделенный блок памяти по границе параграфа.

С функцией DOSFreeMem еще проще. Нужно лишь указать номер сегмента выделенного блока в регистр ES и вызвать функцию освобождения блока int 21h, предварительно установив mov ah,49h с номером функции в регистре AX. Для тех, кто еще не знает: в ассемблере числовое значение, заканчивающееся латинской буквой h, считается шестнадцатеричным числом. При неудачном вызове этой функции будет установлен флаг переноса, и в регистре AX появится код ошибки: 7 — см. выше; 9 — неверный адрес блока памяти. Этим можно пренебречь, просто установив значение указателя в nil.

Теперь что касается вызовов стандартной процедуры SwapVectors модуля dos.pas. Вызывая ее перед процедурой Exec, мы восстанавливаем системное окружение для запускаемой программы. А затем снова восстанавливаем привычное для Turbo Pascal окружение для нормальной работы нашей программы.

Таким образом, используя процедуры DOSGetMem и DOSFreeMem, мы можем успешно запустить такую прожорливую программу как графический визуализатор-конвертер alchemy.exe, который занимает 1021 Кб дискового пространства и нашпигован оверлеями. Запустив ее с ключем *.bmp -v, мы сможем просмотреть все BMP-файлы, находящиеся в текущей директории.

Ну а где функции DOSGetMem и DOSFreeMem, там и DOSMaxAvail, которая возвращает размер наибольшего доступного блока памяти. Эта функция использует уже известную нам функцию отведения блока, но запрашивает слишком много памяти 0FFFFh параграфов, что эквивалентно 1048560 байтам. Естественно, что функция MS-DOS на такую неслыханную наглость ответит ошибкой, но при этом в регистр BX занесет размер наибольшего доступного блока. Нам лишь остается это значение умножить на 16 и преобразовать в longint.

Копирование файлов

Среди стандартных возможностей Turbo Pascal имеются процедуры удаления и переименования файлов, но нет процедуры копирования файла или группы файлов. Вот на этот недостаток и обратил мое внимание читатель Павел.

Есть два способа решения этой задачи.

Первый способ очень прост и напрашивается сам собой. Он основан на использовании функции COPY командного процессора command.com. Таким образом с помощью стандартной процедуры Exec можно запустить вторичный командный процессор и передать ему в качестве параметра строку с необходимой командой, при этом предварив ее ключом /c, иначе командный процессор запустится, но строку параметров не воспримет должным образом, и появится запрос операционной системы. При этом можно будет вводить любую команду MS-DOS, а для завершения сеанса командного процессора и возвращения в Pascal-программу достаточно ввести команду EXIT. Иначе говоря, ключ /c обеспечит нормальное выполнение команды MS-DOS, незамедлительное завершение сеанса командного процессора и возврат управления Pascal-программе. Как раз то, что нам нужно.

А вот и необходимая нам функция копирования файлов:

Функция GetEnv возвратит путь к командному процессору, хранящийся в переменной окружения COMSPEC. Можно, конечно, указать и так: exec(‘c:\command.com’,…), но этот способ не универсален. Параметр SourceFileName должен содержать имя (маску, например, —*.*) исходного файла. Параметр DestFileName должен содержать новое имя файла или путь, куда следует сделать копию, например, d:\.

В конце выполнения функции CopyFile считываем значение переменной DosError модуля dos. Вот пример использования функции CopyFile:

Ко всему этому хочу добавить, что, несмотря на кажущуюся простоту, у данного способа копирования файлов есть два серьезных недостатка. Первый — при возникновении ошибки копирования переменная DosError все равно возвратит нулевое значение. И лишь при неудаче запуска самого командного процессора может вернуть код ошибки 8 («Недостаточно памяти»). Второй — мы опять сталкиваемся с проблемой размера хипа, что вынуждает нас для выделения памяти под динамические переменные использовать процедуры DOSGetMem и DOSFreeMem.

Есть, правда, небольшое утешение — командный процессор command.com может запуститься при установке директивы {$M 4000, 390000,390000} (при 519 Кб свободной памяти), но опять-таки это не универсальный способ.

Второй способ, так сказать, бескровный — несмотря на некоторую усложненность своей реализаци, он обеспечивает возможность использования привычного для большинства программистов Turbo Pascal со стандартным интерфейсом выделения/освобождения памяти под динамические переменные. Данный способ основан на работе с файлами прямого доступа, или нетипизированными файлами. Речь идет не о каких-то особых файлах, а о режиме прямого доступа к любому файлу. Режим прямого доступа к файлу предполагает, что данные файла организованы в виде записей фиксированной длины. Для удобства установим размер записи, равный одному байту, используя конструкции reset(InFile, 1) и rewrite(OutFile, 1). Вначале функция CopyFile2 производит разбор пути копирования и в случае его отсутствия возвращает ошибку, а если указан только путь, то формирует полное имя создаваемого файла из имени исходного и указанного пути получателя. Далее происходит открытие исходного файла и определение его размера в записях, а так как размер записи мы установили в один байт, то получаем размер файла в байтах. Затем производится ревизия свободного дискового пространства на получателе, и если его объема достаточно, то создается файл на получателе. Затем следует repeat-цикл, копирующий файл по порциям.

function CopyFile2 (SourceFileName, DestFileName : string) : word;
const BufSize = 1024;
var buf : array [1..BufSize] of byte;
  Infile, OutFile : file;
  d, res, trans : word;
  writed, Count, space, FTime : longint;
  Drive : char;
  Dir : DirStr;
  Ext : ExtStr;
  FileName : NameStr;
  Path : PathStr;

function ExtractFileDrive(FileName : string) : char;
 var j : word;
 begin
 ExtractFileDrive := '@'; {Default drive}
 j := pos(':', FileName);
 if j = 0 then exit;
 ExtractFileDrive := FileName[j-1];
 end;

begin
CopyFile2 := 0;
FSplit(DestFileName, Dir, FileName, Ext);
if Dir = '' then begin
  if FileName = '' then begin CopyFile2 := 3;exit;end;
  end
  else if FileName = '' then begin
       DestFileName := Dir;
       FSplit(SourceFileName, Dir, FileName, Ext);
       DestFileName := DestFileName + FileName + Ext;
       end;
assign(InFile, SourceFileName); {$I-}
reset(InFile, 1);
res := IOResult;
if res <> 0 then begin CopyFile2 := res;exit;end;
Count := filesize(InFile);
Drive := ExtractFileDrive(DestFileName);
 case Drive of
  'a'..'z' : space := diskfree(1+byte(Drive)-byte('a'));
 'A'..'Z' : space := diskfree(1+byte(Drive)-byte('A'));
else space:=diskfree(0);
 end;
if space < Count then begin CopyFile2 := 5;exit;end;
GetFTime(InFile, FTime);
assign(OutFile, DestFileName);
rewrite(OutFile, 1);
res := IOResult;
if res <> 0 then begin CopyFile2 := res;exit;end;
writed := 0;
repeat
 trans := BufSize;
 if Count-writed < BufSize then trans := Count-writed;
 blockread(InFile, buf, trans, d);
 res := IOResult;
 if res <> 0 then begin CopyFile2 := res;exit;end;
 if d < trans then begin CopyFile2 := 100;exit;end;
 blockwrite(OutFile, buf, trans, d);
 res := IOResult;
 if res <> 0 then begin CopyFile2 := res;exit;end;
 if d < trans then begin CopyFile2 := 101;exit;end;
 writed := writed + trans;
until writed >= Count;
close(InFile);
SetFTime(OutFile, FTime);
close(OutFile); {$I+}
end;

В данной функции предусмотрено копирование файла с сохранением даты его создания. На каждом этапе выполнения функции производится проверка возникновения ошибок.

Пожалуй, единственным недостатком такого способа копирования файла является невозможность копирования групп файлов по маске. Но это легко поправимо, если на базе функции CopyFile2 написать функцию копирования групп файлов по маске с применением стандартных процедур FindFirst и FindNext модуля dos. Еще не мешало бы предусмотреть приостановление выполнения копирования при нажатии клавиши Esc.

Наконец, для удобства все процедуры и функции, описанные выше, можно собрать в единый модуль, например, msdos.pas.

(Продолжение следует)

Литература

1. Р. Джордейн. Справочник программиста персональных компьютеров типа IBM PC, XT и AT. — М.: Финансы и статистика, 1992.

2. Диалоговая справочная система Norton Guide.

Рекомендуем ещё прочитать:

Порядочные алгоритмы. (№28/199 `2002) Владимир Ткачук
Мысли о Паскале. (№6/177 `2002) Владислав Демьянишин
Домашняя кухня: игры. (№30/201 `2002) Нет Автора
Сценарист GIMP, или учимся учиться. (№30/201 `2002) Александр Кузьмюк
Мысли о Паскале. (№34/205 `2002) Владислав Демьянишин
Прямой Х и открытый GL. (№47/218 `2002) Роман Савчук
Алгоритмы текстурирования. (№47/218 `2002) Davert
OpenGL и Delphi-2. (№48/219 `2002) Руслан Ризванов

Предыдущая статья Назад К списку журналов Следующая статья