home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / turbopas / zindent5.lbr / SYSDSK.IQC / SYSDSK.INC
Text File  |  1986-09-24  |  9KB  |  345 lines
  1.  
  2. (* Include File of Procedures *************************************)
  3. (* System Disk Utility,  v. 0922pm, thu, 18.Sep.86, Glen Ellis *)
  4.  
  5.  
  6.  
  7. (* procedure *******************************************************)
  8. (* Say File List,     v. 0126pm, mon, 01.Sept.86, Glen Ellis       *)
  9.  
  10. procedure pSayFileList;
  11.  
  12. begin
  13.    writeln;
  14.    FOR x := 1 to SysInSourceMax do
  15.    begin
  16.       writeln('SysInSource[',x,'] = ', SysInSource[x] );
  17.    end;
  18.    writeln;
  19. end;
  20.  
  21.  
  22. (* procedure **************************************************)
  23. (* System Parse .inc, v. 0555am, sat, 13.Sep.86, Glen Ellis   *)
  24.  
  25. procedure pSysParse( pFILE : Thestr ; var PgmMod : string2 ;
  26. var PgmModStrL, PgmModStrR : string2 );
  27.  
  28. (* SysInFilename contains the real SourceFileName *)
  29. (* parse for ?TYP
  30. (*   OutLine(.TXT) /  dBASE(.CMD.PRG) / Pascal(.PAS.INC.PRO.FUN)
  31. (* default to .$$$ (which is written normally any way)
  32. (* set SysMode flag to (null) or (OL) or (TP) or (DB)
  33. (*---------------------------------------------------------*)
  34.  
  35. (* pFILE    = pFILEName to be parsed for .TYP mode
  36. (* Mode     = flag for system use
  37. (* ModStrL  = prefix for comment line
  38. (* ModStrR  = Suffix for comment line
  39. *)
  40.  
  41. var
  42. i  : nbr;
  43. uTYPArray : array[0..12] of string4;
  44. uTYPe     : string4;
  45. uLine     : THEstr;
  46.  
  47. begin (* proc *)
  48.    
  49.    PgmMod := '  ';
  50.    PgmModStrL  := '  ';
  51.    PgmModStrR  := '  ';
  52.    
  53.    (* OutLine *)
  54.    uTYPArray[0] := '.TXT';
  55.    
  56.    (* dBASE *)
  57.    uTYPArray[1] := '.CMD';
  58.    uTYPArray[2] := '.PRG';
  59.    
  60.    (* Turbo Pascal *)
  61.    uTYPArray[3] := '.PAS';
  62.    uTYPArray[4] := '.INC';
  63.    uTYPArray[5] := '.FUN';
  64.    uTYPArray[6] := '.PRO';
  65.    uTYPArray[7] := '.BOX';
  66.    
  67.    IF length(pFILE) = 0 then
  68.    begin
  69.       writeln('No FileName Entered');
  70.       pAlarm;
  71.       pKeyPressed;
  72.    end;
  73.    
  74.    pUpCase(pFILE);    (* parse for filename *)
  75.    x  := pos('.',pFILE);
  76.    IF x < 4 then
  77.    begin
  78.       pFILE := '.###';
  79.       x := 1;
  80.    end;
  81.    uTYPe := copy(pFILE,x,4);
  82.    
  83.    (* ? force caps for compare ? *)
  84.    uLine := uTYPe;
  85.    pUpCase(uLine);
  86.    
  87.    (*------*)
  88.    (* OutLine , general catch-all *)
  89.    
  90.    begin
  91.       IF uTYPe =  uTYPArray[0] then
  92.       begin
  93.          PgmMod := 'OL';
  94.          PgmModStrL  := '* ';
  95.          PgmModStrR  := ' *';
  96.       end;
  97.    end;
  98.    
  99.    
  100.    for x := 1 to 2 do
  101.    begin
  102.       (* dBASE *)
  103.       IF uTYPe =  uTYPArray[x] then
  104.       begin
  105.          PgmMod := 'DB';
  106.          PgmModStrL  := '* ';
  107.          PgmModStrR  := ' *';
  108.       end;
  109.    end;
  110.    
  111.    (* Turbo Pascal *)
  112.    for x := 3 to 7 do
  113.    begin
  114.       IF uTYPe =  uTYPArray[x] then
  115.       begin
  116.          PgmMod := 'TP';
  117.          PgmModStrL := '(*';
  118.          PgmModStrR := '*)';
  119.       end;
  120.    end;
  121.    
  122. end; (* proc *)
  123.  
  124.  
  125. (* procedure ************************************************************)
  126. (* Input/Output Error Checking, v. 0800am, mon, 15.Sept.86, Glen Ellis  *)
  127.  
  128. procedure pIOCheck( var IOcheck : lgc );
  129.  
  130. (* develop no halt for trying to read non-existent file *)
  131. (* need skip read loop, continue program if no file found *)
  132.  
  133. var
  134. Ch : Char;
  135. IOReadErr : lgc;
  136.  
  137. begin (* proc *)
  138.    
  139.    IOVal := IOresult;
  140.    IOErr := (IOVal <> 0);
  141.    
  142.    (* GotoXY(1,23); ClrEol; *)
  143.    
  144.    IF IOErr then
  145.    begin
  146.       
  147.       Write(Chr(7));
  148.       writeln('---------------------');
  149.       writeln(' procedure I/O Check ');
  150.       writeln('---------------------');
  151.       
  152.       (*    pAlarm; (* SysUtl.inc *)
  153.       
  154.       CASE IOVal of
  155.          
  156.          $01  :  Write('File does not exist');
  157.          $02  :  Write('File not open for input');
  158.          $03  :  Write('File not open for output');
  159.          $04  :  Write('File not open');
  160.          $05  :  Write('Can''t read from this file');
  161.          $06  :  Write('Can''t write to this file');
  162.          $10  :  Write('Error in numeric format');
  163.          $20  :  Write('Operation not allowed on a logical device');
  164.          $21  :  Write('Not allowed in direct mode');
  165.          $22  :  Write('Assign to standard files not allowed');
  166.          $90  :  Write('Record length mismatch');
  167.          $91  :  Write('Seek beyond end of file');
  168.          $96  :  Write('Strange undefined IO error, not in manual !');
  169.          $99  :  Write('Unexpected end of file');
  170.          $F0  :  Write('Disk write error');
  171.          $F1  :  Write('Directory is full');
  172.          $F2  :  Write('File size overflow');
  173.          $FF  :  Write('File disappeared')
  174.          else      Write('Unknown I/O error:  ',IOVal:3)
  175.       end; (* case *)
  176.       
  177.       writeln;
  178.       
  179.       (* fatal type error *)
  180.       IF IOval = $01 then
  181.       begin       (* if no read file, then skip read loop *)
  182.          IOcheck := false ;
  183.          IF SysPgmTrace then
  184.          begin
  185.             writeln('IOcheck = ',IOcheck,' : IOval = ',IOval,chr(7));
  186.             delay(1000);
  187.          end;
  188.       end;
  189.       
  190.       (* not fatal type error *)
  191.       IF IOval > $01 then  (**)
  192.       begin
  193.          (* no function for non-fatal errors *)
  194.          IF SysPgmTrace then
  195.          begin
  196.             IF KeyPressed Then
  197.             begin
  198.                Repeat
  199.                   Read(Kbd,Ch)
  200.                Until Not KeyPressed;
  201.                writeln('User Interrupt allowed ');
  202.                Write(^M,'Terminate (Y/N)? ');
  203.                Read(Kbd,Ch);
  204.                IF UpCase(Ch)='Y' Then
  205.                begin
  206.                   WriteLn('Y');
  207.                   (* Write(SysOutFile,'User Terminated on pIOcheck error');*)
  208.                   Close(SysOutFile);
  209.                   Halt;
  210.                end
  211.                Else Write(^M,'                ',^M);
  212.             end; (* keypressed *)
  213.          end; (* SysPgmTrace *)
  214.       end; (* IOval *)
  215.    end; (* IOerr *)
  216. end; (* proc *)
  217.  
  218.  
  219. (* procedure ****************************************************)
  220. (* Start System Files,   v. 0752pm, thu, 18.Sep.86, Glen Ellis *)
  221.  
  222. procedure pSysStartFiles( var IOcheck : lgc );
  223.  
  224. (* borrows system global vars *)
  225. (* SysFile 0,1,2, SysIOcheck flag*)
  226.  
  227. var
  228. x : integer;
  229.  
  230. begin (* proc *)
  231.    
  232.    (* position of .typ *)
  233.    x := pos('.',SysInFileName);
  234.    
  235.    (* file.BAK *)
  236.    SysFile0 := copy(SysInFileName,1,x);
  237.    SysFile0 := concat(SysFile0,'BAK');
  238.    
  239.    (* file.CMD *)
  240.    SysFile1 := SysInFileName;
  241.    
  242.    (* file.$$$ *)
  243.    SysFile2 := copy(SysInFileName,1,x);
  244.    SysFile2 := concat(SysFile2,'$$$');
  245.    
  246.    IF SysUserTrace then
  247.    begin
  248.       pSaySysFiles;   (* SysUtl.inc *)
  249.       IF SysPgmTrace then delay(1000);
  250.    end;
  251.    
  252.    IF SysUserTrace then writeln('Assign Read-File  = ',SysFile1);
  253.    ASSIGN( SysInFile, SysFile1 );
  254.    
  255.    IF SysUserTrace then writeln('Reset   Read      = ',SysFile1);
  256.    (*$I-*); RESET( SysInFile ); (*$I+*);
  257.    pIOcheck( IOcheck );
  258.    
  259.    IF IOcheck  then (* able to read from Source file *)
  260.    begin
  261.       
  262.       IF SysUserTrace then writeln('Assign Write-File = ',SysFile2);
  263.       ASSIGN( SysOutFile, SysFile2 );
  264.       
  265.       IF SysUserTrace then writeln('ReWrite  Write    = ',SysFile2);
  266.       (*$I-*); REWRITE( SysOutFile ); (*$I+*);
  267.       pIOcheck( IOcheck );
  268.       
  269.    end; (* IOcheck *)
  270.    
  271. end; (* proc *)
  272.  
  273.  
  274.  
  275. (* Procedure *********************************************************)
  276. (* Rename System Files,  v. 0830pm, wed, 17.Sep.86, Glen Ellis *)
  277.  
  278. procedure pSysReName( var IOcheck : lgc );
  279.  
  280. begin (* proc *)
  281.    
  282.    (* borrows system global vars *)
  283.    
  284.    (* purpose:
  285.    (* rename the outfile.$$$ to Sourcefile.CMD
  286.    (* so operation of program is invisible to user
  287.    
  288.    (* test for infile.bak prior to erase/rename
  289.    
  290.    (* SysFile0 is Source.BAK *)
  291.    (* SysFile1 is Source.CMD *)
  292.    (* SysFile2 is Source.$$$ *)
  293.    
  294.    IF SysUserTrace then writeln('--- Rename Files ---');
  295.    
  296.    ASSIGN( SysInfile, SysFile0 ); (* test for presence of file.BAK *)
  297.    (*$I-*); RESET( SysInFile ); (*$I+*);
  298.    pIOcheck( IOcheck );
  299.    (* if not file.BAK, then simply continue *)
  300.    
  301.    (* handled by pIOcheck() *);
  302.    (* IOval   := IOresult ; *)
  303.    (* IOerr   := (IOval <> 0); *)
  304.    
  305.    IF not IOerr then
  306.    begin
  307.       IF SysUserTrace then writeln('--- Erase ',SysFile0,' ---');
  308.       (*$I-*); ERASE( SysInFile ); (*$I+*);
  309.       pIOcheck( IOcheck );
  310.    end;
  311.    
  312.    IF SysUserTrace then
  313.    writeln('--- Rename ',SysFile1, ' to ',SysFile0,' ---');
  314.    
  315.    
  316.    ASSIGN(SysInFile,SysFile1); (* open Source.CMD *)
  317.    (*$I-*); RENAME( SysInFile, SysFile0 ); (*$I+*);
  318.    (* rename Source.CMD to Source.BAK *)
  319.    (*$I-*); CLOSE( SysInFile ); (*$I+*);
  320.    pIOcheck( IOcheck );  (* close  Source.BAK *)
  321.    
  322.    IF SysUserTrace then
  323.    writeln('--- Rename ',SysFile2,' to ',SysFile1,' ---');
  324.    
  325.    ASSIGN( SysOutfile, SysFile2 );
  326.    (*$I-*); RENAME( SysOutFile, SysFile1 ); (*$I+*);
  327.    pIOcheck( IOcheck );
  328.    (*$I-*); CLOSE( SysInFile ); (*$I+*);
  329.    pIOcheck( IOcheck );
  330.    (*$I-*); CLOSE( SysOutFile ); (*$I+*);
  331.    pIOcheck( IOcheck );
  332.    
  333.    IF SysUserTrace then writeln('--- Close Files ---');
  334.    
  335. end; (* proc *)
  336.  
  337. (*---------------------------------------------------------*)
  338. (*:B:0*)
  339. (*:B:0*)
  340. (*:B:0*)
  341. (*:B:0*)
  342.    
  343. end; (* proc *)
  344.  
  345. (*--------------------------------