program deLbr;

{  The following notes are from the original "C" source file  }

(*
 * A program to extract all files from a "Novosielski" archive (foo.LBR)
 *
 * Jeff Martin, 10/9/82
 *
 * 11/24/89 - Increased library entries from 64 to 256.  (BP)
 *
 * 07/28/84 - Fixed AZTEC conditional defines.  (Tried it this
 *     time, instead of guessing). Removed DESMET stuff,
 *     as the Read() function dosen't always know how many
 *     bytes it has read!  That didn't work too well. <pjh>
 *
 * 06/10/84 - Kludged up to work with a variety of unix-like compilers.
 *     BUFFERING added. <pjh>
 *
 * 04/07/84 - reworked to compile under DeSmet 'C' Compiler
 *     for use under CP/M-86   Peter A. Polansky
 *
 * 01/01/83 - Bug in large LBR files removed. --JEC
 *
 * 11/12/83 - CP/M 68k version created.  Jim Cathey
 *
 * 01/03/83 - BDS version reworked to provide the generally-useful
 *     getldir() function --JCM
 *
 * 01/02/83 - BDS C version created --JCM
 *
 * 11/27/82 - Fixed bug that was causing one-sector files to
 *     be rejected as invalid directory entries  --JCM
 *)

const VERSION = '1.0  27-July-1998';
      MAXDIRENT = 256;             { Increased from 64 (BP) }
      TOOBIG = 1024;               { Assume dir is bad if > this many sectors }
      BUFFSIZ = 16384;             { be sure this is a multiple of 128 }
      ERR = (-1);

type anyStr = string[255];
     byteFile = file of byte;
     entType = record
                 fName: anyStr;
                 offs,
                 size: longint
               end;

var ndir, dirent, i: integer;
    filename: anyStr;
    fdi, fdo: file;
    buff: array[0..127] of char;
    dirEntries: array[0..256] of entType;

function toLower(c: char): char;
  begin
    if c in ['A'..'Z']
        then toLower := chr(ord(c) or $20)
      else toLower := c
  end;

procedure upString(var s: anyStr);
  var i: integer;
  begin
    for i := 1 to length(s)
      do s[i] := upCase(s[i])
  end;

procedure fskip(var f: byteFile; bytes: integer);
  var i: integer;
      dummy: byte;
  begin
    for i := 1 to bytes
      do read(f, dummy)
  end;

(*
 * Get .LBR directory  -- names, offsets, and sizes of entries in an LBR file.
 *
 *   The returned function value is the number of actual entries found,
 *    or ERR (if couldn't open file).
 *
 *  Input parameters:
 *
 *   fname - pointer to the string containing the full pathname of the LBR
 * file.
 *   maxent - maximum number of entries to get (i. e., usually the size of
 * the following arrays).
*)
function getldir(fname: anyStr; maxent: integer): integer;
  var lo, hi, byt: byte;
      c: char;
      ndir, dirent, nentry, i, j: integer;
      ostart, osize: longint;
      entryname: anyStr;
      dir: byteFile;
  begin
    assign(dir, fname);
    reset(dir);
    if eof(dir)
        then getldir := ERR
      else begin
        fskip(dir, 14);                    { Point to dir size }
        read(dir, lo, hi);
        ndir := (lo + (hi shl 8)) * 4;
        fskip(dir, 16);                    { Skip unused dir bytes }
        nentry := 0;                       { Init count of live entries }
        for dirent := 1 to ndir
          do begin
            read(dir, byt);
            if byt <> 0
                then fskip(dir, 31)        { Ignore defunct entries in dir }
              else begin
                entryname := '';
                for i := 1 to 8
                  do begin
                    read(dir, byt);
                    c := chr(byt and $7F);
                    c := toLower(c);
                    if c <> ' '
                        then entryname := entryname + c
                  end;
                entryname := entryname + '.';
                for i := 1 to 3
                  do begin
                    read(dir, byt);
                    c := chr(byt and $7F);
                    c := toLower(c);
                    if c <> ' '
                        then entryname := entryname + c
                  end;
                upString(entryname);
(*
  { Check for any no-no chars. }
  for (s = entryname; *s != '\0'; s++)
   if ( *s == ';' || *s == '*' || *s < ' ')
    *s = '.';
*)
                dirEntries[nentry].fName := entryname;
                { Determine where this file is in the archive }
                read(dir, lo, hi);
                ostart := lo + hi shl 8;
                dirEntries[nentry].offs := ostart;
                read(dir, lo, hi);
                osize := lo + hi shl 8;
                dirEntries[nentry].size := osize;
                fskip(dir, 16);            { Skip unused dir bytes }
                nentry := nentry + 1
              end
        end;
      close(dir);
      getldir := nentry
    end
  end;

begin
(*
    while (--argc > 0 && ( *++argv)[0] == '-') {
        for (s = argv[0]+1; *s != '\0'; s++) {
            switch ( *s) {
                default:
                    printf("Illegal Option: '%c'\n", *s);
                    argc = 0;
                    break;
            }
        }
    }
*)
  if ParamCount <> 1
      then begin
        writeln('delbr v', VERSION);
        writeln('Usage: deLbr filename(.LBR assumed)');
        writeln('Extract all files from a "Novosielski" archive.');
        halt(1)
      end;
(*
    if ((buf= malloc(BUFFSIZ)) == NULL) /* get memory for buffer */ {
        printf("Not enough memory.  MALLOC returned NULL\n");
        exit(0);
    }
*)
  filename := ParamStr(1);
  filename := filename + '.lbr';
  upString(filename);
  ndir := getldir(filename, MAXDIRENT);
  if ndir = ERR
     then begin
       writeln('Trouble getting directory from ', filename);
       halt(2)
     end;
  assign(fdi, filename);
  reset(fdi);
  { Really need to check 'IOResult'? }
  for dirent := 0 to ndir - 1
    do begin
(*
        if ((fdo = CRET(names[dirent], C_BWRITE)) == ERR) {
            printf("Cannot create %s.\n", names[dirent]);
            exit(2);
        }
*)
      assign(fdo, dirEntries[dirent].fName);
      rewrite(fdo);
      { Didn' bother to implement test for inability to open output file }
      writeln('Extracting: ', dirEntries[dirent].fName);
(*
        if (lseek(fdi, offsets[dirent], 0) == ERR) {
         printf("\nError seeking this entry - aborting.\n");
         exit(2);
        }
*)
      seek(fdi, dirEntries[dirent].offs);
      { Didn' bother to implement test for seek failure }
(*
        bytes= (long) sizes[dirent] * 128L;
        while (bytes != 0L) {
            if (bytes > (long) BUFFSIZ) {
                toRead= BUFFSIZ;
                bytes-= BUFFSIZ;
            }
            else {
                toRead= bytes;
                bytes= 0L;
            }
            if ((didRead= read(fdi, buf, toRead)) != toRead) {
                    printf("\nError reading this entry - aborting.  Read %u bytes\n",didRead);
                    exit (2);
            }
            if (write(fdo, buf, toRead) != toRead) {
                    printf("\nError writing this entry - aborting.\n");
                    exit (2);
            }
        }
*)
      for i := 1 to dirEntries[dirent].size
        do begin
          BlockRead(fdi, buff, 1);
          BlockWrite(fdo, buff, 1)
        end;
      close(fdo)
    end;
  writeln;
  close(fdi)
end.