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

 

 

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

 

С вашего позволения я продолжаю ;O)

  

Немного мудреней получился метод позиционирования rSeek, который должен устанавливать указатель вложенного файла на заданную позицию Pos. Но перед этим он выполняет проверку, если заданная позиция представляет собой отрицательное число, то такая позиция непригодна и позиционирование осуществляется на начало вложения. Если же заданная позиция превышает размер вложения, то это уж ни в какие ворота не лезет, и позиционирование осуществляется на конец вложения. Тут нужно быть аккуратным, так как последующее чтение данных из вложения может позволить прочесть заголовок следующего вложения, либо вызвать ошибку чтения за пределами XMS-буфера. Иначе позиционирование проводится в соответствии с указаниями.

 

procedure TResource.rSeek( var f; Pos : longint );

var af : TFile absolute f;

if Pos < 0 then Pos := 0;

if Pos > af.FSize then Pos := af.FSize;

af.FPos := Pos;

 

Пока вы самостоятельно изучаете следующий метод, я спокойно сделаю паузу, съем Twix и запью горячим чаем с лимоном ;o)

 

function TResource.rFileSize( var f ) : longint;

var af : TFile absolute f;

rFileSize := af.FSize;

 

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

  

В зависимости от размещения ресурсного файла может быть выполнена вложенная процедура rBlockReadXMS, которая копирует ACount байт из XMS-буфера начиная с начала размещения ресурсного файла FResOfs плюс смещение читаемого вложения af.FOfs в нем и плюс заданная позиция af.FPos. Для чтения с диска будет выполнена процедура rBlockReadDisk, которая составлена на столько традиционным для моих статей образом, что в пояснении нуждается лишь строка Seek( bf, FResOfs + af.FOfs + af.FPos ). Данная операция, несмотря на такое длинное арифметическое выражение, выполняет позиционирование указателя ресурсного файла на начало читаемого вложения af.FOfs плюс его текущая позиция af.FPos. При этом значение FResOfs, еще при создании экземпляра объекта, для режима загрузки FResType=rtDisk получило нулевое значение, и указано лишь для сохранения аналогии в обоих вложенных процедурах, хотя с точки зрения оптимизации можно было фрагмент “FResOfs+” из данного выражения убрать.

  

В обеих процедурах значение поля FPos файловой переменной увеличивается на размер прочитанных данных.

 

procedure TResource.rBlockread( var f, DosBuf; ACount : word; var Result : word );

var af : TFile absolute f;

 

 {чтение из ресурсного файла, загруженного в XMS}

 procedure rBlockReadXMS;

 moveXMSToMem( FResBuf, DosBuf,

           FResOfs + af.FOfs + af.FPos, ACount );

 Result := ACount;

 af.FPos := af.FPos + ACount;

 

 {чтение из ресурсного файла на диске}

 procedure rBlockReadDisk;

 var bf : file;

 Assign( bf, FName ); {$I-}

 Reset( bf, 1 ); {$I+}

 FIoResult := IOresult;

 if FIoResult <> 0 then exit;

 Seek( bf, FResOfs + af.FOfs + af.FPos );

 blockread( bf, DosBuf, ACount, Result );

 af.FPos := af.FPos + Result;

 Close( bf );

 

if FResType = rtXMS then rBlockReadXMS

    else rBlockReadDisk;

 

Завершающий метод простой до смешного ;O) И в самом деле, что нам закрывать, если мы ничего не открывали.

 

procedure TResource.rClose( var f );

 

С объектом для ресурсных файлов мы разобрались. А если кто-то еще не все понял из выше сказанного, пишите мне по адресу: Интернетовская область, деревня Гадюкино, последняя хата с краю, Амониту Исааковичу ;O)

  

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

  

Осталось рассмотреть подпрограмму, которая бы выполняла добавление файла с именем AddFileName в создаваемый или уже существующий ресурсный файл ResFileName. Это будет функция, возвращающая нулевое значение при успешно выполненной работе, иначе любое другое значение будет означать код ошибки.

  

В рассматриваемом блоке все настолько напоминает многое из того, что вы уже могли видеть, что я объясню лишь вкратце. Во-первых, следует проверить наличие необходимого объема свободной памяти для буфера копирования, иначе и не стоит затевать всю эту кутерьму. Во-вторых, пытаемся открыть файл, претендующий на перспективу быть вложенным. Если все проходит гладко, то пытаемся открыть еще и ресурсный файл. Если он к этому времени уже существует, то позиционируем его указатель в конец, чтобы затем добавить очередной заголовок и файл, а если ресурсного файла нет, то создаем его. Затем следует выделение памяти под временный буфер Buf для копирования. После этого определяем размер вкладываемого файла и заполняем переменную Rec данными о нем – заголовок готов. Далее следует запись заголовка и содержимого добавляемого файла в ресурсный файл. Освобождаем память. Аминь.

 

function AddFileToResource( ResFileName, AddFileName : string ) : word;

const arsize = SizeOf( TArrByte );

var rf, af : file;

       err, d, count : word;

       long : longint;

       Rec : TResFileRec;

       buf : ^TArrByte;

AddFileToResource := 0;

if MaxAvail < arsize then begin

   AddFileToResource := 203;

   exit;

   end;

Assign( af, AddFileName ); {$I-}

Reset( af, 1 ); {$I-}

err := IOresult;

if err <> 0 then begin

   AddFileToResource := err;

   exit;

   end;

Assign( rf, ResFileName ); {$I-}

Reset( rf, 1 ); {$I+}

err := IOresult;

if err <> 0 then Rewrite( rf, 1 )

   else Seek( rf, FileSize( rf ) );

GetMem( buf, arsize );

long := FileSize( af );

Rec.FileName := AddFileName;

Rec.ID := ResSignature;

Rec.FOfs := FileSize( rf ) + tsize;

Rec.FSize := long;

blockwrite( rf, Rec, tsize, d );

 

 if long < arsize then count := long

    else count := arsize;

 blockread( af, buf^, count, d );

 blockwrite( rf, buf^, count, d );

 long := long – d;

until long <= 0;

Close( af );

Close( rf );

FreeMem( buf, arsize );

 

 

Вот собственно и весь модуль. Честно говоря, все, что было описано выше, временами напоминало фарс ;O)

  

Ну да ладно. Это все была присказка, а сказочка еще впереди. Осталось написать программу добавления файла в ресурс. Состоит она из проверки количества указанных параметров в командной строке. Первым параметром должно идти имя ресурсного файла, например “MYDATA.RES”, а вторым имя добавляемого файла, например “MYFONT1.FNT”. Если указано два параметра, то выполняется функция добавления, и вся основная работа ложится на модуль.

 

Program AddRes;

Uses ResFiles;

 

if ParamCount<2 then begin

   writeln('Resource file creator');

   writeln('Usage: addres.exe [resource file] [file for add]');

   halt;

   end;

if AddFileToResource(ParamStr(1),ParamStr(2))<>0

   then writeln('Addiding error.');

 

Перед рассмотрением следующей и последней на этот раз программы, взываю к вашей памяти и прошу припомнить одну из предыдущих статей под названием “Работаем с текстовым режимом” из данного цикла. В ней шла речь о текстовых режимах дисплея, и упоминалось о том, как при помощи функции InstallFont модуля VESACRT.PAS можно устанавливать собственные шрифты для отображения текста на экране.

  

Так вот сейчас я продемонстрирую, как можно подгружать и устанавливать шрифты из ресурсного файла. Для начала следует создать ресурсный файл, например с именем 'fonts.res', и добавить в него пять шрифтов, имена которых специально перечислены в константе Font, чтобы затем поименно их загружать по очереди. Ранее, я уже рассказывал, где можно взять такие шрифты. Собственно, единственное существенное изменение претерпела функция InstallFont, которая теперь будет называться InstallFontFromResource, где вместо обращений к обычному файлу шрифта применен способ загрузки его из ресурса Res^. Следует заметить, что в вызовах методов rAssign, rReset, rSeek, rBlockread и rClose указана обычная файловая переменная, объявленная с идентификатором стандартного типа File. Это вполне допустимо, так как в данном случае файловая переменная используется только для доступа к вложению, и не может служить для получения информации о файле через обращение к полям данной структуры. Как это может быть вопреки всем правилам? Пускай это останется моим маленьким секретом ;O)

  

В начале главного блока программы проводится проверка наличия загруженного XMS-драйвера. Затем выполняется строка New( Res, Create( 'fonts.res', rtXMS)), создающая экземпляр объекта Res для работы с ресурсным файлом и выполняющая одновременную загрузку оного из файла 'fonts.res' в XMS, так как указана константа rtXMS в качестве второго параметра.

 

Uses VesaCrt, Keyboard, ResFiles, XMS;

 

const MaxFont = 4;

          Font : array [0..MaxFont] of string =

                  ( 'latrus1.fnt', 'latrus2.fnt',

       'vg.fnt', 'latrus4.fnt', 'year2000.fnt' );

 

var d, mode, key, FontIndex : word;

       Res : ^TResource;

       AFile : TFile;

 

procedure GetMem( var p; Size : word );

var PP : pointer absolute p;

PP := nil;

if MaxAvail < Size then exit;

System.GetMem( PP, Size );

 

function InstallFontFromResource( FileName : string; FirstChar, CharCount, BytePerChar : word ) : word;

type TBuf = array [0..20*256] of byte;

var Buf, Buf2 : ^TBuf;

       f : file;

       d, j : word;

       k : real;

InstallFontFromResource := 0;

GetMem( Buf, 256*BytePerChar );

if Buf = nil then begin

   InstallFontFromResource := 203; exit; end;

GetMem( Buf2, 256*Screen.CharBytes );

if Buf2 = nil then begin

   InstallFontFromResource := 203;

   FreeMem( Buf, 256*BytePerChar );

   exit;

   end;

Res^.rAssign( f, FileName );

Res^.rReset( f );

d := Res^.rIOResult;

if d <> 0 then begin

   InstallFontFromResource := d;

   FreeMem( Buf2, 256*Screen.CharBytes );

   FreeMem( Buf, 256*BytePerChar );

   exit;

   end;

Res^.rSeek( f, 2 );

Res^.rBlockread( f, Buf^, 256*BytePerChar, d );

Res^.rClose( f );

if Screen.CharBytes = BytePerChar then

   SetCharTable(Buf^[FirstChar*BytePerChar],

        FirstChar, CharCount, Screen.CharBytes )

   else begin

   k := BytePerChar/(Screen.CharBytes-1);

   for d:=0 to 255 do

     for j:=0 to Screen.CharBytes-1 do

              Buf^[d*BytePerChar+trunc(k*j)];

   SetCharTable(Buf2^[FirstChar*Screen.CharBytes],

        FirstChar, CharCount, Screen.CharBytes );

   end;

FreeMem( Buf2, 256*Screen.CharBytes );

FreeMem( Buf, 256*BytePerChar );

 

procedure SetFont;

if InstallFontFromResource( Font[ FontIndex ],

      0, 256, 8 ) > 0 then

   if SetTextMode( 0 ) then begin

      Dispose(Res,Free);

      writeln( 'Bad font index ', FontIndex );

      halt;

      end;

 

procedure NextMode;

if mode < 5 then Inc( mode )

   else mode := 0;

if not SetTextMode( mode ) then begin

   Dispose(Res,Free);

   writeln( 'Bad screen mode' );

   halt;

   end;

SetFont;

SetCurSize( 0, Screen.CharHeight-1 );

end;

 

procedure NextFont;

if FontIndex < MaxFont then Inc( FontIndex )

   else FontIndex := 0;

SetFont;

 

function IntToStr( value : longint ) : string;

var s : string;

Str( value, s );

IntToStr := s;

 

mode := 0;

FontIndex := 0;

if not InitXMS then begin

   writeln( 'XMS driver not found.' );

   halt;

   end;

Res := nil;

New( Res, Create( 'fonts.res', rtXMS ) );

if Res = nil then begin

   writeln( 'Create object error.' );

   halt;

   end;

if not SetTextMode( mode ) then begin

   Dispose(Res,Free);

   writeln( 'Bad screen mode' );

   halt;

   end;

SetCurSize( 0, Screen.CharHeight-1 );

SetFont;

 FillScr( ' ', clWhite, clLightGray );

 SetTextColor( clWhite );

 TextOut( 0, 1,'Hello украинцы!' );

 TextOut( 0, 2,'Режим: ' + IntToStr( mode ));

 TextOut( 0, 3,'Current Font: '+Font[FontIndex]);

 TextOut( 0, 5,'Files:' );

 for d := 0 to Res^.Count-1 do begin

       Res^.GetFile( d, AFile );

       TextOut( 0, d + 7, 'File ' + IntToStr(d) +

         ' : ' + AFile.Name + ' , ' +

         IntToStr( AFile.Index ));

       end;

 for d := 0 to 127 do

       TextOut( d, Screen.MaxY-3, char( d ));

 for d := 128 to 255 do

       TextOut( d-128, Screen.MaxY-1, char( d ));

 key := waitkey;

 if key = VK_Enter then NextMode;

 if key = VK_Space then NextFont;

until key = VK_Esc;

Dispose(Res,Free);

if SetTextMode( 0 ) then;

 

Программа работает таким образом, что при каждом нажатии клавиши “пробел” будет меняться шрифт от первого в списке константы Font и до последнего, и снова с первого и так по кругу. На экране будет отображаться информация о номере текущего текстового режима, изменять который можно нажатием клавиши ENTER. Помимо этого, будет выводиться информация о названии текущего шрифта, и даже список всех имеющихся шрифтов в ресурсном файле. При этом доступ к информации о вложенном файле будет осуществляться при помощи вызова метода Res^.GetFile(d, AFile), где переменная AFile, объявленная с идентификатором TFile, получает данные о файле, и эти данные могут быть доступны через поля этой переменной. Завершить выполнение программы можно нажатием клавиши ESCAPE.

  

Вот, собственно, так легко можно использовать ресурсные файлы системы Amonit ;O)

 

 

 

Журнал > Программирование > Паскаль для новичков (Turbo Pascal, Assembler) > Паскаль для новичков (часть 34): Ресурсные файлы 2 (продолжение)