home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / lan / tpnet / sample2.pas < prev   
Pascal/Delphi Source File  |  1987-06-30  |  44KB  |  1,260 lines
  1. { This program has been designed to give software developers an example of how to
  2.   interface with the assembly library provided.  The library has been revised
  3.   and the version contained on this disk should be used in place of the original 
  4.   library that came with the programmers' guide diskette. The programmmers'guide 
  5.   will help provide a better understanding of what parameters each call 
  6.   needs and how each function works. The following declaration needs to made 
  7.   whenever the library routines are accessed, since all function calls are 
  8.   referenced from the "xtndopn" function.
  9.                    BE SURE AND DECLARE THE FOLLOWING:
  10.    function xtndopn(var mode,handle:integer;var filename:str):integer; external 'PASNETA.COM'; }
  11.  
  12. {===========================================================================================}
  13.  
  14. program FuncInterface;
  15.     type   
  16.     str = string[52];
  17.  
  18.     var
  19.         hex,filename,asciiz,sema4,recstr,request,reply: str;
  20.          Handle, retcode, Hoff, Loff, HLen, LLen, FLAG, TMO, Func, Attribute: integer;
  21.          semavalu,Hihandle,Lohandle,opencnt,volume,newserv: integer;
  22.          I, Len, mode, seg, off: integer;
  23.          ans: char;
  24.  
  25. {pasneta.pas
  26. this file contains the function and procedure declarations
  27. for the TurboPascal/Advanced NetWare interface}
  28.     
  29. type
  30.     Strvar = String[52];
  31.  
  32. function xtndopn(var Mode, Handle: Integer;var Filename: Strvar): Integer; external 'PASNETA.COM';
  33. function setattr(var Func, Attribute: Integer; var Filename: Strvar): Integer; external xtndopn[3];
  34. function eojstat(var Flag: Integer):integer; external xtndopn[6];
  35. function PRLH_Log(var FileHandle,HiByteOffset,LoByteOffset,HiLockLen,
  36.       LoLockLen,Flags,TimeOut: Integer): Integer; external xtndopn[9];
  37. function PRLH_Rel(var FileHandle,HiByteOffset,LoByteOffset,HiLockLen,
  38.       LoLockLen: Integer): Integer; external xtndopn[12];
  39. function PRLH_Clr(var FileHandle,HiByteOffset,LoByteOffset,HiLockLen,
  40.       LoLockLen: Integer): Integer; external xtndopn[15];
  41. function PRLF_Log(var fcb,HiByteOffset,LoByteOffset,HiLockLen,LoLockLen,
  42.       Flags,TimeOut: Integer): Integer; external xtndopn[18];
  43. function PRLF_Rel(var fcb,HiByteOffset,LoByteOffset: Integer): Integer; external xtndopn[21];
  44. function PRLF_Clr(var fcb,HiByteOffset,LoByteOffset: Integer): Integer; external xtndopn[24];
  45. function PRLS_Lck(var Flags,TimeOut: Integer): Integer; external xtndopn[27];
  46. function PRLS_Rel: Integer; external xtndopn[30];
  47. function PRLS_Clr: Integer; external xtndopn[33];
  48. function OpenSem(var Sema4: Strvar; var SemaValu,HiHandle,LoHandle,OpenCnt: Integer): Integer; external xtndopn[36];
  49. function ExamSem(var HiHandle,LoHandle,SemaValu,OpenCnt: Integer): Integer; external xtndopn[39];
  50. function WaitSem(var HiHandle,LoHandle,TimeOut: Integer): Integer; external xtndopn[42];
  51. function SigSem(var HiHandle,LoHandle: Integer): Integer; external xtndopn[45];
  52. function ClosSem(var HiHandle,LoHandle: Integer): Integer; external xtndopn[48];
  53. function setlck(var Func: Integer): Integer; external xtndopn[51];
  54. function BakOuts(var Func: Integer): Integer; external xtndopn[54];
  55. function btrans(var Mode: Integer): Integer; external xtndopn[57];
  56. function etrans: Integer; external xtndopn[60];
  57. function exclog(var FcbAddr: Integer): Integer; external xtndopn[63];
  58. function exclcks(var Mode: Integer): Integer; external xtndopn[66];
  59. function exculkf(var FcbAddr: Integer): Integer; external xtndopn[69];
  60. function exculks: Integer; external xtndopn[72];
  61. function excclrf(var FcbAddr: Integer): Integer; external xtndopn[75];
  62. function excclrs: Integer; external xtndopn[78];
  63. function reclog(var RecStr: Strvar;var flag,TimeOut:integer): Integer; external xtndopn[81];
  64. function reclck(var Mode: Integer): Integer; external xtndopn[84];
  65. function reculk(var Semaphore: Strvar): Integer; external xtndopn[87];
  66. function reculks: Integer; external xtndopn[90];
  67. function recclr(var Semaphore: Strvar): Integer; external xtndopn[93];
  68. function recclrs: Integer; external xtndopn[96];
  69. function eoj: Integer; external xtndopn[99];
  70. function sysout: Integer; external xtndopn[102];
  71. function volstat(var volume: Integer;var reply: Strvar): Integer; external xtndopn[105];
  72. function locdrv:Integer; external xtndopn[108];
  73. function wsid: Integer; external xtndopn[111];
  74. function errmode(var mode: Integer):integer; external xtndopn[114];
  75. function bcsmode(var mode: Integer):integer; external xtndopn[117];
  76. function ctlspl(var Mode: Integer): Integer; external xtndopn[120];
  77. function splreq(var RequestBlock, Reply: Strvar): Integer; external xtndopn[123];
  78. function pipreq(var RequestBlock, Reply: Strvar): Integer; external xtndopn[126];
  79. function dpath(var RequestBlock, Reply: Strvar): Integer; external xtndopn[129];
  80. function syslog(var RequestBlock, Reply: Strvar): Integer; external xtndopn[132];
  81. function fattr(var FcbAddr, Attribute: Integer): Integer; external xtndopn[135];
  82. function updfcb(var FcbAddr: Integer): Integer; external xtndopn[138];
  83. function cpyfile(var FcbSource, FcbDest, CountLow, CountHigh: Integer): Integer; external xtndopn[141];
  84. function nettod(var time: Strvar):integer; external xtndopn[144];
  85. function clsmode(var mode: Integer):integer; external xtndopn[147];
  86. function drvmap(var drive: Integer): Integer; external xtndopn[150];
  87. function retshl(var EnvirStr: Strvar; var Mode: Integer): Integer; external xtndopn[153];
  88. function asclog(var Flags, TimeOut: Integer;var Asciiz: Strvar): Integer; external xtndopn[156];
  89. function asculkf(var Asciiz: Strvar): Integer; external xtndopn[159];
  90. function ascclrf(var Asciiz: Strvar): Integer; external xtndopn[162];
  91. function Get_PSN: Integer; external xtndopn[165];
  92. function Get_STA(var Mode,Segment,Offset: Integer):integer; external xtndopn[168];
  93. function SetServ(var Mode,NewServ: Integer): Integer; external xtndopn[171];
  94. function ModServ(var Mode,NewServ: Integer): Integer; external xtndopn[174];
  95.  
  96.  
  97. procedure Explain;
  98.     
  99.     begin
  100.       writeln('This program will display a menu of different function calls that can be');
  101.     writeln('performed. Each call will prompt the user for the parameters needed by the');
  102.       writeln('the function call.  After a function call has completed execution, the user ');
  103.       writeln('must hit the <enter> key to get back to the main menu.  This program has ');
  104.       writeln('been written to provide examples of how to use the function call interfaces,');
  105.         writeln('contained in pasneta.asm');
  106.       write('       Type return to continue: ');
  107.       readln;
  108.       clrscr;
  109.     end;
  110.  
  111.  
  112. function HexConvert(num:integer):str;
  113.     var quot, rem: integer;
  114.         dum:str;
  115.  
  116.     begin
  117.       quot:=num div 16;
  118.       rem:= num mod 16;
  119.       case rem of
  120.            0:hex:='0'+hex;
  121.            1:hex:='1'+hex;
  122.            2:hex:='2'+hex;
  123.             3:hex:='3'+hex;
  124.            4:hex:='4'+hex;
  125.            5:hex:='5'+hex;
  126.            6:hex:='6'+hex;
  127.             7:hex:='7'+hex;
  128.             8:hex:='8'+hex;
  129.             9:hex:='9'+hex;
  130.             10:hex:='A'+hex;
  131.             11:hex:='B'+hex;
  132.             12:hex:='C'+hex;
  133.             13:hex:='D'+hex;
  134.             14:hex:='E'+hex;
  135.             15:hex:='F'+hex;
  136.         end;
  137.         if quot > 15 then 
  138.             dum:=HexConvert(quot)
  139.         else
  140.            begin
  141.             case quot of
  142.                  0:hex:='0'+hex;
  143.                  1:hex:='1'+hex;
  144.                  2:hex:='2'+hex;
  145.                  3:hex:='3'+hex;
  146.                     4:hex:='4'+hex;
  147.                      5:hex:='5'+hex;
  148.                  6:hex:='6'+hex;
  149.                      7:hex:='7'+hex;
  150.                     8:hex:='8'+hex;
  151.                      9:hex:='9'+hex;
  152.                  10:hex:='A'+hex;
  153.                  11:hex:='B'+hex;
  154.                  12:hex:='C'+hex;
  155.                  13:hex:='D'+hex;
  156.                  14:hex:='E'+hex;
  157.                  15:hex:='F'+hex;
  158.             end;
  159.            end;
  160.         hexconvert:=hex;
  161.     end;
  162.  
  163.  
  164. procedure get_filename;
  165.   
  166.     begin
  167.         write('Enter the name of the file you want to use:  ');
  168.        readln(filename);
  169.        write('Press the <enter> key to begin .....');
  170.        readln;
  171.        Len:=length(filename);
  172.        filename[Len+1]:=chr(0);        { Make it an ASCIIZ string }
  173.   end;
  174.  
  175.  
  176. (************************************************************************)
  177. (* Open_File is the Novell Extended Open Function Call. It opens the    *)
  178. (* file shareable, read/write.                                          *)
  179. (************************************************************************)
  180.  
  181.  
  182. procedure open;
  183.  
  184.     begin
  185.           get_filename;
  186.           writeln('The file is being opened Sharable Read Write...');
  187.         writeln('This is accomplished by placing a hex 42 in the AL register');
  188.           write('Type return to continue...');
  189.         readln;
  190.           flag:=$42;
  191.           clrscr;
  192.           retcode:=xtndopn(flag,handle,filename);
  193.           if retcode <> 0 then 
  194.         writeln('Return code = ',hexconvert(retcode),' file has not been opened')
  195.           else         
  196.                begin
  197.                     writeln('The file handle is ',handle,' the return code is : ',retcode);
  198.                     writeln('Remember the file handle number above, it will be needed to release locked records.');
  199.                end;
  200.      end;
  201.  
  202.  
  203. (*************************************************************************)
  204. (* Get or Set file Attributes *)
  205. (*************************************************************************)
  206.  
  207. procedure setget;
  208.     var get:integer;
  209.  
  210.     begin
  211.       get:=0;
  212.       get_filename;
  213.       writeln('Enter a ''0'' to get the atributes');
  214.     write('Enter a ''1'' to set the attributes: ');
  215.       readln(func);
  216.       if func = 1 then
  217.            begin
  218.                 writeln('Enter one of the following attributes: ');
  219.                 writeln;
  220.             writeln('1 - Read only. 2 - Hidden. 4 - system. 128 - Sharable.');
  221.             readln(attribute);
  222.            end
  223.       else 
  224.         get:=1;
  225.       retcode:=setattr(FUNC,ATTRIBUTE,filename);
  226.       write('executing... ');
  227.       if get = 1 then 
  228.         writeln(' The attribute is : ',hexconvert(attribute));
  229.       writeln('The return code is: ',hexconvert(retcode));
  230.     end;
  231.  
  232. (************************************************************************)
  233. (* Set EOJ flag *)
  234. (************************************************************************)
  235.  
  236.  
  237. procedure SetEOJ;
  238.     
  239.     begin
  240.       writeln('Enter a ''0'' to disable the End Of Job flag');
  241.     writeln('Enter a ''1'' to enable the End Of Job flag.');
  242.       readln(flag);
  243.       retcode:=eojstat(flag);
  244.       writeln('The return code is: ',retcode);
  245.     end;
  246.  
  247.  
  248. (************************************************************************)
  249. (* Physical record LOG and LOCK  *)
  250. (************************************************************************)
  251.  
  252.  
  253. procedure Log_Lock;
  254.  
  255.     begin
  256.        ans:='n';
  257.        write('If the target file is already open, type a ''y'': ');
  258.     readln(ans);
  259.        if ans <> 'y' then 
  260.         OPEN
  261.        else
  262.             begin
  263.              write('Enter the appropriate file handle: ');
  264.         readln(handle);
  265.             end;
  266.        write('Enter the Low Word Starting Offset of the record: ');
  267.     readln(Loff);
  268.        write('Enter the High Word Starting Offset of the record: ');
  269.     readln(Hoff);
  270.        write('Enter the Low Word Length of the record: ');
  271.     readln(LLen);
  272.        write('Enter the High Word Length of the record: ');
  273.     readln(HLen);
  274.        write('Enter a ''1'' to lock and log, or enter a ''3'' to do a shared lock: ');
  275.     readln(flag);
  276.        if flag = 1 then
  277.             begin
  278.              write('Enter the lock timeout in 1/18 secs intervals: ');
  279.         readln(TMO);
  280.             end;
  281.        retcode:=PRLH_Log(handle,Hoff,Loff,HLen,LLen,Flag,TMO);
  282.        writeln('The return code is: ',retcode);
  283.     end;
  284.  
  285.  
  286. (**************************************************************************)
  287. (* Release a record but it still remains in the log table. *)
  288. (* Release a record and remove it from the log table (clear the record).*)
  289. (**************************************************************************)
  290.  
  291.  
  292. procedure Rel_Clr;
  293.  
  294.     begin
  295.        ans:='n';
  296.        writeln('To release a record you must have opened the file and obtained a valid file handle.');
  297.      write('To proceed type a ''y'': ');
  298.     readln(ans);
  299.        if ans = 'y' then
  300.            begin
  301.             write('Enter the file handle of the appropriate file: ');
  302.         readln(handle);
  303.             write('Enter the Low Word Starting Offset of the record: ');
  304.         readln(Loff);
  305.             write('Enter the High Word Starting Offset of the record: ');
  306.         readln(Hoff);
  307.             write('Enter the Low Word Length of the record: ');
  308.         readln(LLen);
  309.             write('Enter the High Word Length of the record: ');
  310.         readln(HLen);
  311.             write('If you want to release the record, but not remove it from the log table, type an ''r'': ');
  312.             readln(ans);
  313.             if ans ='r' then
  314.                  begin
  315.                   writeln('Releasing the record...');
  316.                   retcode:=PRLH_Rel(handle,Hoff,Loff,HLen,LLen);
  317.                      end
  318.             else
  319.                  begin
  320.                   writeln('Removing the record from the log table...');
  321.                   retcode:=PRLH_Clr(handle,Hoff,Loff,HLen,LLen);
  322.                  end;
  323.             writeln('The return code is: ',retcode);
  324.            end;
  325.     end;
  326.  
  327.  
  328. (*********************************************************************)
  329. (* Lock the record set (all records in the log table *)
  330. (* Release record set or clear the record set.
  331. (*********************************************************************)
  332.  
  333.  
  334. procedure Lock_Set;
  335.     
  336.     begin
  337.       write('Enter a ''1'' to do a shared lock, nonexclusive:  ');
  338.       readln(flag);
  339.       write('Enter the timeout amount in 1/18 secs intervals, 0 means no wait: ');
  340.     readln(TMO);
  341.       retcode:=PRLS_Lck(flag,TMO);
  342.       writeln('The return code is: ',retcode);
  343.     end;
  344.  
  345.  
  346. procedure Set_Rel_Clr;
  347.  
  348.     begin
  349.        ans:='n';
  350.        writeln('To release the entire record set without removing the records');
  351.      write('from the log table, enter  an ''r'': ');
  352.     readln(ans);
  353.        if ans = 'r' then
  354.             begin
  355.              writeln('Releasing the record set...');
  356.              retcode:=PRLS_Rel;
  357.             end
  358.        else
  359.             begin
  360.              write('Removing all records from log table...');
  361.              retcode:=PRLS_Clr;
  362.             end;
  363.        write('Return code is : ',retcode);
  364.     end;
  365.  
  366.  
  367. (**********************************************************************)
  368. (* Open a Semaphore *)
  369. (**********************************************************************)
  370.  
  371.  
  372. procedure Sem_Open;
  373.  
  374.     begin
  375.     write('Enter the name of the semaphore: ');
  376.     readln(sema4);
  377.       write('Enter the initial semaphore value, it must be positive: ');
  378.     readln(semavalu);
  379.       retcode:=opensem(sema4,semavalu,Hihandle,Lohandle,opencnt);
  380.       writeln;
  381.     writeln;
  382.       writeln('The return code is : ',retcode);
  383.     writeln('The number of stations using this semaphore is : ',opencnt);
  384.       write('The semaphore handle is : HiPart = ',hexconvert(Hihandle));
  385.       hex:=' ';
  386.       writeln(' LoPart = ',hexconvert(Lohandle));
  387.       writeln('WRITE DOWN THIS HANDLE EXACTLY AS YOU SEE IT, IT WILL BE NEDDED TO ACCESS THIS SEMAPHORE');
  388.       writeln;
  389.     end;
  390.  
  391.  
  392. procedure Sem_Exam;
  393.  
  394.     begin
  395.         writeln('When entering the file handle, enter the HEX digits in the following manner: ');
  396.       writeln('    ie.    low part first: $adcb  (put a ''$'' before the hex digits) ');
  397.       writeln;
  398.       write('Enter the semaphore handle, low part first: ');readln(Lohandle);
  399.       write('  enter the high part of the handle: ');
  400.     readln(Hihandle);
  401.       retcode:=ExamSem(Hihandle,Lohandle,semavalu,opencnt);
  402.       writeln('The return code is : ',retcode);
  403.       writeln('The open count is : ',opencnt);
  404.       writeln('The semaphore value is : ',semavalu);
  405.     end;
  406.  
  407.  
  408. procedure Sem_Wait_Sig;
  409.  
  410.     begin
  411.       ans:='n';
  412.       writeln('When entering the file handle, enter the HEX digits in the following manner: ');
  413.       writeln('    ie.    low part first: $adcb  (put a ''$'' before the hex digits) ');
  414.       writeln;
  415.       write('Enter the semaphore handle, low part first: ');
  416.     readln(Lohandle);
  417.       write('  enter the high part of the handle: ');
  418.     readln(Hihandle);
  419.       writeln('     If you desire to SIGNAL the semaphore (increment) ');
  420.       write('  enter an ''s'', else type return: ');
  421.       readln(ans);
  422.       if ans = 's' then 
  423.         retcode:= SigSem(Hihandle,Lohandle)
  424.       else
  425.            begin
  426.             write('Enter the timeout value in 1/18 secs intervals: ');
  427.         readln(TMO);
  428.         writeln;
  429.             write('waiting... ');
  430.             retcode:=WaitSem(Hihandle,Lohandle,TMO);
  431.            end;
  432.       writeln('The return code is : ',retcode);
  433.     end;
  434.  
  435.  
  436. procedure Sem_Close;
  437.  
  438.     begin
  439.       writeln('When entering the file handle, enter the HEX digits in the following manner: ');
  440.       writeln('    ie.    low part first: $adcb  (put a ''$'' before the hex digits) ');
  441.       writeln;
  442.       write('Enter the semaphore handle, low part first: ');
  443.     readln(Lohandle);
  444.       write('  enter the high part of the handle: ');
  445.     readln(Hihandle);
  446.       retcode:= ClosSem(Hihandle,Lohandle);
  447.       writeln('    closing... the return code is : ',retcode);
  448.     end;
  449.  
  450.  
  451. (************************************************************************)
  452. (* GetOrSet_LockMode sets the Lock Mode to 01 as explained in Function      *)
  453. (* call guide.                                                          *)
  454. (************************************************************************)
  455.  
  456.  
  457. procedure GetOrSet_LockMode;
  458.  
  459.     begin
  460.        writeln('Enter one of the following choices: ');
  461.     writeln;
  462.        writeln('      0 - set to old compatibility mode');
  463.        writeln('      1 - set to new extended locks mode');
  464.        write('      2 - return current lock mode    ---->  ');
  465.     readln(func);
  466.        retcode:=setlck(func);
  467.        writeln('The current lock mode is ',retcode);
  468.     end;
  469.  
  470.  
  471. (************************************************************************)
  472. (* Transaction Tracking Begin, End, TTS verify, Abort trans,
  473.    Transaction status *)
  474. (************************************************************************)
  475.  
  476. procedure TTS_functions;
  477.  
  478.     begin
  479.       writeln('Enter a TTS function code 0');
  480.     writeln('Enter a ''0'' to begin a transaction');
  481.     writeln('Enter a ''1'' to end a transaction (Note - NO Transaction Reference No. is returned)');
  482.     writeln('Enter a ''2'' to verify whether or not the preferred file server supports transaction tracking');
  483.     writeln('Enter a ''3'' to abort a transaction');
  484.     readln(func);
  485.       retcode:=BakOuts(func);
  486.       writeln('The return code is : ',retcode);
  487.     end;
  488.  
  489.  
  490. (*************************************************************************)
  491. (* Begin or End logical locking read-modify-update cycle *)
  492. (*************************************************************************)
  493.  
  494.  
  495. procedure Logical_Begin_End;
  496.  
  497.     begin
  498.       writeln('To begin logical locking enter a ''b''');
  499.     writeln('To end logical locking enter an ''e''');
  500.     write('------->');
  501.     readln(ans);
  502.       if ans = 'b' then
  503.            begin
  504.             ans:='n';
  505.             write('This function assumes that the Lock Mode has been set to 1. If true, type a ''y'' : ');
  506.         readln(ans);
  507.             if ans = 'y' then
  508.                  begin
  509.                   write('Enter the time out amount in 1/18 secs intervels : ');
  510.             readln(TMO);
  511.                   retcode:=btrans(TMO);    
  512.             write('Logical locking installed');
  513.                  end;
  514.            end
  515.       else
  516.         begin
  517.                 retcode:=etrans;
  518.         write('Logical locking ended');
  519.         end;
  520.       writeln('The return code is : ',retcode);
  521.     end;
  522.  
  523.  
  524. (**************************************************************************)
  525. (* Logical record lock functions--Log, Lock, Unlock, Unlock set, Clear rec,
  526.    Clear set *)
  527. (**************************************************************************)
  528.  
  529.  
  530. procedure Logical_locking;
  531.  
  532.     begin
  533.       ans:='n';
  534.       write('This procedure assumes the Lock Mode has been set to 1 if true enter ''y'' : ');
  535.     readln(ans);
  536.       if ans = 'y' then
  537.        begin
  538.             writeln('Choose one of the following functions: ');
  539.             writeln('    0 - Log and Lock a logical record');
  540.             writeln('    1 - Lock all the logical records in the log table');
  541.             writeln('    2 - Release a logical record lock, but do not remove it from the log table');
  542.             writeln('    3 - Release all the logical records in the log table');
  543.             writeln('    4 - Release and remove a logical record from the log table');
  544.             writeln('    5 - Release and remove the entire logical record set from the log table');
  545.             write(' ----> ');
  546.         readln(ans);
  547.             if ans ='0' then
  548.              begin
  549.                   clrscr;
  550.                       writeln('You have chosen to Log and Lock a record ');
  551.             writeln;
  552.                   writeln('Enter a ''1'' to Log and Lock the record (exclusive lock)');
  553.             writeln('Enter a ''3'' to Log and Lock the record (non-exclusive lock)');
  554.             write('------->');        
  555.             readln(flag);
  556.                   write('Enter the record string to lock : ');
  557.             readln(recstr);
  558.                   write('Enter the time out amount in 1/18 sec intervals : ');
  559.             readln(TMO);
  560.                   retcode:=reclog(recstr,flag,TMO);
  561.              end
  562.             else if ans = '1' then
  563.              begin
  564.                   clrscr;
  565.                   writeln('You have chosen to Lock the Record Set ');
  566.                   write('Enter the time out in 1/18 sec intervels : ');
  567.             readln(TMO);
  568.                   retcode:=reclck(TMO);
  569.              end
  570.             else if ans = '2' then
  571.              begin
  572.                   clrscr;
  573.                   writeln('You have chosen to release a record');
  574.                   write('Enter the name of the record string : ');
  575.             readln(recstr);
  576.                   retcode:=reculk(recstr);
  577.              end
  578.             else if ans = '3' then
  579.              begin
  580.                       retcode:=reculks;
  581.                   write('Record set released');
  582.              end
  583.             else if ans = '4' then
  584.              begin
  585.                   clrscr;
  586.                   writeln('You have chosen to clear a record');
  587.                   write('Enter the name of the record string : ');
  588.             readln(recstr);
  589.                   retcode:=recclr(recstr);
  590.              end
  591.             else if ans = '5' then
  592.              begin
  593.                   retcode:=recclrs;
  594.                   write('Record Set Cleared');
  595.              end;
  596.              writeln('The return code is : ',retcode);
  597.        end;
  598.     end;
  599.  
  600.  
  601. (**********************************************************************)
  602. (* Execute an End Of Job call *)
  603. (**********************************************************************)
  604.  
  605.  
  606. procedure EndOfJob;
  607.  
  608.     begin
  609.     retcode:=eoj;
  610.     writeln('EOJ function call completed');
  611.       writeln('The return code is : ',retcode);
  612.     end;
  613.  
  614.  
  615. (********************************************************************)
  616. (* Logout from the network *)
  617. (********************************************************************)
  618.  
  619.  
  620. procedure Sys_logout;
  621.  
  622.     begin
  623.     writeln('Executing the logout function call');
  624.       retcode:=sysout;
  625.       writeln('The return code is : ',retcode);
  626.     end;
  627.  
  628.  
  629. (*******************************************************************)
  630. (* Get the volume statistics *)
  631. (*******************************************************************)
  632.  
  633.  
  634. procedure Get_Vol_Stat;
  635.  
  636.     begin
  637.       write('Enter the volume number : ');
  638.     readln(volume);
  639.     reply:='hi there';
  640.       retcode:=volstat(volume,reply);
  641.       writeln('The return code is : ',retcode);
  642.       writeln;
  643.       writeln('Number of sectors per block : ',ord(reply[1]),ord(reply[2]));
  644.       writeln('Number of total blocks : ',ord(reply[3]),ord(reply[4]));
  645.       writeln('Number of unused blocks : ',ord(reply[5]),ord(reply[6]));
  646.       writeln('Number of directory entries : ',ord(reply[7]),ord(reply[8]));
  647.       writeln('Number of unused directory entries : ',ord(reply[9]),ord(reply[10]));
  648.       write('Volume Name : ',reply[11],reply[12],reply[13],reply[14],reply[15],reply[16]);
  649.       write(reply[17],reply[18],reply[19],reply[20],reply[21],reply[22]);
  650.       writeln(reply[23],reply[24],reply[25],reply[26]);
  651.       writeln('Removeable flag - 00 if volume is not removeable : ',ord(reply[27]),ord(reply[28]));
  652.     end;
  653.  
  654.  
  655. (***********************************************************************)
  656. (* Find number of local disk that the shell has drives mapped to *)
  657. (***********************************************************************)
  658.  
  659.  
  660. procedure Number_Loc_drv;
  661.     
  662.     begin
  663.       retcode:=locdrv;
  664.       writeln('Number of local drives : ',retcode);
  665.     end;
  666.  
  667.  
  668. (***********************************************************************)
  669. (* Get the Logical station number *)
  670. (***********************************************************************)
  671.  
  672.  
  673. procedure Logical_Sta_Num;
  674.  
  675.     begin
  676.       retcode:=wsid;
  677.       writeln('The logical station number is : ',retcode);
  678.     end;
  679.  
  680.  
  681. (*************************************************************************)
  682. (* SetErrorMode sets the Error Mode to 1, so that the program will       *)
  683. (* have control.                                                         *)
  684. (*************************************************************************)
  685.  
  686.  
  687. procedure SetErrorMode;
  688.     begin
  689.       writeln('To set the error mode');
  690.       writeln('Enter one of the following : ');
  691.       writeln('      0 - to display errors on screen');
  692.       writeln('      1 - Extended errors for all file I/O returned in AL');
  693.       writeln('      2 - Critical errors returned in AL (only Netware 2.x and up)');
  694.       write('------>  ');
  695.     readln(func);
  696.       retcode:=errmode(func);
  697.       writeln('The previous error mode was : ',retcode);
  698.     end;
  699.  
  700.  
  701. (*************************************************************************)
  702. (* This function allows programs to change the way the shell treats network *)
  703. (* broadcast messages. *)
  704. (*************************************************************************)
  705.  
  706.  
  707. procedure Change_Bcast;
  708.  
  709.     begin
  710.       writeln('To set the broadcast mode, choose one of the following : ');
  711.       writeln('       0 - Receive console and workstation broadcasts');
  712.       writeln('       1 - Receive console broadcasts only');
  713.       writeln('       2 - Disable receipt of all broadcasts');
  714.       writeln('       3 - Store broadcast messages');
  715.       writeln('       4 - Return current broadcast mode');
  716.       writeln('       5 - Shell timer interrupt checks are disabled');
  717.       writeln('       6 - Shell timer interrupts are enabled');
  718.       write('---->  ');
  719.     readln(func);
  720.       retcode:=bcsmode(func);
  721.       writeln;writeln('The current mode is : ',retcode);
  722.     end;
  723.  
  724.  
  725. (************************************************************************)
  726. (* The Modify LST Device function enables the use of the network spool device*)
  727. (************************************************************************)
  728.  
  729.  
  730. procedure Spool_func;
  731.  
  732.     begin
  733.       writeln('You have chosen to start your spool device, enter one of the following :');
  734.       writeln('       0 - Start the LST catch');
  735.       writeln('       1 - End the LST catch and queue for printing');
  736.       writeln('       2 - End the LST catch and abort print');
  737.       writeln('       3 - Queue for printing and restart LST catch');
  738.       write('---->  ');
  739.     readln(func);
  740.       retcode:=ctlspl(func);
  741.       writeln;
  742.     writeln('The return code is : ',retcode);
  743.     end;
  744.  
  745.  
  746. (*********************************************************************)
  747. (* Spool data to a capture file located on the server *)
  748. (*********************************************************************)
  749.  
  750.  
  751. procedure Spool_Capture;
  752.     var packet, tab, copy, prnt, form: integer;
  753.         ban: str;
  754.         res: char;
  755.  
  756.     begin
  757.       ans:='n';
  758.       writeln('Choose one of the following spool functions : ');
  759.       writeln('              0 - Spool data to a capture file on the server');
  760.       writeln('              1 - Close and Queue or Abort the capture file');
  761.       writeln('              2 - Set the spool flags');
  762.       write('---->  ');
  763.     readln(func);
  764.     writeln;
  765.       if func = 0 then
  766.            begin
  767.             writeln('Enter a string to be spooled (length = 1 to 52) :');
  768.             readln(request);
  769.             request:=chr(length(request) + 1) + chr(0) + chr(func) + request;
  770.            end
  771.       else if func = 1 then
  772.            begin
  773.             write('If you want to ABORT the queue type a ''y'' : ');
  774.         readln(ans);
  775.             if ans = 'y' then
  776.                   request:=chr(2) + chr(0) + chr(func) + chr(255)
  777.             else 
  778.             request:=chr(1) + chr(0) + chr(func);
  779.            end
  780.       else if func = 2 then
  781.            begin
  782.             write('Do you want a banner page? (y/n) : ');
  783.         readln(ans);
  784.             if ans = 'y' then 
  785.             packet:=21 else packet:=6;
  786.         writeln('Enter the print flags, the choices are: ');
  787.             writeln('    08h - Suppress auto form feed at the end of a print job');
  788.             writeln('    20h - Delete spool file after printing');
  789.             writeln('    40h - Enable tab expansion');
  790.             writeln('    80h - Print a banner page');
  791.             writeln('  example: to suppress form feed and print a banner page add the two numbers');
  792.             writeln('    in HEX --> 008h + 80h = 88h.   TO ENTER --> $88 ($ = HEX) ');
  793.         writeln;
  794.             write('--->  ');
  795.         readln(flag);
  796.         writeln;
  797.             write('Enter the Tab size 1..20 : ');
  798.         readln(tab);
  799.             write('Enter the target printer 0..p : ');
  800.         readln(prnt);
  801.             write('Enter the number of copies to print 0..255 (0 copies = no printing : ');
  802.         readln(copy);
  803.             write('Enter the form type 0..255 : ');
  804.         readln(form);
  805.             write('Enter the string for the banner 1..13 chars : ');
  806.         readln(ban);
  807.             request:=chr(packet)+chr(0)+chr(2)+chr(flag)+chr(tab)+chr(prnt)+chr(copy)+chr(form)+res+ban+chr(0);
  808.         end;
  809.       reply:=chr(0) + chr(0);
  810.       retcode:=splreq(request,reply);
  811.       writeln('The return code is : ',retcode);
  812.     end;
  813.  
  814.  
  815. (*************************************************************************)
  816. (* Network Communication Function Calls-- Pipes and broadcast *)
  817. (*************************************************************************)
  818.  
  819.  
  820. procedure Pipes;
  821.     var numsta,stanum: integer;
  822.         message: str;
  823.     
  824.     begin
  825.         writeln('Choose one of the following piping functions: ');
  826.       writeln;
  827.       writeln('       0 - Send a broadcast message');
  828.       writeln('       1 - Get a broadcast message');
  829.       writeln('       2 - Disable station broadcasts');
  830.       writeln('       3 - Enable station broadcasts');
  831.       writeln('   Pipe functions can be added, see function call manual');
  832.       writeln;
  833.       write('-----> ');
  834.     readln(func);
  835.     writeln;
  836.       reply:=chr(255)+chr(0);
  837.       if func = 0 then
  838.            begin
  839.             writeln('For our purposes, only one station needs to receive the message ');
  840.             write('Enter the station number: ');
  841.         readln(stanum);
  842.         numsta:=1;
  843.             write('Enter the string you want to send: ');
  844.         readln(message);
  845.             request:= chr(length(message)+4)+chr(0)+chr(0)+chr(numsta)+chr(stanum)+chr(length(message))+message;
  846.             retcode:=pipreq(request,reply);
  847.            end
  848.       else if func = 1 then
  849.            begin
  850.             request:=chr(1)+chr(0)+chr(1);
  851.             retcode:=pipreq(request,reply);
  852.             reply[0]:=chr(ord(reply[3])+3);    { makes printable to screen }
  853.                 reply[3]:=chr(0);                  { "       "   "       "     "   "    }
  854.             writeln(reply);
  855.            end
  856.       else if func = 2 then
  857.            begin
  858.             request:=chr(1)+chr(0)+chr(2);
  859.             retcode:=pipreq(request,reply);
  860.            end
  861.       else if func = 3 then
  862.            begin
  863.             request:=chr(1)+chr(0)+chr(3);
  864.             retcode:=pipreq(request,reply);
  865.            end;
  866.       writeln;
  867.       writeln('Error code is: ',retcode);
  868.     end;
  869.  
  870.  
  871. (************************************************************************)
  872. (* Directory Request functions *)
  873. (************************************************************************)
  874.  
  875.  
  876. procedure directory;
  877.     var sbase: integer;
  878.      
  879.     begin
  880.       writeln('Get the Base Path Mapping for the entered drive');
  881.       write('Enter a SOURCEBASE (drive handle--1 or 2): ');
  882.     readln(sbase);
  883.       request:=chr(2)+chr(0)+chr(1)+chr(sbase);
  884.       reply:=chr(255)+chr(0);
  885.       retcode:=dpath(request,reply);
  886.       reply[0]:=chr(ord(reply[3])+3);
  887.       reply[3]:=chr(0);
  888.       writeln('Return code is: ',retcode);
  889.       writeln(reply);
  890.     end;
  891.  
  892.  
  893. (*************************************************************************)
  894. (* Log request functions  *)
  895. (**************************************************************************)
  896.  
  897.  
  898. procedure SystemLog;
  899.     var connection: integer;
  900.  
  901.     begin
  902.       writeln('Get a Stations Logged Information');
  903.       write('Enter the logical station number or connection number:  ');
  904.       readln(connection);
  905.       request:=chr(2)+chr(0)+chr(5)+chr(connection);
  906.       reply:=chr(255)+chr(1);
  907.       retcode:=syslog(request,reply);
  908.       reply[0]:=chr(255);
  909.       writeln('The return code is: ',retcode);
  910.       writeln('The return string is: ');
  911.       writeln(reply);
  912.     end;
  913.  
  914.  
  915. (************************************************************************)
  916. (* Get the Date/Time String *)
  917. (************************************************************************)
  918.  
  919.  
  920. procedure GetTime;
  921.     var time:str;
  922.  
  923.     begin
  924.       retcode:=nettod(time);  { The value in the str is found at byte#-1 }
  925.       writeln('The return code is: ',retcode);
  926.       writeln('The month/day/year is: ',ord(time[1]),'/',ord(time[2]),'/',ord(time[0]));
  927.       writeln('The time is: ',ord(time[3]),':',ord(time[4]),':',ord(time[5]));
  928.       case ord(time[6]) of
  929.            0:writeln('The day is Sunday');
  930.            1:writeln('The day is Monday');
  931.            2:writeln('The day is Tuesday');
  932.            3:writeln('The day is Wednesday');
  933.            4:writeln('The day is Thursday');
  934.            5:writeln('The day is Friday');
  935.            6:writeln('The day is Saturday');
  936.       end;
  937.     end;
  938.  
  939.  
  940. (*************************************************************************)
  941. (* Get the shell's Base Status *)
  942. (*************************************************************************)
  943.  
  944.  
  945. procedure driveHand;
  946.     var drive: integer;
  947.  
  948.     begin
  949.         write('Enter the drive number to check (A = 0, B = 1 etc.): ');
  950.     readln(drive);
  951.       retcode:=drvmap(drive);
  952.       writeln('The network pathbase (drive handle) is: ',retcode);
  953.     end;
  954.  
  955.  
  956. (*************************************************************************)
  957. (* Return the Shell Version *)
  958. (*************************************************************************)
  959.  
  960.  
  961. procedure RetShellVer;
  962.     var envirstr: str;
  963.         mode: integer;
  964.  
  965.     begin
  966.       writeln('Enter the mode:');
  967.     writeln('   0 - Find hardware type only');
  968.       writeln('   1 - get the OS, version and hardware type');
  969.       write('------>  ');
  970.     readln(mode);
  971.       if mode = 0 then
  972.            begin
  973.             retcode:=retshl(envirstr,mode);
  974.             writeln('Hardware type is: ',retcode);
  975.             writeln('The type is defined as follows, 0 - IBM PC, 1 - Victor 9000');
  976.            end
  977.       else
  978.            begin
  979.             retcode:=retshl(envirstr,mode);
  980.             envirstr[0]:=chr(30);
  981.             writeln(envirstr);
  982.            end;
  983.      end;
  984.  
  985.  
  986. (*************************************************************************)
  987. (* Log and/or Lock an ASCIIZ String *)
  988. (*************************************************************************)
  989.  
  990.  
  991. procedure AsciizStr;
  992.     begin
  993.       writeln('Choose one of the following:');
  994.     writeln('    0 - Log or Lock the Asciiz string');
  995.       writeln('    1 - Release an Asciiz string');
  996.       writeln('    2 - Clear an Asciiz string');
  997.       write('-------> ');
  998.     readln(func);
  999.       writeln;
  1000.       if func = 0 then
  1001.            begin
  1002.             writeln('Type a ''0'' if you only want to log the string');
  1003.         writeln('Type a ''1'' if you want to log and lock the string');
  1004.         write('------->');
  1005.         readln(flag);
  1006.             write('Enter the string name: ');
  1007.         readln(asciiz);
  1008.             asciiz[length(asciiz)+1]:=chr(0);
  1009.             writeln(asciiz);
  1010.             write('Enter the desired timeout value in 1/18 second intervals: ');
  1011.         readln(TMO);
  1012.             writeln;
  1013.             retcode:=asclog(flag,TMO,asciiz);
  1014.            end
  1015.       else if func = 1 then
  1016.            begin
  1017.             write('Enter the name of the string to be released: ');
  1018.         readln(asciiz);
  1019.             asciiz[length(asciiz)+1]:=chr(0);   { Make an asciiz string }
  1020.             retcode:=asculkf(asciiz);
  1021.            end
  1022.       else if func = 2 then
  1023.            begin
  1024.                 write('Enter the name of the string to be cleared: ');
  1025.         readln(asciiz);
  1026.             asciiz[length(asciiz)+1]:=chr(0);   {Make an asciiz string }
  1027.             retcode:=ascclrf(asciiz);
  1028.            end;
  1029.        writeln('The return code is: ',retcode);
  1030.     end;
  1031.  
  1032.  
  1033. (************************************************************************)
  1034. (* Get Physical station Number--switch setting on the Network Interface Card*)
  1035. (************************************************************************)
  1036.  
  1037.  
  1038. procedure GetPhsNum;
  1039.     
  1040.     begin
  1041.       retcode:=get_psn;
  1042.       writeln('The Physical Station Number is : ',retcode);
  1043.     end;
  1044.  
  1045.  
  1046. (************************************************************************)
  1047. (* Get the Shell table Addresses *)
  1048. (************************************************************************)
  1049.  
  1050.  
  1051. procedure GetShlAdr;
  1052.  
  1053.     begin
  1054.       writeln('Enter one of the following choices: ');
  1055.       writeln('         0 - Get the Drive Handle Table');
  1056.       writeln('         1 - Get the Drive Flag Table');
  1057.       writeln('         2 - Get the Drive Server Table');
  1058.       writeln('         3 - Get the Server Mapping Table');
  1059.       write('----->  ');
  1060.     readln(mode);
  1061.       retcode:=get_sta(mode,seg,off);
  1062.       writeln;
  1063.       writeln('These segment and offset addresses have been displayed in decimal');
  1064.       writeln;
  1065.       writeln('The segment address is: ',seg);
  1066.       writeln('The offset address is: ',off);
  1067.     end;
  1068.  
  1069.  
  1070. (************************************************************************)
  1071. (* Set the preferred File Server *)
  1072. (************************************************************************)
  1073.  
  1074.  
  1075. procedure PrefServ;
  1076.  
  1077.     begin
  1078.       writeln('Enter one of the following: ');
  1079.       writeln('        0 - Set the preferred file server');
  1080.       writeln('        1 - Get the preferred file server');
  1081.       writeln('        2 - Get the Effective File Server');
  1082.       writeln('        3 - Get the Spooled file server');
  1083.       writeln('        4 - Set the primary file server');
  1084.       writeln('        5 - Get the Primary file server');
  1085.       write('----->  ');
  1086.     readln(mode);
  1087.       writeln;
  1088.       write('Enter the preferred server 1-8:  ');
  1089.     readln(newserv);
  1090.       retcode:=setserv(mode,newserv);
  1091.       writeln('The return code is:  ',retcode);
  1092.     end;
  1093.  
  1094.  
  1095. (************************************************************************)
  1096. (* Attach or Detach to a file server *)
  1097. (************************************************************************)
  1098.  
  1099.  
  1100. procedure AttDetServ;
  1101.    
  1102.     begin
  1103.       writeln('Enter one of the following: ');
  1104.       writeln('       0 - Attach to a specfied server');
  1105.       writeln('       1 - Logout and detach from a specified server');
  1106.       writeln('       2 - Logout but do not dettach from a specified server');
  1107.       write('----> ');
  1108.     readln(mode);
  1109.       writeln;
  1110.       write('Enter the specified server numbers 1-8: ');
  1111.     readln(newserv);
  1112.       writeln;
  1113.       retcode:=modserv(mode,newserv);
  1114.       writeln('The return code is: ',retcode);
  1115.     end;
  1116.  
  1117.  
  1118.  
  1119. (*************************************************************************)
  1120.  
  1121.  
  1122. procedure menu;
  1123.     var stop:boolean;
  1124.  
  1125.     begin
  1126.       repeat
  1127.           clrscr;
  1128.           stop:=false;
  1129.           hex:=' ';
  1130.           writeln('Choose one of the following: ');
  1131.           writeln('0 - Get or Set the lock mode');
  1132.           writeln('1 - OPEN a file');
  1133.           writeln('2 - SET or Get a files attributes');
  1134.           writeln('3 - Check the EOJ status');
  1135.           writeln('4 - Log and Lock a record');
  1136.           writeln('5 - Release a locked record');
  1137.           writeln('6 - Lock a record set, all the records in the stations log table');
  1138.           writeln('7 - Release a locked record set');
  1139.           writeln('8 - Open a semaphore');
  1140.           writeln('9 - Examine a semaphore');
  1141.           writeln('A - Wait semaphore (decrement value) or Signal semaphore (increment value)');
  1142.           writeln('B - Close a semaphore');
  1143.           writeln('C - TTS Functions');
  1144.           writeln('D - Begin or End logical locking read_modify_update cycle');
  1145.           writeln('E - Logical locking functions');
  1146.           writeln('F - Execute an End Of Job');
  1147.           writeln('G - Logout');
  1148.           writeln('Z - Quit');
  1149.           writeln;
  1150.           writeln('  ENTER A CORRESPONDING CHARACTER OR TYPE RETURN TO SEE THE REST OF THE MENU ');
  1151.           writeln('******************************************************************************');
  1152.           write('----> ');
  1153.         readln(ans);
  1154.           if NOT (ans IN ['0','1','2','3','4','5','6','7','8','9','a','b','c','d','e','f','g','z','A','B','C','D','E','F','G','Z']) then
  1155.                begin
  1156.                 clrscr;
  1157.                 writeln('H - Get the volume statistics');
  1158.                 writeln('I - Get the number of local drives');
  1159.                 writeln('J - Get the logical station number');
  1160.                 writeln('K - Set the error mode');
  1161.                 writeln('L - Set the broadcast mode');
  1162.                 writeln('M - Start the spooler under program control');
  1163.                 writeln('N - Various spooling functions');
  1164.                 writeln('O - Piping functions');
  1165.                 writeln('P - Directory Functions');
  1166.                 writeln('Q - Sytem log functions');
  1167.                 writeln('R - Get the Date/Time string');
  1168.                 writeln('S - Get the shells Base Status');
  1169.                 writeln('T - Get the shell version');
  1170.                 writeln('U - Log, Lock, Release and clear an Asciiz string.');
  1171.                 writeln('     Any Asciiz string function are assuming the Lock mode is 1');
  1172.                 writeln('V - Get the Physical Station Number');
  1173.                 writeln('W - Get the shell table addresses');
  1174.                 writeln('X - Get the preferred server, different functions');
  1175.                 writeln('Y - Attach or Detach a specified server');
  1176.                 writeln('Z - Quit');
  1177.                 writeln;
  1178.                 writeln('       ENTER A CORRESPONDING CHARACTER OR TYPE RETURN TO SEE MENU AGAIN...');
  1179.                 writeln('******************************************************************************');
  1180.                 write('------> ');
  1181.             readln(ans);
  1182.               end;    
  1183.           clrscr;
  1184.           case ans of
  1185.                '0':GetOrSet_LockMode;
  1186.                '1':OPEN;
  1187.                '2':SETGET;
  1188.                '3':SetEOJ;
  1189.                '4':Log_Lock;
  1190.                '5':Rel_Clr;
  1191.                '6':Lock_Set;
  1192.                '7':Set_Rel_Clr;
  1193.                '8':Sem_Open;
  1194.                '9':Sem_Exam;
  1195.                'a', 'A':Sem_Wait_Sig;
  1196.                'b', 'B':Sem_Close;
  1197.                'c', 'C':TTS_Functions;
  1198.                'd', 'D':Logical_Begin_End;
  1199.                'e', 'E':Logical_Locking;
  1200.                'f', 'F':EndOfJob;
  1201.                'g','G':Sys_logout;
  1202.                'h', 'H':Get_Vol_Stat;
  1203.                'i', 'I':Number_loc_drv;
  1204.                'j', 'J':Logical_Sta_Num;
  1205.                'k', 'K':SetErrorMode;
  1206.                'l', 'L':Change_Bcast;
  1207.                'm', 'M':Spool_Capture;
  1208.                'n', 'N':Spool_Capture;
  1209.                'o', 'O':Pipes;
  1210.                'p', 'P':Directory;
  1211.                'q', 'Q':SystemLog;
  1212.                'r', 'R':GetTime;
  1213.                's', 'S':DriveHand;
  1214.                't', 'T':RetShellVer;
  1215.                'u', 'U':AsciizStr;
  1216.                'v', 'V':GetPhsNum;
  1217.                'w', 'W':GetShlAdr;
  1218.                'x', 'X':PrefServ;
  1219.                'y', 'Y':AttDetServ;
  1220.                'z', 'Z':stop:=true;
  1221.             end;
  1222.             if stop = FALSE then
  1223.                 begin
  1224.                      writeln;
  1225.                 writeln;
  1226.                      write('Type return to continue... ');
  1227.                 readln;
  1228.                 end;
  1229.        until stop = true;
  1230.     end;
  1231.  
  1232.  
  1233.  
  1234. (**************************** MAIN PROGRAM ******************************)
  1235.  
  1236.  
  1237.     begin
  1238.         clrscr;
  1239.         writeln;writeln;writeln;writeln;
  1240.         writeln('                  SAMPLE FUNCTION CALL LIBRARY INTERFACE ');
  1241.         write('         please type return to continue... ');
  1242.         readln;
  1243.         writeln;
  1244.         explain;
  1245.         writeln;writeln;writeln;writeln;
  1246.         func:=1;
  1247.         retcode:=errmode(func);
  1248.         writeln('The ERROR MODE has been set to 1, to proceed type return');
  1249.         readln;writeln;
  1250.         menu;
  1251.     end.
  1252.  
  1253.  
  1254.  
  1255.  
  1256.  
  1257.  
  1258.  
  1259.             
  1260.