(* 5 TURBO PASCAL UTILITY PROGRAMS ARE IN THIS FILE:
   1 COPY
   2 PRINT
   3 RENERA
   4 DIR
   5 ERABAK
Separate them for use with Turbo Pascal. *)

(* Send remarks to Doug Cox
                   488 University Ave #611
                   Palo Alto, Ca. 94301 *)

program COPY;
label FIN;
var
  source, dest: File;
  destDrive: char;
  sourceName, destName: string[14];
  buffer: array[1..17152] of byte;
  recs, rem: byte;
  ok: boolean;
begin
ClrScr;
GotoXY(1,12); write ('Enter file to COPY: ');
repeat
  GotoXY(21,12); ClrEol;
  read (sourceName);
  if sourceName= '' then Goto FIN;
  GotoXY(1,11); ClrEol;
  Assign (source, sourceName);
  {$I-} Reset (source) {$I+};
  ok:= (IOresult= 0);
  if not ok then
    begin
    GotoXY(1,11);
    write ('Sorry, I can''t find "',sourceName,'", try again...');
    end;
until ok;
writeln; writeln;
if FileSize (source) <= 135 then
  begin
  if Copy(sourceName,2,1)= ':' then
    sourceName:= Copy(sourceName,3,Length(sourceName));
  write ('Destination Drive: ');
  readln (destDrive);
  destName:= UpCase(destDrive)+':'+sourceName;
  Assign (dest, destName);
  Rewrite (dest);
  rem:= FileSize (source);
  while rem <> 0 do
    begin
    if rem > 134 then recs:= 134 (*17152/128 records*)
      else recs:= rem;
    BlockRead (source, buffer, recs);
    BlockWrite (dest, buffer, recs);
    rem:= rem - recs;
    end;
  Close (dest);
  write ('Done.');
  end
else
  begin
  writeln ('Sorry, that file is too big for me to transfer.');
  end;
Close (source);
FIN: end.

program PRINT;
label FIN;
var {$U+}
  line: string[127]; (* Osborne 1 specific *)
  fileName: string[14];
  anyKey: char;
  f: Text;
  ok: boolean;
begin
ClrScr;
GotoXY(1,12); write ('Enter file to PRINT:');
repeat
  GotoXY(22,12); ClrEol;
  read (fileName);
  if fileName= '' then Goto FIN;
  GotoXY(1,11); ClrEol;
  Assign (f, fileName);
  {$I-} Reset (f) {$I+};
  ok:= (IOresult= 0);
  if not ok then
    begin
    GotoXY(1,11);
    write ('Sorry, I can''t find "',fileName,'", try again...');
    end;
until ok;
GotoXY(1,12); ClrEol;
write ('Set up printer & press RETURN when ready');
read (Kbd, anyKey);
writeln (Lst);
ClrScr; GotoXY(1,1);
while not Eof (f) do
  begin
  readln (f, line);
  writeln (line);
  writeln (Lst, line);
  end;
Close (f);
writeln (Lst);
FIN:end.

program RENERA;
label Q;
var
  fileName, newName: string[14];
  choice: char;
  f: File;
  ok: boolean;
begin
ClrScr;
repeat
  GotoXY(1,10); write ('(R)ename or (E)rase: ');
  read (Kbd, choice); if choice= ^M then Goto Q;
  choice:= UpCase(choice); write (choice);
  if choice= 'R' then write ('ENAME');
  if choice= 'E' then write ('RASE');
until (choice= 'R') or (choice= 'E');
GotoXY(1,12);
write ('Enter file name:');
repeat
  GotoXY(18,12); ClrEol;
  read (fileName);
  if fileName= '' then Goto Q;
  GotoXY(1,11); ClrEol;
  Assign (f, fileName);
  {$I-} Reset (f) {$I+};
  ok:= (IOresult= 0);
  if not ok then
  begin
    GotoXY(1,11);
    write ('Sorry, I can''t find "',fileName,'", try again...');
  end;
until ok;
Close (f);
writeln; writeln;
if (choice= 'R') then
begin
  write ('Enter new name: ');
  readln (newName);
  Rename (f, newName);
end
else if (choice= 'E') then Erase (f);
write ('Done.');
Q:end.

program DIR; {$A-}
const
  MaxFiles= 64;
  schf= 17;
  schn= 18;
  setdma= 26;
  fcbl= $5C;
  fcb= $80;
type
  Directory= array[1..MaxFiles] of string[12];
var
  dmabuf: array[1..130] of byte;
  dir: Directory;
  drive: char;
  h,i,j,k: integer;

procedure QuickSort (var dir: Directory; i: integer);
procedure Sort (left,right: byte);
  var
    middle,tDir: string[12];
    l,r: byte;
  begin
    l:= left; r:= right;
    middle:= dir[(left+right) div 2];
    repeat
      while dir[l] < middle do l:= l+1;
      while middle < dir[r] do r:= r-1;
      if l <= r then
      begin
        tDir:= dir[l]; dir[l]:= dir[r]; dir[r]:= tDir;
        l:= l+1; r:= r-1;
      end;
    until l > r;
    if left < r then Sort (left,r);
    if l < right then Sort (l,right);
  end;
begin (*Quicksort*)
  Sort (1,i);
end;

begin
  ClrScr;
  write ('Drive: '); read (Kbd, drive);
  drive:= UpCase(drive); writeln (drive,' Directory');
  write ('Standby...');
  GotoXY(1,2);
  Mem[fcbl]:= Ord(drive)-64;
  for i:= 1 to 11 do Mem[fcbl+i]:= ord('?');
  for i:= 12 to 36 do Mem[fcbl+i]:= 0;
  FillChar(dir,SizeOf(dir),'o');
  i:= 1;
  Bdos(setdma,Addr(dmabuf[1]));
  j:= Bdos(schf, fcbl);
  if j < 255 then
  begin
    dmabuf[j*32+1]:= 11;
    Move(dmabuf[j*32+1], dir[i], 12);
    j:= Bdos(schn, fcbl);
    while j < 255 do
    begin
      i:= i+1;
      dmabuf[j*32+1]:= 11;
      Move(dmabuf[j*32+1], dir[i], 12);
      j:= Bdos(schn, fcbl);
    end;
    bdos(setdma, fcb);
    for j:= 1 to i do Insert('.', dir[j], 9);
    QuickSort (dir,i);
    k:= 1;
    for j:= 1 to (i div 3) do
      begin writeln (dir[j]); k:= k+1; end;
    h:= 1;
    for j:= k to ((i*2) div 3) do
      begin GotoXY(21,h); write (dir[j]); k:= k+1; h:= h+1; end;
    h:= 1;
    for j:= k to i do
      begin GotoXY(41,h); write (dir[j]); k:= k+1; h:= h+1; end;
    writeln; writeln;
  end;
end.

program ERABAK;
const
  schf= 17;
  schn= 18;
  setdma= 26;
  fcbl= $5C;
  fcb= $80;
var
  ch: char;
  h,i,j,k: integer;
  dmabuf: array[1..130] of byte;
  dir: array[1..64] of string[12];
  temp: string[12];
  OK: boolean;
  fv: Text;
begin
  Mem[fcbl]:= 0;
  for i:= 1 to 8 do Mem[fcbl+i]:= ord('?');
  Mem[fcbl+9]:= ord('B');
  Mem[fcbl+10]:= ord('A');
  Mem[fcbl+11]:= ord('K');
  for i:= 12 to 36 do Mem[fcbl+i]:= 0;
  FillChar(dir,SizeOf(dir),' ');
  i:= 1;
  Bdos(setdma,Addr(dmabuf[1]));
  j:= Bdos(schf, fcbl);
  if j < 255 then
  begin
    dmabuf[j*32+1]:= 11;
    Move(dmabuf[j*32+1], dir[i], 12);
    j:= Bdos(schn, fcbl);
    while j < 255 do
    begin
      i:= i+1;
      dmabuf[j*32+1]:= 11;
      Move(dmabuf[j*32+1], dir[i], 12);
      j:= Bdos(schn, fcbl);
    end;
    Bdos(setdma, fcb);
    for j:= 1 to i do Insert('.', dir[j], 9);
    for j:= 1 to i do
      begin
        while Pos (' ', dir[j]) <> 0 do
          begin
          Delete (dir[j], Pos (' ',dir[j]), 1);
          end;
        Assign (fv, dir[j]);
        Close (fv);
        Erase (fv);
      end;
    write ('All .BAK files have now been erased.')
  end
  else write ('I didn''t find any .BAK files.');
end.