home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / ZSYS / ZNODE-12 / I / NZ-TOOL4.LBR / NZ-TOOL.BZX / NZ-TOOL.BOØ
Text File  |  2000-06-30  |  10KB  |  386 lines
  1.  
  2. (* NZ-TOOL.BOX 1.0 for Turbo Pascal 3.0
  3.    Copyright (C) 1989 Alpha Systems
  4.  
  5.    Author:  Joe Wright
  6.    Date:    20 Sept 89
  7.    Version: 1.0
  8.  
  9.    Invoke TURBO.COM with a Z-System alias, TP.COM, as follows..
  10.  
  11.      1 --> GET 100 TURBO.COM;
  12.      2 --> POKE 103 5A 33 45 4E 56 01 00 00;
  13.      3 --> GO
  14.  
  15.    This puts a Z3ENV Type 1 header at the beginning of TURBO.COM
  16.    so that GO will 'install' the Environment address at 109H.
  17.    COM files created by TURBO.COM will also contain this header
  18.    and therefore be Z3 utilities.
  19.  
  20.    This version of the TOOL.BOX describes the entire Z-System in
  21.    terms of Turbo Pascal Records.  The Record structure and Turbo
  22.    Pascal Pointers will allow the veteran Pascal programmer complete
  23.    access to the Z-System Environment and by implication, a description
  24.    of its entire structure.
  25.  
  26.    The Z-System assembly language programmer is presented with Pascal
  27.    functions and procedures with familiar SYSLIB and Z3LIB names so
  28.    that he can 'call' his favorite subroutines within Turbo Pascal
  29.    without re-inventing the wheel.
  30.  
  31.    Programming style seems to vary according to the square of
  32.    of programmers (or square programmers?) and no one should feel
  33.    limited by the examples in this TOOL.BOX.  Think of it as a
  34.    demonstration.  In the end, do it your way.
  35.  
  36.    Load the Tool Box into you program with the Turbo Pascal
  37.    {$I NZ-TOOL.BOX} insertion directive.
  38.  
  39.    Turbo Pascal is not upper/lower case sensitive.  We tend to use
  40.    mixed case for readability.  In order to distinguish among Turbo
  41.    Pascal Standard declarations and our own, I try to follow the
  42.    convention that..
  43.  
  44.      GoToBed   is a Turbo Pascal defined Word or Identifier
  45.      GOTOBED   is the User Definition
  46.      gotobed   is the User Declaration
  47.  
  48.    Mixed case is Pascal, UPPERCASE is our own definition and
  49.    lowercase declares our definitions.
  50.  
  51. *)
  52.  
  53. { User-Defined Global Types }
  54.  
  55. Type
  56.   STR8    = String[8];              { Dir Name or Password         }
  57.   STR21   = String[21];             { NDIRNAME:FILENAME.TYP        }
  58.   STR80   = String[80];             { Parameter                    }
  59.  
  60.   ARR8    = Array[1..8] of Char;    { Name or Password array       }
  61.   ARR3    = Array[1..3] of Char;    { File type array              }
  62.   ARR5    = Array[1..5] of Char;    { Five-char ID like Z3ENV      }
  63.  
  64.   SECTOR  = Array[0..127] of Byte;  { Standard CP/M Unit Record    }
  65.  
  66.   FCBPTR  = ^FCBREC;
  67.   FCBREC  =
  68.     Record
  69.       DRIV  : Byte;
  70.       NAME  : arr8;
  71.       TYP   : arr3;
  72.       EXT   : Byte;
  73.       S1    : Byte;
  74.       S2    : Byte;
  75.       RC    : Byte;
  76.       ALLOC : Array[0..15] of Byte;
  77.       CR    : Byte;
  78.       RREC  : Integer;
  79.       RERR  : Byte
  80.     End;
  81.  
  82. { This describes the Z3MSG structure. }
  83.  
  84.   MSGPTR = ^MSGREC;
  85.   MSGREC =
  86.     Record
  87.       ERFLG   : Byte;
  88.       IFLEV   : Byte;
  89.       IFSTS   : Byte;
  90.       CMDST   : Byte;
  91.       ERADR   : Integer;
  92.       PRGER   : Byte;
  93.       ZEXMSG  : Byte;
  94.       ZEXRUN  : Byte;
  95.       ZEXNXT  : Integer;
  96.       ZEX1ST  : Integer;
  97.       SHCTL   : Byte;
  98.       SCRAT   : Integer;
  99.       ERCMD   : Array[1..32] of Char;
  100.       REGIS   : Array[0..31] of Byte;
  101.     End;
  102.  
  103. { This describes the Z3CL structure for 'standard' Z-Systems. }
  104.  
  105.   MCLPTR = ^MCLREC;
  106.   MCLREC =
  107.     Record
  108.       NXTCHR  : Integer;
  109.       MCLMAX  : Byte;
  110.       MCL     : String[203];
  111.     End;
  112.  
  113.   MEMORY = Array[0..$7FFE] of Integer;
  114.  
  115.   PATPTR = ^PATREC;
  116.   PATREC =
  117.     Record
  118.       PATH : memory;
  119.     End;
  120.  
  121.   NDRPTR = ^NDRREC;
  122.   NDRREC =
  123.     Record
  124.       DU : Integer;
  125.       NAME : arr8;
  126.       PASS : arr8;
  127.     End;
  128.  
  129. { The following Record Structures define the Z3 Environment of
  130.   any NZ-System.  }
  131.  
  132.   ENVPTR = ^ENVREC;
  133.   ENVREC =
  134.     Record
  135.       ENV     : Byte;
  136.       CBIOS   : Integer;
  137.       Z3ID    : Array[1..5] of Char;
  138.       ENVTYP  : Byte;
  139.       EXPATH  : patptr;
  140.       EXPATHS : Byte;
  141.       RCP     : Integer;
  142.       RCPS    : Byte;
  143.       IOP     : Integer;
  144.       IOPS    : Byte;
  145.       FCP     : Integer;
  146.       FCPS    : Byte;
  147.       Z3NDIR  : ndrptr;
  148.       Z3NDIRS : Byte;
  149.       Z3CL    : mclptr;
  150.       Z3CLS   : Byte;
  151.       Z3ENV   : Integer;
  152.       Z3ENVS  : Byte;
  153.       SHSTK   : Integer;
  154.       SHSTKS  : Byte;
  155.       SHSIZE  : Byte;
  156.       Z3MSG   : msgptr;
  157.       EXTFCB  : fcbptr;
  158.       EXTSTK  : Integer;
  159.       QUIET   : Byte;
  160.       Z3WHL   : ^Byte;
  161.       SPEED   : Byte;
  162.       MAXDSK  : Byte;
  163.       MAXUSR  : Byte;
  164.       DUOK    : Byte;
  165.       CRT     : Byte;
  166.       PRT     : Byte;
  167.       COLS    : Byte;
  168.       ROWS    : Byte;
  169.       LINS    : Byte;
  170.       DRVEC   : Integer;
  171.       SPAR1   : Byte;
  172.       PCOL    : Byte;
  173.       PROW    : Byte;
  174.       PLIN    : Byte;
  175.       FORM    : Byte;
  176.       SPAR2   : Byte;
  177.       SPAR3   : Byte;
  178.       SPAR4   : Byte;
  179.       SPAR5   : Byte;
  180.       CCP     : Integer;
  181.       CCPS    : Byte;
  182.       DOS     : Integer;
  183.       DOSS    : Byte;
  184.       BIO     : Integer;
  185.       SHVAR   : Array[1..11] of Char;
  186.       FILE1   : Array[1..11] of Char;
  187.       FILE2   : Array[1..11] of Char;
  188.       FILE3   : Array[1..11] of Char;
  189.       FILE4   : Array[1..11] of Char;
  190.       PUBLIC  : Integer;
  191.     End;
  192.  
  193. { Global Variables }
  194.  
  195. { These are the Absolute (External) variable assignments which
  196.   give the Turbo Pascal program access to everything we know. }
  197.  
  198. Var
  199.   WBOOTV  : Integer     Absolute $0001;
  200.   IOBYTE  : Byte        Absolute $0003;
  201.   CDISK   : Byte        Absolute $0004;
  202.   BDOSV   : Integer     Absolute $0006;
  203.   FCB1    : fcbrec      Absolute $005C;
  204.   FCB2    : fcbrec      Absolute $006C;
  205.   TBUFF   : String[126] Absolute $0080;
  206.   DBUFF   : sector      Absolute $0080;
  207.   Z3EADR  : envptr      Absolute $0109;
  208.  
  209. { These Global Variables are used by the new Functions and Procedures
  210.   and the Main program to pass parameters among themselves. }
  211.  
  212.   SPEC1   : str21;      {For DIRECTRY:FILENAME.TYP}
  213.   SPEC2   : str21;      {For DIRECTRY:FILENAME.TYP}
  214.   DIRS    : str8;       {For D:, U:, DU: or DIR:}
  215.   NAME    : str8;       {Directory Name}
  216.   PASS    : str8;       {Directory Password}
  217.  
  218.   SOURCE  : File;       {File being Read}
  219.   DESTIN  : File;       {File being Written}
  220.   CURDU   : Integer;    {Current (default) Drive/User}
  221.   SRCDU   : Integer;    {Source D/U}
  222.   DSTDU   : Integer;    {Destination D/U}
  223.  
  224.  
  225. { From here on, we will collect various User-Defined functions
  226.   and procedures which emulate SYSLIB and Z3LIB subroutines of
  227.   the Z-System.  To the extent that they may 'call' each other,
  228.   they are arranged here such they are Declared before they are
  229.   called, SYSLIB, Z3LIB, VLIB, in that order.  Turbo Pascal is
  230.   itself rich enough to provide most of the functions we need. }
  231.  
  232. Procedure CAPSTR(Var S:str21);
  233. Var I : Integer;
  234. Begin
  235.   for i := 1 to Length(s) do s[i] := UpCase(s[i])
  236. End;
  237.  
  238. Function PHEX(N,B:Integer):str8;
  239. Var H : str8; I, C : Byte;
  240. Begin
  241.   h[0] := #0; { Clear the string }
  242.   For i := b Downto 1 Do
  243.   Begin
  244.     c := n and 15; n := n shr 4;
  245.     If c < 10 Then c := c+48 Else c := c+55;
  246.     Insert(Chr(c),h,1)
  247.   End;
  248.   phex := h
  249. End;
  250.  
  251. Function RETUD:Integer;
  252. Begin
  253.   retud := 256 * (Bdos(25)+1) + Bdos(32,$FF)
  254. End;
  255.  
  256. Procedure LOGUD(DU:Integer);
  257. Begin
  258.   Bdos(14,Hi(DU)-1); Bdos(32,Lo(DU))
  259. End;
  260.  
  261. Procedure PDU(du:Integer);
  262. Begin
  263.   Write(Chr(Hi(du)+64),Lo(du),':')
  264. End;
  265.  
  266. Function GETNDR:Integer;
  267. Begin
  268.   getndr := Ord(z3eadr^.z3ndir)
  269. End;
  270.  
  271. Function GETMCL:Integer;   { get multiple command line }
  272. Begin
  273.   getmcl := Ord(z3eadr^.z3cl)
  274. End;
  275.  
  276. Function DIRSCAN(S:str8):Integer;
  277. Var NDIR : ndrptr;
  278.     D, I : Integer;
  279. Begin
  280.   d := 0;
  281.   ndir := Ptr(getndr);
  282.   if ndir^.du <> 0 then
  283.     Repeat
  284.       name[0] := #8;
  285.       for i := 1 to 8 do name[i] := ndir^.name[i];
  286.       i := Pos(' ',name);
  287.       if i <> 0 then name[0] := Chr(i-1);
  288.       if s = name then d := Swap(ndir^.du) else d := 0;
  289.       ndir := Ptr(Ord(ndir)+SizeOf(ndrrec));
  290.     Until (d <> 0) or (Lo(ndir^.du) = 0);
  291.   dirscan := d;
  292. End;
  293.  
  294. Function DUSCAN(S:str8):Integer;
  295. Const d = 'ABCDEFGHIJKLMNOP';
  296. Var du, usr, cod : Integer;
  297. Begin
  298.   du := curdu;
  299.   if Length(s) <> 0 then
  300.     begin
  301.       if Pos(s[1],d) <> 0 then
  302.         begin
  303.           du := Pos(s[1],d)*256 + (du and 255);
  304.           Delete(s,1,1)
  305.         end;
  306.       if Length(s) <> 0 then
  307.         begin
  308.           Val(s,usr,cod);
  309.           if cod <> 0 then du := 0 else du := (du and -256) + usr
  310.         end;
  311.     end;
  312.   duscan := du;
  313. End;
  314.  
  315. Function DNSCAN:Integer;
  316. Var du : Integer;
  317. Begin
  318.   du := dirscan(dirs);
  319.   if du = 0 then du := duscan(dirs);
  320.   dnscan := du
  321. End;
  322.  
  323. Function NAMSTR(Nam:arr8):str8;
  324. Var I : Integer; Str : str8;
  325. Begin
  326.   str[0] := #8;
  327.   for i := 1 to 8 do str[i] := nam[i];
  328.   i := Pos(' ',str);
  329.   if i <> 0 then
  330.     str[0] := Chr(i-1);
  331.   namstr := str
  332. End;
  333.  
  334. Function DUTDIR(du:Integer):Boolean;
  335. Var ndir : ndrptr;
  336.     i    : Integer;
  337. Begin
  338.   name[0] := #0;
  339.   pass[0] := #0;
  340.   ndir    := Ptr(getndr);
  341.   Repeat
  342.     if du = Swap(ndir^.du) then
  343.       begin
  344.         name := namstr(ndir^.name);
  345.         pass := namstr(ndir^.pass);
  346.       end;
  347.     ndir := Ptr(Ord(ndir)+SizeOf(ndrrec));
  348.   Until (Length(name) <> 0) or (Lo(ndir^.du) = 0);
  349.   dutdir := Length(name) <> 0
  350. End;
  351.  
  352. Function GETWHL:Boolean;
  353. Begin
  354.   if z3eadr^.z3whl^ = 0 then
  355.     getwhl := false
  356.   else
  357.     getwhl := true
  358. End;
  359.  
  360. Procedure SETWHL(B:Byte);
  361. Begin
  362.   z3eadr^.z3whl^ := b
  363. End;
  364.  
  365. Function GETDUOK:Boolean;
  366. Begin
  367.   if z3eadr^.duok = 0 then
  368.     getduok := false
  369.   else
  370.     getduok := true
  371. End;
  372.  
  373. Procedure PARSE(Var S:str21);
  374. Var P : Integer;
  375. Begin
  376.   dirs[0] := #0;  { Clear the string }
  377.   p := Pos(':',s);
  378.   if p <> 0 then
  379.     begin
  380.       dirs := Copy(s,1,p-1);
  381.       Delete(s,1,p)
  382.     end;
  383. End;
  384.  
  385. { End of NZ-TOOL.BOX 1.0 }
  386.