Компьютерная диагностика двигателя автомобиля (адаптер К-линии)

Скачать игру Крыло-Гром (Wing-Thunder) бесплатно

Паскаль для новичков (часть 12)

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

Автор: Владислав Демьянишин

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

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

Запуск независимых программ из 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;

{ контрольный выстрел ;O) }

{ инициализируем массив 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 копеек ;O)

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

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

Процедура DOSGetMem вызывает документированную функцию MS-DOS по отведению (выделению) блока памяти размером в 16-байтовых параграфах в регистре BX. Поэтому в теле процедуры стоит команда установки номера функции mov ah,48h в регистр AX, и младшей половиной 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, считается 16-ричным числом. При неудачном вызове этой функции будет установлен флаг переноса и в регистре 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.

function DOSMaxAvail : longint; assembler;

asm

mov ah,48H; mov bx, 0FFFFh; int 21h;

mov dx,bx; shr dx,12; shl bx,4; mov ax,bx

end;

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

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

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

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

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

function CopyFile ( SourceFileName, DestFileName : string) : word;

begin

SwapVectors;

exec(GetEnv(' COMSPEC '),'/c copy ' + SourceFileName + ' ' +

DestFileName);

SwapVectors;

CopyFile := DosError;

end;

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

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

{$M 4000,0,0}

uses Dos;

var res : word;

s : string;

begin

res := CopyFile('D:TP6myprog.pas','a:');

case res of

0 : s := 'Ok';

2 : s := 'File not found';

3 : s := 'Path not found';

5 : s := 'Access denied';

6 : s := 'Invalid handle';

8 : s := 'Not enough memory';

10 : s := 'Invalid environment';

11 : s := 'Invalid format';

15 : s := 'Invalid drive';

18 : s := 'No more files';

100 : s := 'Read disk error';

101 : s := 'Write disk error';

150 : s := 'Disk write protected';

else s := 'Unknow error';

end;

writeln(s);

end.

Ко всему этому хочу добавить, что, несмотря на кажущуюся простату, у данного способа копирования файлов есть два серьезных недостатка. Первый – при возникновении ошибки копирования, переменная 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. – 543 с.

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

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

На нашем сайте можно не только бесплатно скачать игры, но и документацию и книги по программированию на MIDLetPascal, Turbo Pascal 6, Turbo Pascal 7, Borland Pascal, по программированию устройств Sound Blaster, Adlib, VESA BIOS, справочник Norton Guide и много другой полезной информации для программистов, включая примеры решения реальных задач по созданию резидентных программ.

Журнал > Программирование > Паскаль для новичков (Turbo Pascal, Assembler) > Паскаль для новичков (часть 12): Спрашивали? Отвечаю...

При использовании материалов сайта активная ссылка на http://sulfurzona.ru обязательна.

Весь оригинальный контент защищен сервисом Яндекс Вебмастер и сервисами проверки уникальности текста content-watch.ru, text.ru, advego.ru, etxt.ru, copyscape.com.