home *** CD-ROM | disk | FTP | other *** search
- { Super File Manager
-
- SFMOTHER.INC
-
- by David Steiner
- 2035 J Apt. 6
- Lincoln, NE
-
-
- Routines placed in this include file have been taken from other
- sources. Although there are only two such procedures, I find
- them both very useful.
-
-
- DISPLAY: Routines released into the public domain.
-
- by Keith G. Chuvala
- 317 West 8th
- Winfield, KS 67156
- (316) 221-0814
-
-
- INT24: Taken from a magazine article in Programmer's Journal.
- I'd list which issue and all but I can't seem to find it.
-
- by Bela Lubkin
-
- Another program I couldn't have done without is David Baldwin's
- Inline Assembler. This program takes chunks of assembly code
- and turns it into Turbo inline statements.
- Its only drawback is the fact that it comes with essentially no
- documentation.
-
- }
-
- Procedure display(col,row,attr: byte; str: str80);
- {
- Procedure written by Keith G. Chuvala, minor changes made
- by myself to conform the row/col to the Turbo standard.
- Also altered to conform the input assembly code for acceptance
- by David Baldwin's Inline Assembler.
- }
- begin
- Inline(
- $1E { push ds ; We'll modify DS twice, so }
- /$1E { push ds ; we'll save it twice. }
- /$8A/$86/>ROW { mov al,[BP+>row] ; Get row. }
- /$FE/$C8 { DEC AL ; CONVERT FROM TURBO ROW/COL}
- /$B3/$50 { mov bl,$50 ; Mult. by 80 columns/row. }
- /$F6/$E3 { mul bl }
- /$29/$DB { sub bx,bx }
- /$8A/$9E/>COL { mov bl,[BP+>col] ; Get column. }
- /$FE/$CB { DEC BL ; CONVERT FROM TURBO STNDRD }
- /$01/$D8 { add ax,bx ; Add column to row. }
- /$01/$C0 { add ax,ax ; Must double AX for attr. }
- /$89/$C7 { mov di,ax ; Set DI to buffer location.}
- /$BE/$00/$00 { mov si,$0000 }
- /$8A/$BE/>ATTR { mov bh,[BP+>attr] ; Attribute stays in BH. }
- /$8A/$8E/>STR { mov cl,[BP+>str] ; Get string. }
- /$20/$C9 { and cl,cl ; Is it there? }
- /$74/$3E { jz leave ; Nope, so exit. }
- /$29/$C0 { sub ax,ax }
- /$8E/$D8 { mov ds,ax ; Get video mode byte at }
- /$A0/$49/$04 { mov al,[$0449] ; 0000:0449. }
- /$1F { pop ds ; Restore DS to Turbo seg. }
- /$2C/$07 { sub al,$7 ; Mono video? }
- /$74/$22 { jz mono ; Yes, go do it. }
- /$BA/$00/$B8 { mov dx,$b800 ; B800 = color buffer. }
- /$8E/$DA { mov ds,dx ; Set DS to color buffer }
- /$BA/$DA/$03 { mov dx,$03da ; Get video retrace status. }
- /$46 {printc: inc si }
- /$8A/$9A/>STR { mov bl,[BP+si+>str]; Put char in BL. }
- /$EC {loop1: in al,dx ; Loop until video retrace. }
- /$A8/$01 { test al,1 }
- /$75/$FB { jnz loop1 }
- /$90 { nop }
- /$EC {loop2: in al,dx }
- /$A8/$01 { test al,1 }
- /$74/$FB { jz loop2 }
- /$89/$1D { mov [di],bx ; Put char in screen buffer.}
- /$47 { inc di ; Advance DI twice to allow }
- /$47 { inc di ; for attribute byte.}
- /$E2/$EA { loop printc }
- /$28/$C0 { sub al,al }
- /$74/$10 { jz leave }
- /$BA/$00/$B0 {mono: mov dx,$b000 ; B000 = Mono buffer. }
- /$8E/$DA { mov ds,dx ; Set DS }
- /$46 {printm: inc si }
- /$8A/$9A/>STR { mov bl,[BP+si+>str]; Put char in BL. }
- /$89/$1D { mov [di],bx ; Move it to screen buffer. }
- /$47 { inc di ; Advance DI twice to allow }
- /$47 { inc di ; for attribute byte.}
- /$E2/$F5 { loop printm }
- /$1F {leave: pop ds ; Restore DS to Turbo seg. }
- /$89/$EC { mov sp,bp }
- /$5D { pop bp }
- /$C2/$57/$00 { ret $57 ; Pop off 87 bytes. }
- );
- end;
-
- procedure Disp( attr : integer; s : str80 );
- {
- Calls Display for speedy screen update, then updates the cursor
- position for Turbo.
- }
- var
- x, y : integer;
- begin
- x := wherex;
- y := wherey;
- Display( x+X1-1, y+Y1-1, attr, s );
- gotoxy( x+length(s), y);
- end;
-
- const
- INT24Err : Boolean = False;
- INT24ErrCode : Byte = 0;
- OldINT24 : Array[1..2] of Integer = (0,0);
-
- procedure INT24;
- {
- Interrupt $24 handler. Takes the error codes produced by DOS
- and Turbo, combines them and allows us to avoid having
- our screen clobbered by the lethal "Abort, Retry, Ignore?".
- Code written by Bela Lubkin.
- Again I altered it slighty for use in the Inline Assembler.
- }
- begin
- { ; These lines are not entered by us, they
- PUSH BP ; are placed at the start of every subroutine
- MOV BP, SP ; by Turbo Pascal. You must therefore account
- PUSH SP ; for them before executing an IRET instruction.
- }
- Inline(
- $2E/$C6/$06/>INT24ERR/$01 {CS: MOV BYTE PTR [>INT24Err],1 }
- { ; }
- /$50 { PUSH AX }
- /$89/$F8 { MOV AX,DI ; Get DOS error code }
- { ; }
- /$2E/$A2/>INT24ERRCODE {CS: MOV [>INT24ErrCode],AL }
- /$58 { POP AX }
- /$B0/$00 { MOV AL,0 }
- { ; }
- /$89/$EC { MOV SP,BP ; Code to exit }
- /$5D { POP BP }
- /$CF { IRET }
- );
- end;
-
- procedure INT24On;
- {
- Directs calls to Interrupt $24 to the above procedure.
- }
- var
- Regs: reg_T;
- begin
- INT24Err := False;
- Regs.AX := $3524; { DOS function $35 - Get Interrupt Vector Address }
- MsDos(Regs);
- If (OldINT24[1] or OldINT24[2]) = 0 then
- begin
- OldINT24[1] := Regs.ES;
- OldINT24[2] := Regs.BX;
- end;
- Regs.DS := CSeg;
- Regs.DX := Ofs(INT24);
- Regs.AX := $2524; { DOS function $25 - Set Interrupt Vector Address }
- MsDos(Regs);
- end;
-
- procedure INT24Off;
- {
- Restores the original handler.
- }
- var
- Regs: reg_T;
- begin
- INT24Err := False;
- If OldINT24[1]<>0 then
- begin
- Regs.DS := OldINT24[1];
- Regs.DX := OldINT24[2];
- Regs.AX := $2524; { DOS function $25 - Set Interrupt Vector Address }
- MsDos(Regs);
- end;
- OldINT24[1] := 0;
- OldINT24[2] := 0;
- end;
-
- procedure ErrorMessage( I:integer );
- {
- This procedure is designed to cover most errors trapped by
- the Int24 procedure above. I have made minor changes for
- the display. I also commented out those messages not needed
- by this program and added a few messages of my own.
- The added messages are for the DOS calls made by this program
- and were put here just to centralize the DOS error messages
- and minimize the code used for them.
- }
- var
- ch : char;
- tstr : str80;
- begin
- writeln;
- Disp( NATTR, ' Error: ' );
- case hi(I) of
- 0: case lo(i) of
-
- $00: tstr := 'No error.';
- $01: tstr := 'File does not exist.';
- (***
- {
- These error messages are commented out because they
- should not occur from within this program.
- (We are also desperate for code space)
- }
- $02: tstr := 'File not open for input.';
- $03: tstr := 'File not open for output.';
- $04: tstr := 'File not open.';
- $10: tstr := 'Error in numeric format.';
- $20: tstr := 'Operation not allowed on a logical device.';
- $21: tstr := 'Not allowed in direct mode.';
- $22: tstr := 'Assign to standard files not allowed.';
- $90: tstr := 'Record length mismatch.';
- $91: tstr := 'Seek beyond end of file.';
- $99: tstr := 'Unexpected end of file.';
- $F0: tstr := 'Disk write error.';
- $F1: tstr := 'Directory full.';
- $F2: tstr := 'File size overflow.';
- $FF: tstr := 'File disappeared.';
- ***)
- else tstr := 'Turbo error number $' + copy(HexStr(lo(i)),3,2) + '.';
-
- end;
-
- $01: tstr := 'Attempt to write on write protected disk.';
- $02: tstr := 'Unknown unit.';
- $03: tstr := 'Drive not ready.';
- $04: tstr := 'Unknown command.';
- $05: tstr := 'Data error (CRC).';
- $06: tstr := 'Bad request structure length.';
- $07: tstr := 'Seek error.';
- $08: tstr := 'Unknown media type.';
- $09: tstr := 'Sector not found.';
- $0A: tstr := 'Printer out of paper.';
- $0B: tstr := 'Write fault.';
- $0C: tstr := 'Read fault.';
- $0D: tstr := 'General failure.';
-
- {
- The following are for codes returned by DOS function calls from
- the sfmDOS.inc procedures and functions.
- }
-
- $82: tstr := 'File not found.';
- $83: tstr := 'Path not found.';
- $84: tstr := 'Too many open files.';
- $85: tstr := 'Access to file denied.';
- $8C: tstr := 'Invalid access code for file.';
- $8F: tstr := 'Invalid drive specification.';
- $90: tstr := 'Cannot remove current directory.';
- $91: tstr := 'Must redirect files to same disk drive.';
-
- else tstr := 'DOS error number $' + copy(HexStr(hi(i)), 3, 2) + '.';
-
- end;
- Disp( HATTR, tstr );
- writeln;
- Disp( NATTR, ' PRESS ANY KEY');
- Noise( 250, 100 );
- repeat until keypressed;
- read(kbd,ch);
- if (ch = #27) and keypressed then read(kbd,ch);
- end;
-
- function INT24Result : integer;
- {
- This function replaces the Turbo IOResult function with
- a more comprehensive error code.
- The code returned is a combination of the normal IOResult
- code and the DOS critical error code:
-
- high byte = DOS error code
- low byte = Turbo code
- }
- var
- i : integer;
- begin
- i := IOResult;
- if INT24Err then
- begin
- i := i + swap( succ(INT24ErrCode) );
- INT24Err := false;
- end;
- INT24Result := i;
- end;