unit SWFile;

..........................................


var                        (* глобальные переменные для описания ошибок работы функции *)
  sOpenErr : string;
  IOpenErr : integer;
  IOResultLast : integer; //byte;
  sErrLast : string;

..........................................


function RARdRec1             (* ЧТЕНИЕ ЗАПИСИ ИЗ ЗАКРЫТОГО ФАЙЛА RA = Right Access *)
                 (Nam:string;   (* полное имя файла    *)
                  HeadSize,     (* размер заголовка    *)
                  RecSize,      (* размер записи       *)
                  I:longint;    (* номер треб.записи (счет с 1,а не с 0) *)
                  var V:TABt    (* адрес буфера чтения *)
                  ):boolean;
Const
  MBuf  = 10700000;   (* буфер, достаточный чтобы загрузить самый большой необходимый блок  *)
  MBuf0 =     4096;   (* объём памяти, который может быть прочитан за одну операцию         *)
                      (*   BlockRead ограничен, поэтому будем заполнять MBuf "кусочками"    *)

Type
  TBuf = array [1..MBuf] of byte; (* описание области памяти, куда будем читать *)
  TPBuf = ^TBuf;

  var
    F        : file;    (* файл без определения его типа данных *)
    LL       : longint; (* размер (объём) файла                 *)
    LData    : longint; (* объём файла без хидера               *)
    L1       : longint; (* позиция начала чтения блока          *)

    IRes     : integer;
    NRec     : integer;
    PP       : TPBuf;   (* указатель, под который выделим память буфера *)
    sErr     : string;

    L2       : longint; (* стартовая позиция в массиве VV *)
                        (* при попытке читать "кусочками" *)
    NPart    : integer; (* число "кусочков"               *)
    JPart    : integer; (* порядковый номер кусочка       *)
    NLast    : longint; (* размер последнего кусочка      *)
    RecSize1 : longint; (* *)

  begin

    RARdRec1 := false;  (* в случае Exit будет понятно, что чтение не удалось *)

    (* входные проверки *)
    (*------------------*)
    if RecSize > MBuf then begin
      sErr := 'RARdRec1 ERR: RecSize='+ISt(RecSize)+
              ' > BufferSize='+ISt(MBuf);
      swFile.sErrLast := sErr;
      WarnAbs(sErr);
      IOResultLast := 998;
      Exit;
    end
    else
    if RecSize = 0 then begin
      sErr := 'RARdRec(<'+Nam+'>) ERR: I='+ISt(I)+' RecSize=0!!! '+
              ' BufferSize='+ISt(MBuf);
      swFile.sErrLast := sErr;
      WarnAbs(sErr);
      IOResultLast := 996;
      Exit;
    end;

    if Nam = '' then begin
      sErr := 'proc swFile.RARdRec1 вызвана с пустым именем файла!';
      WarnAbs(sErr);
      IOResultLast := 990;
      Exit;
    end;


    Assign(F,Nam); (*$I-*) Reset(f,1); (*$I+*)  (* связываем файл с именем Nam с файловой переменной F *)
    IOResultLast := IOResult;
    if IOResultLast <> 0 then Exit;             (* не удалось связать *)


    LL := FileSize(F); LData := LL - HeadSize; NRec := LData div RecSize;

    if Not QIn(I,1,NRec+1) then begin
      Close(f);
      sErrLast := 'RARdRec I='+ISt(I)+' Not in [1..'+ISt(NRec)+']';
      Exit;
                                end;(*+1 для случая, когда посл.зап.не полная*)

    L1 := HeadSize + RecSize*(I-1);

    GetMem(PP,RecSize);  (* выделить динамическую память *)

    if RecSize > MBuf0 then begin
      (* попытаемся прочитать "кусочками" *)

      (* сначала определим, не упираемся ли мы в конец файла *)
      if (LL - L1) < RecSize then RecSize1 := LL - L1
                             else RecSize1 := RecSize;

      Seek(F,L1);

      L2 := 1;
      NPart := RecSize1 div MBuf0;
      for JPart := 1 to NPart-1 do begin
        BlockRead(F,PP^[L2],MBuf0,IRes);
        inc(L2,MBuf0);
      end;
      NLast := RecSize1 - (NPart - 1) * MBuf0;
      BlockRead(F,PP^[L2],NLast,IRes);
    end
    else begin
      Seek(F,L1); BlockRead(F,PP^[1],RecSize,IRes);
      if IRes < RecSize then FillChar(PP^[IRes+1],RecSize-IRes,#0);
    end;

    Close(F);


    move(PP^[1],V[0],RecSize); (* перемещаем данные из буфера в динамической памяти в тело переменной V *)

    FreeMem(PP,RecSize);


    sErrLast := '';
    RARdRec1 := true;
  end;