(* Short demonstration procedures about using Concord filebase O.O1 Gamma-2 *)
(* Written by Pasi Talliniemi on 21-May-95. Document has not been tested... *)
(* Procedures are self explaining, no further comments needed. Questions    *)
(* should be addressed to the author either via Fidonet or Internet e-mail. *)

var

  Cfg:              ConfigRec;        (* Read this from CONFIG.DAT ..... *)
  HdrFile:          File;             (* ABCDEFGH.HDR header file ...... *)
  TxtFile:          File;             (* ABCDEFGH.TXT description file . *)
  FileListHdr:      FileListRec;      (* Current record in file list ... *)
  FileListDesc:     Array [0..1024] of Char; (* Current file description *)
  FileListUploader: Array [0..35] of Char; (* Uploader of current file . *)

Function ReturnFileDatabaseName (FArea: FAreaRec): PathStr;
(* Function AddSlash returns directory name appended by a backslash \ *)
(* Function NumToHex returns longint value in 8 char long hexa number *)
(* Function CRC_32 returns CRC-32 value of given string ............. *)
(* Function Capit returns given string in uppercased format ......... *)
begin
  if FArea.Basename <> '' then begin
    ReturnFileDatabaseName := AddSlash (Cfg.Paths.FilebasePath) +
                              FArea.Basename;
  end else begin
    ReturnFileDatabaseName := AddSlash (Cfg.Paths.FilebasePath) +
                              NumToHex (CRC_32 (Capit (FArea.Name)));
  end;
end;

Function OpenFileBase (FArea: FAreaRec): Integer;
var Fname: PathStr;
    IOErr: Integer;
begin
  Fname := ReturnFiledatabaseName (FArea);
  Filemode := 66; (* Read/Write, Denynone *)
  Assign (HdrFile, Fname + '.HDR');
  Assign (TxtFile, Fname + '.TXT');
  {$I-} Reset (HdrFile, SizeOf (FileListRec)); {$I+} IOErr := IOResult;
  if IOErr <> 0 then begin
    OpenFileBase := IOErr;
  end else begin
    {$I-} Reset (TxtFile, 1); {$I+} IOErr := IOResult;
    if IOErr <> 0 then begin
      OpenFileBase := IOErr;
      Close (HdrFile);
    end else begin
      OpenFileBase := 0;
    end;
  end;
end;

Function CloseFileBase: Integer;
begin
  {$I-}
  Close (HdrFile);
  Close (TxtFile);
  {$I+}
  CloseFileBase := IOResult;
end;

Function FileListCnt: LongInt;
begin
  {$I-} FileListCnt := FileSize (HdrFile); {$I+}
  if IOResult <> 0 then begin
    FileListCnt := 0;
  end;
end;

Function ReturnFileListHdr (N: LongInt): Boolean;
var Num: Word;
begin
  ReturnFileListHdr := False;
  if (N >= 1) and (N <= FileListCnt) then begin
    {$I-}
    Seek (HdrFile, N - 1);
    BlockRead (HdrFile, FileListHdr, 1, Num);
    {$I+}
    ReturnFileListHdr := (Num = 1) and (IOResult = 0);
  end;
end;

Function ReturnFileListDesc: Boolean;
var Num: Word;
begin
  {$I-}
  Seek (TxtFile, FileListHdr.DescPtr);
  BlockRead (TxtFile, FileListDesc, FileListHdr.DescRecLen, Num);
  {$I+}
  ReturnFileListDesc := (Num = FileListHdr.DescRecLen) and (IOResult = 0);
end;

Function ReturnFileListUploader: Boolean;
var Num: Word;
begin
  {$I-}
  Seek (TxtFile, FileListHdr.DescPtr + FileListHdr.DescRecLen);
  BlockRead (TxtFile, FileListUploader, FileListHdr.UpldrLen, Num);
  {$I+}
  ReturnFileListUploader := (Num = FileListHdr.UpldrLen) and (IOResult = 0);
end;

Function SaveFileList (N: LongInt): Boolean;
var Num1, Num2, Num3: Word;
begin
  SaveFileList := False;
  if (N >= 1) and (N <= FileListCnt + 1) then begin
    {$I-}
    Seek (HdrFile, N - 1);
    BlockWrite (HdrFile, FileListHdr, 1, Num1);
    Seek (TxtFile, FileListHdr.DescPtr);
    BlockWrite (TxtFile, FileListDesc, FileListHdr.DescRecLen, Num2);
    BlockWrite (TxtFile, FileListUploader, FileListHdr.UpldrLen, Num3);
    {$I+}
    SaveFileList := (Num1 = 1) and (Num2 = FileListHdr.DescRecLen)
                and (Num3 = FileListHdr.UpldrLen) and (IOResult = 0);
  end;
end;

Function AddFileList: Boolean;
begin
  FileListHdr.DescPtr := FileSize (TxtFile);
  AddFileList := SaveFileList (FileListCnt + 1);
end;

(* End of document *)