home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Source Code 1992 March
/
Source_Code_CD-ROM_Walnut_Creek_March_1992.iso
/
msdos
/
turbopas
/
sfmsrc.arc
/
SFMOTHER.INC
< prev
next >
Wrap
Text File
|
1987-06-01
|
12KB
|
297 lines
{ 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;