{-----------------------------------------------------------------------------}
{                                                                             }
{  LoadRam - Copy files from floppy to RAM disk during system boot.           }
{                                                                             }
{       Scott Gray                      (C) Copyright 1986 Scott Gray         }
{       705 Linda Court                                                       }
{       Virginia Beach, Va. 23455                                             }
{       GENIE - S.A.GRAY                                                      }
{                                                                             }
{-----------------------------------------------------------------------------}

program LoadRam (INPUT, OUTPUT, P_FILE, E_FILE);

const
  Copyright             = '(C) Copyright 1986 Scott Gray';
  MAX_BUFFSIZE          = 16384;
  MAX_PARAMS            = 20;
  TE_filnotfou          = -33;
  TE_patnotfou          = -34;
  TE_nomorfil           = -49;

type
  varstr                = string[80];
  fixstr                = packed array [1..80] of char;
  filebuff_type         = packed array [1..MAX_BUFFSIZE] of char;
  filebuff_ptr          = ^filebuff_type;
  DTA_struc             = record
    reserved            : array [1..10] of integer;
    attrib              : integer;              { low order (second) byte }
    filetime            : integer;
    filedate            : integer;
    filesize            : long_integer;
    filename            : fixstr
  end;
  p_struc               = record
    param               : array [1..MAX_PARAMS] of varstr;
    cnt                 : integer
  end;

var
  P_REC                 : varstr;
  P_GROUP               : p_struc;
  ABORT                 : boolean;
  STATUS                : integer;
  DTA                   : DTA_struc;
  FILEBUFF              : filebuff_ptr;

  P_FILE, E_FILE        : text;

{-----------------------------------------------------------------------------}
{                                                                             }
{  External declarations ...                                                  }
{                                                                             }
{-----------------------------------------------------------------------------}

procedure IO_Check (b : boolean);
  External;

function IO_Result : integer;
  External;

function TOS_setdta (var dta : dta_struc) : integer;
  GEMDOS($1a);

function TOS_mkdir (var name : fixstr) : integer;
  GEMDOS ($39);

function TOS_create (var name : fixstr; attributes : integer) : integer;
  GEMDOS ($3C);

function TOS_open (var name : fixstr; mode : integer) : integer;
  GEMDOS ($3D);

function TOS_close (handle : integer) : integer;
  GEMDOS ($3E);

function TOS_read (handle : integer; buflen : long_integer;
                   buffer : filebuff_ptr) : long_integer;
  GEMDOS ($3F);

function TOS_write (handle : integer; buflen : long_integer;
                    buffer : filebuff_ptr) : long_integer;
  GEMDOS ($40);

function TOS_sfirst (var filnam : fixstr; attrib : integer) : integer;
  GEMDOS ($4E);

function TOS_snext : integer;
  GEMDOS ($4F);

function TOS_gsdtof (var buff : integer; handle : integer;
                         mode : integer) : integer;
  GEMDOS ($57);

{-----------------------------------------------------------------------------}
{                                                                             }
{  All ERROR paths come here ...                                              }
{                                                                             }
{-----------------------------------------------------------------------------}
procedure ErrorExit (msg : varstr; stat : integer);
  begin
    rewrite (e_file, 'A:\LOADRAM.ERR');
    writeln (e_file, msg, ' - ', stat:1);
    close (e_file);
    if FILEBUFF <> NIL then
      dispose (FILEBUFF);
    Halt
  end;

{-----------------------------------------------------------------------------}
{                                                                             }
{  Modules to convert STRING variables from/to Asciz PACKED ARRAY of CHAR     }
{  variables.                                                                 }
{                                                                             }
{-----------------------------------------------------------------------------}
procedure str_to_asciz (s : varstr; var a : fixstr);
  var
    i                   : integer;
  begin
    for i := 1 to length(s) do
      a[i] := s[i];
    a[length(s)+1] := chr(0)
  end;

procedure asciz_to_str (a : fixstr; var s : varstr);
  var
    i                   : integer;
  begin
    s := '';
    i := 1;
    while (a[i] <> chr(0)) and (i <= 80) do
      begin
        s := Concat (s, a[i]);
        i := succ(i)
      end
  end;

{-----------------------------------------------------------------------------}
{                                                                             }
{  Check for the hidden file 'D:\LOADRAM.CHK'. If present - then abort,       }
{  otherwise, create it.                                                      }
{                                                                             }
{-----------------------------------------------------------------------------}
procedure CheckForRestart (var abort : boolean);
  var
    st, hndl            : integer;
    temp                : fixstr;
  begin {CheckForRestart}
    str_to_asciz ('D:\LOADRAM.CHK', temp);
    st := TOS_sfirst (temp, $02);
    if st = 0 then
      abort := true
    else
      begin
        hndl := TOS_create (temp, $02);
        if hndl < 0 then
          ErrorExit ('Error creating D:\LOADRAM.CHK (hidden)', hndl);
        st := TOS_close (hndl);
        abort := false
      end
  end; {CheckForRestart}

{-----------------------------------------------------------------------------}
{                                                                             }
{  Parse items from the command line.                                         }
{                                                                             }
{-----------------------------------------------------------------------------}
procedure ParseCommand (s : varstr; var p : p_struc);
  var
    i                   : integer;
  begin {ParseCommand}
    for i := 1 to Length(s) do
      if s[i] in ['a'..'z'] then
        s[i] := chr( ord(s[i]) - 32 );
    p.cnt := 0;
    while (Length(s) > 0) and (p.cnt < MAX_PARAMS) do
      begin
        while (Length(s) > 0) and (s[1] = ' ') do
          Delete (s, 1, 1);
        if Length(s) > 0 then
          begin
            p.cnt := succ(p.cnt);
            p.param[p.cnt] := '';
            while (Length(s) > 0) and (s[1] <> ' ') do
              begin
                p.param[p.cnt] := Concat (p.param[p.cnt], s[1]);
                Delete (s, 1, 1)
              end
          end
      end
  end; {ParseCommand}

{-----------------------------------------------------------------------------}
{                                                                             }
{  Copy one file from the source drive to the RAM disk.                       }
{                                                                             }
{-----------------------------------------------------------------------------}
procedure CopyFile (s, d : varstr);

  var
    i                           : integer;
    src_handle, dst_handle      : integer;
    src_name, dst_name          : varstr;
    temp                        : fixstr;
    st, bytes_read              : long_integer;
  begin {CopyFile}

    i := Length(s);                     { find the last '\' }
    while (i > 0) and (s[i] <> '\') do
      i := pred(i);

    if i > 0 then                       { we found a back slash }
      begin

{  First delete everything after the '\' we found.                           }
{  Then convert the DTA.filename to a string so we can work with it.         }
{  The output name is:  D  +  DTA.filename                                   }
{  The source name is:  everything before/including the '\'  +  DTA.filename }

        Delete (s, i+1, Length(s)-i);
        asciz_to_str (DTA.filename, src_name);
        dst_name := Concat (d, src_name);
        src_name := Concat (s, src_name);

{  Now that we have the source and target filenames, let's open the files. }

        str_to_asciz (src_name, temp);
        src_handle := TOS_open (temp, 0);
        if src_handle < 0 then
          begin
            src_name := Concat ('Error opening ', src_name);
            ErrorExit (src_name, src_handle)
          end;

        str_to_asciz (dst_name, temp);
        dst_handle := TOS_create (temp, 0);
        if dst_handle < 0 then
          begin
            dst_name := Concat ('Error creating ', dst_name);
            ErrorExit (dst_name, dst_handle)
          end;

{  Main COPY loop ...                                                   }
{    Read and write bytes until either an error occurs or we read       }
{    DTA.filesize bytes.                                                }

        bytes_read := 0;
        st := 0;
        while (st >= 0) and (bytes_read < DTA.filesize) do
          begin
            st := TOS_read (src_handle, MAX_BUFFSIZE, FILEBUFF);
            if st > 0 then
              begin
                if (bytes_read+st) > DTA.filesize then
                  st := DTA.filesize - bytes_read;
                bytes_read := bytes_read + st;
                st := TOS_write (dst_handle, st, FILEBUFF);
                if st < 0 then
                  begin
                    dst_name := Concat ('Error writing ', dst_name);
                    ErrorExit (dst_name, Int(st))
                  end
              end
            else
              begin
                src_name := Concat ('Error reading ', src_name);
                ErrorExit (src_name, Int(st))
              end
          end; {while st >= 0 ... }

          i := TOS_gsdtof (DTA.filetime, dst_handle, 0);
          if i < 0 then
            ErrorExit ('Error setting file date/time', i);
          i := TOS_close (src_handle);
          i := TOS_close (dst_handle)

     end {if i > 0 ... }

  end; {CopyFile}

{-----------------------------------------------------------------------------}
{                                                                             }
{  Copy all the files specified by the source search path                     }
{                                                                             }
{-----------------------------------------------------------------------------}
procedure CopyDriver (p : p_struc);
  var
    st                  : integer;
    temp                : fixstr;
  begin {CopyDriver}
    with p do
      begin
        str_to_asciz (param[2], temp);
        st := TOS_sfirst (temp, $00);
        while st = 0 do
          begin
            CopyFile (param[2], param[3]);
            st := TOS_snext
          end;
        if (st <> TE_filnotfou) and (st <> TE_nomorfil) then
          begin
            param[1] := Concat ('Error searching directory - ', param[2]);
            ErrorExit (param[2], st)
          end
      end
  end; {CopyDriver}

{-----------------------------------------------------------------------------}
{                                                                             }
{  Create a directory (folder)                                                }
{                                                                             }
{-----------------------------------------------------------------------------}
procedure MakeDirectory (p : p_struc);
  var
    st                  : integer;
    temp                : fixstr;
  begin {MakeDirectory}
    with p do
      begin
        str_to_asciz (param[2], temp);
        st := TOS_mkdir (temp);
        if st < 0 then
          begin
            param[2] := Concat ('Error creating directory - ', param[2]);
            ErrorExit (param[2], st)
          end
      end
  end; {MakeDirectory}

{-----------------------------------------------------------------------------}
{                                                                             }
{  Main Program Module                                                        }
{                                                                             }
{-----------------------------------------------------------------------------}
begin {Main Program}

  FILEBUFF := NIL;
  IO_Check (false);

  reset (P_FILE, 'A:\AUTO\LOADRAM.FIL');
  STATUS := IO_Result;
  if (STATUS = TE_filnotfou) or (STATUS = TE_patnotfou) then
    Halt
  else if STATUS <> 0 then
    ErrorExit ('Error opening A:\AUTO\LOADRAM.FIL', STATUS);

  CheckForRestart (ABORT);
  if ABORT then
    begin
      close (P_FILE);
      Halt
    end;

  STATUS := TOS_setdta (DTA);
  if STATUS < 0 then
    ErrorExit ('Error setting DTA', STATUS);

  new (FILEBUFF);

  while not eof(P_FILE) do
    begin
      readln (P_FILE, P_REC);
      STATUS := IO_Result;
      if STATUS <> 0 then
        ErrorExit ('Error reading A:\AUTO\FILE.LST', STATUS);

      if Length(P_REC) > 0 then  { if there's nothing on the line - skip }
        begin
          ParseCommand (P_REC, P_GROUP);
          with P_GROUP do
            if (param[1] = 'MD') and (cnt = 2) then
              MakeDirectory (P_GROUP)
            else if (param[1] = 'COPY') and (cnt = 3) then
              CopyDriver (P_GROUP)
        end; {if length ... }

    end; {while not eof ... }

  close (P_FILE);
  dispose (FILEBUFF)

end. {Main Program}
