home *** CD-ROM | disk | FTP | other *** search
/ Power Programming / powerprogramming1994.iso / progtool / turbopas / sfmsrc.arc / SFMOTHER.INC < prev    next >
Text File  |  1987-06-01  |  12KB  |  297 lines

  1. {                          Super File Manager
  2.  
  3.                              SFMOTHER.INC
  4.  
  5.                            by David Steiner
  6.                               2035 J Apt. 6
  7.                               Lincoln, NE
  8.  
  9.  
  10.    Routines placed in this include file have been taken from other
  11.      sources.  Although there are only two such procedures, I find
  12.      them both very useful.
  13.  
  14.  
  15.    DISPLAY: Routines released into the public domain.
  16.  
  17.                by Keith G. Chuvala
  18.                   317 West 8th
  19.                   Winfield, KS  67156
  20.                   (316) 221-0814
  21.  
  22.  
  23.    INT24:   Taken from a magazine article in Programmer's Journal.
  24.               I'd list which issue and all but I can't seem to find it.
  25.  
  26.                by Bela Lubkin
  27.  
  28.    Another program I couldn't have done without is David Baldwin's
  29.      Inline Assembler.  This program takes chunks of assembly code
  30.      and turns it into Turbo inline statements.
  31.      Its only drawback is the fact that it comes with essentially no
  32.      documentation.
  33.  
  34. }
  35.  
  36. Procedure display(col,row,attr: byte; str: str80);
  37.   {
  38.   Procedure written by Keith G. Chuvala, minor changes made
  39.     by myself to conform the row/col to the Turbo standard.
  40.     Also altered to conform the input assembly code for acceptance
  41.     by David Baldwin's Inline Assembler.
  42.   }
  43. begin
  44.   Inline(
  45.     $1E            {        push  ds             ; We'll modify DS twice, so }
  46.     /$1E           {        push  ds             ;    we'll save it twice.   }
  47.     /$8A/$86/>ROW  {        mov   al,[BP+>row]   ; Get row.                  }
  48.     /$FE/$C8       {        DEC   AL             ; CONVERT FROM TURBO ROW/COL}
  49.     /$B3/$50       {        mov   bl,$50         ; Mult. by 80 columns/row.  }
  50.     /$F6/$E3       {        mul   bl                                         }
  51.     /$29/$DB       {        sub   bx,bx                                      }
  52.     /$8A/$9E/>COL  {        mov   bl,[BP+>col]   ; Get column.               }
  53.     /$FE/$CB       {        DEC   BL             ; CONVERT FROM TURBO STNDRD }
  54.     /$01/$D8       {        add   ax,bx          ; Add column to row.        }
  55.     /$01/$C0       {        add   ax,ax          ; Must double AX for attr.  }
  56.     /$89/$C7       {        mov   di,ax          ; Set DI to buffer location.}
  57.     /$BE/$00/$00   {        mov   si,$0000                                   }
  58.     /$8A/$BE/>ATTR {        mov   bh,[BP+>attr]  ; Attribute stays in BH.    }
  59.     /$8A/$8E/>STR  {        mov   cl,[BP+>str]   ; Get string.               }
  60.     /$20/$C9       {        and   cl,cl          ; Is it there?              }
  61.     /$74/$3E       {        jz    leave          ; Nope, so exit.            }
  62.     /$29/$C0       {        sub   ax,ax                                      }
  63.     /$8E/$D8       {        mov   ds,ax          ; Get video mode byte at    }
  64.     /$A0/$49/$04   {        mov   al,[$0449]     ;    0000:0449.             }
  65.     /$1F           {        pop   ds             ; Restore DS to Turbo seg.  }
  66.     /$2C/$07       {        sub   al,$7          ; Mono video?               }
  67.     /$74/$22       {        jz    mono           ; Yes, go do it.            }
  68.     /$BA/$00/$B8   {        mov   dx,$b800       ; B800 = color buffer.      }
  69.     /$8E/$DA       {        mov   ds,dx          ; Set DS to color buffer    }
  70.     /$BA/$DA/$03   {        mov   dx,$03da       ; Get video retrace status. }
  71.     /$46           {printc: inc   si                                         }
  72.     /$8A/$9A/>STR  {        mov   bl,[BP+si+>str]; Put char in BL.           }
  73.     /$EC           {loop1:  in    al,dx          ; Loop until video retrace. }
  74.     /$A8/$01       {        test  al,1                                       }
  75.     /$75/$FB       {        jnz   loop1                                      }
  76.     /$90           {        nop                                              }
  77.     /$EC           {loop2:  in    al,dx                                      }
  78.     /$A8/$01       {        test  al,1                                       }
  79.     /$74/$FB       {        jz    loop2                                      }
  80.     /$89/$1D       {        mov   [di],bx        ; Put char in screen buffer.}
  81.     /$47           {        inc   di             ; Advance DI twice to allow }
  82.     /$47           {        inc   di             ;        for attribute byte.}
  83.     /$E2/$EA       {        loop  printc                                     }
  84.     /$28/$C0       {        sub   al,al                                      }
  85.     /$74/$10       {        jz    leave                                      }
  86.     /$BA/$00/$B0   {mono:   mov   dx,$b000       ; B000 = Mono buffer.       }
  87.     /$8E/$DA       {        mov   ds,dx          ; Set DS                    }
  88.     /$46           {printm: inc   si                                         }
  89.     /$8A/$9A/>STR  {        mov   bl,[BP+si+>str]; Put char in BL.           }
  90.     /$89/$1D       {        mov   [di],bx        ; Move it to screen buffer. }
  91.     /$47           {        inc   di             ; Advance DI twice to allow }
  92.     /$47           {        inc   di             ;        for attribute byte.}
  93.     /$E2/$F5       {        loop  printm                                     }
  94.     /$1F           {leave:  pop   ds             ; Restore DS to Turbo seg.  }
  95.     /$89/$EC       {        mov   sp,bp                                      }
  96.     /$5D           {        pop   bp                                         }
  97.     /$C2/$57/$00   {        ret   $57            ; Pop off 87 bytes.         }
  98.   );
  99. end;
  100.  
  101. procedure Disp( attr : integer; s : str80 );
  102.   {
  103.   Calls Display for speedy screen update, then updates the cursor
  104.     position for Turbo.
  105.   }
  106. var
  107.   x, y : integer;
  108. begin
  109.   x := wherex;
  110.   y := wherey;
  111.   Display( x+X1-1, y+Y1-1, attr, s );
  112.   gotoxy( x+length(s), y);
  113. end;
  114.  
  115. const
  116.   INT24Err     : Boolean = False;
  117.   INT24ErrCode : Byte    = 0;
  118.   OldINT24     : Array[1..2] of Integer = (0,0);
  119.  
  120. procedure INT24;
  121.   {
  122.   Interrupt $24 handler.  Takes the error codes produced by DOS
  123.     and Turbo, combines them and allows us to avoid having
  124.     our screen clobbered by the lethal "Abort, Retry, Ignore?".
  125.     Code written by Bela Lubkin.
  126.     Again I altered it slighty for use in the Inline Assembler.
  127.   }
  128. begin
  129.   {                  ;  These lines are not entered by us, they
  130.      PUSH    BP      ;    are placed at the start of every subroutine
  131.      MOV     BP, SP  ;    by Turbo Pascal.  You must therefore account
  132.      PUSH    SP      ;    for them before executing an IRET instruction.
  133.   }
  134.   Inline(
  135.     $2E/$C6/$06/>INT24ERR/$01 {CS:     MOV   BYTE PTR [>INT24Err],1     }
  136.                               {        ;                                }
  137.     /$50                      {        PUSH  AX                         }
  138.     /$89/$F8                  {        MOV   AX,DI ; Get DOS error code }
  139.                               {        ;                                }
  140.     /$2E/$A2/>INT24ERRCODE    {CS:     MOV   [>INT24ErrCode],AL         }
  141.     /$58                      {        POP   AX                         }
  142.     /$B0/$00                  {        MOV   AL,0                       }
  143.                               {        ;                                }
  144.     /$89/$EC                  {        MOV   SP,BP  ; Code to exit      }
  145.     /$5D                      {        POP   BP                         }
  146.     /$CF                      {        IRET                             }
  147.   );
  148. end;
  149.  
  150. procedure INT24On;
  151.   {
  152.   Directs calls to Interrupt $24 to the above procedure.
  153.   }
  154. var
  155.   Regs: reg_T;
  156. begin
  157.   INT24Err := False;
  158.   Regs.AX  := $3524;       { DOS function $35 - Get Interrupt Vector Address }
  159.   MsDos(Regs);
  160.   If (OldINT24[1] or OldINT24[2]) = 0 then
  161.   begin
  162.     OldINT24[1] := Regs.ES;
  163.     OldINT24[2] := Regs.BX;
  164.   end;
  165.   Regs.DS := CSeg;
  166.   Regs.DX := Ofs(INT24);
  167.   Regs.AX := $2524;        { DOS function $25 - Set Interrupt Vector Address }
  168.   MsDos(Regs);
  169. end;
  170.  
  171. procedure INT24Off;
  172.   {
  173.   Restores the original handler.
  174.   }
  175. var
  176.   Regs: reg_T;
  177. begin
  178.   INT24Err := False;
  179.   If OldINT24[1]<>0 then
  180.   begin
  181.     Regs.DS := OldINT24[1];
  182.     Regs.DX := OldINT24[2];
  183.     Regs.AX := $2524;     { DOS function $25 - Set Interrupt Vector Address }
  184.     MsDos(Regs);
  185.   end;
  186.   OldINT24[1] := 0;
  187.   OldINT24[2] := 0;
  188. end;
  189.  
  190. procedure ErrorMessage( I:integer );
  191.   {
  192.   This procedure is designed to cover most errors trapped by
  193.     the Int24 procedure above.  I have made minor changes for
  194.     the display.  I also commented out those messages not needed
  195.     by this program and added a few messages of my own.
  196.     The added messages are for the DOS calls made by this program
  197.     and were put here just to centralize the DOS error messages
  198.     and minimize the code used for them.
  199.   }
  200. var
  201.   ch   : char;
  202.   tstr : str80;
  203. begin
  204.   writeln;
  205.   Disp( NATTR, ' Error: ' );
  206.   case hi(I) of
  207.      0: case lo(i) of
  208.  
  209.           $00: tstr := 'No error.';
  210.           $01: tstr := 'File does not exist.';
  211. (***
  212.       {
  213.       These error messages are commented out because they
  214.         should not occur from within this program.
  215.         (We are also desperate for code space)
  216.       }
  217.           $02: tstr := 'File not open for input.';
  218.           $03: tstr := 'File not open for output.';
  219.           $04: tstr := 'File not open.';
  220.           $10: tstr := 'Error in numeric format.';
  221.           $20: tstr := 'Operation not allowed on a logical device.';
  222.           $21: tstr := 'Not allowed in direct mode.';
  223.           $22: tstr := 'Assign to standard files not allowed.';
  224.           $90: tstr := 'Record length mismatch.';
  225.           $91: tstr := 'Seek beyond end of file.';
  226.           $99: tstr := 'Unexpected end of file.';
  227.           $F0: tstr := 'Disk write error.';
  228.           $F1: tstr := 'Directory full.';
  229.           $F2: tstr := 'File size overflow.';
  230.           $FF: tstr := 'File disappeared.';
  231. ***)
  232.           else tstr := 'Turbo error number $' + copy(HexStr(lo(i)),3,2) + '.';
  233.  
  234.         end;
  235.  
  236.     $01: tstr := 'Attempt to write on write protected disk.';
  237.     $02: tstr := 'Unknown unit.';
  238.     $03: tstr := 'Drive not ready.';
  239.     $04: tstr := 'Unknown command.';
  240.     $05: tstr := 'Data error (CRC).';
  241.     $06: tstr := 'Bad request structure length.';
  242.     $07: tstr := 'Seek error.';
  243.     $08: tstr := 'Unknown media type.';
  244.     $09: tstr := 'Sector not found.';
  245.     $0A: tstr := 'Printer out of paper.';
  246.     $0B: tstr := 'Write fault.';
  247.     $0C: tstr := 'Read fault.';
  248.     $0D: tstr := 'General failure.';
  249.  
  250.   {
  251.   The following are for codes returned by DOS function calls from
  252.     the sfmDOS.inc procedures and functions.
  253.   }
  254.  
  255.     $82: tstr := 'File not found.';
  256.     $83: tstr := 'Path not found.';
  257.     $84: tstr := 'Too many open files.';
  258.     $85: tstr := 'Access to file denied.';
  259.     $8C: tstr := 'Invalid access code for file.';
  260.     $8F: tstr := 'Invalid drive specification.';
  261.     $90: tstr := 'Cannot remove current directory.';
  262.     $91: tstr := 'Must redirect files to same disk drive.';
  263.  
  264.     else tstr := 'DOS error number $' + copy(HexStr(hi(i)), 3, 2) + '.';
  265.  
  266.   end;
  267.   Disp( HATTR, tstr );
  268.   writeln;
  269.   Disp( NATTR, '        PRESS ANY KEY');
  270.   Noise( 250, 100 );
  271.   repeat until keypressed;
  272.   read(kbd,ch);
  273.   if (ch = #27) and keypressed then read(kbd,ch);
  274. end;
  275.  
  276. function INT24Result : integer;
  277.   {
  278.   This function replaces the Turbo IOResult function with
  279.     a more comprehensive error code.
  280.     The code returned is a combination of the normal IOResult
  281.     code and the DOS critical error code:
  282.  
  283.          high byte = DOS error code
  284.           low byte = Turbo code
  285.   }
  286. var
  287.   i : integer;
  288. begin
  289.   i := IOResult;
  290.   if INT24Err then
  291.   begin
  292.    i := i + swap( succ(INT24ErrCode) );
  293.    INT24Err := false;
  294.   end;
  295.   INT24Result := i;
  296. end;
  297.