[Back to MISC SWAG index] [Back to Main SWAG index] [Original]
UNIT Utils; { Misc Utilities Last Updates Nov 01/93 }
{ Copyright (C) 1992,93 Greg Estabrooks }
INTERFACE
{ *********************************************************************}
USES
CRT,KeyIO,DOS;
CONST
FpuType :ARRAY[0..3] OF STRING[10] =('None','8087','80287','80387');
CPU :ARRAY[0..3] Of STRING[13] =('8088/V20','80286',
'80386/80486','80486');
CONST { Define COM port Addresses }
ComPort :ARRAY[1..4] Of WORD = ($3F8,$2F8,$3E8,$2E8);
CONST
Warm :WORD = 0000; { Predefined value for warm boot. }
Cold :WORD = 0001; { Predefined value for cold boot. }
VAR
BiosDate :ARRAY[0..7] of CHAR Absolute $F000:$FFF5;
EquipFlag :WORD Absolute $0000:$0410;
CompID :BYTE Absolute $F000:$FFFE;
FUNCTION CoProcessorExist :BOOLEAN;
FUNCTION NumPrinters :WORD;
FUNCTION GameIOAttached :BOOLEAN;
FUNCTION NumSerialPorts :INTEGER;
FUNCTION NumDisketteDrives :INTEGER;
FUNCTION InitialVideoMode :INTEGER;
PROCEDURE Noise(Pitch, Duration :INTEGER);
FUNCTION Time :STRING;
FUNCTION WeekDate :STRING;
FUNCTION DayOfWeek( Month, Day, Year :WORD ) :BYTE; { Returns 1-7 }
FUNCTION PrinterOK :BOOLEAN;
FUNCTION AdlibCard :BOOLEAN;
FUNCTION TrueDosVer :WORD;
PROCEDURE SetPrtScr( On_OFF :BOOLEAN );
FUNCTION CpuType :WORD;
PROCEDURE IdePause;
FUNCTION RingDetect( CPort :WORD) :BOOLEAN;
function DetectOs2: Boolean;
FUNCTION HiWord( Long :LONGINT ) :WORD;
{ Routine to return high word of a LongInt. }
FUNCTION LoWord( Long :LONGINT ) :WORD;
{ Routine to return low word of a LongInt. }
FUNCTION Running4DOS : Boolean;
PROCEDURE Reboot( BootCode :WORD );
{ Routine to reboot system according to boot code.}
FUNCTION GetChar( X,Y :WORD; VAR Attrib:BYTE ) :CHAR;
IMPLEMENTATION
{ *********************************************************************}
FUNCTION CoProcessorExist :BOOLEAN;
BEGIN
CoProcessorExist := (EquipFlag And 2) = 2;
END;
FUNCTION NumPrinters :WORD;
BEGIN
NumPrinters := EquipFlag Shr 14;
END;
FUNCTION GameIOAttached :BOOLEAN;
BEGIN
GameIOAttached := (EquipFlag And $1000) = 1;
END;
FUNCTION NumSerialPorts :INTEGER;
BEGIN
NumSerialPorts := (EquipFlag Shr 9) And $07;
END;
FUNCTION NumDisketteDrives :INTEGER;
BEGIN
NumDisketteDrives := ((EquipFlag And 1) * (1+(EquipFlag Shr 6) And $03));
END;
FUNCTION InitialVideoMode :INTEGER;
BEGIN
InitialVideoMode := (EquipFlag Shr 4) And $03;
END;
PROCEDURE Noise( Pitch, Duration :INTEGER );
BEGIN
Sound(Pitch);
Delay(Duration);
NoSound;
END;
Function Time : String;
VAR
Hour,Min,Sec :STRING[2];
H,M,S,T :WORD;
BEGIN
GetTime(H,M,S,T);
Str(H,Hour);
Str(M,Min);
Str(S,Sec);
If S < 10 Then
Sec := '0' + Sec;
If M < 10 Then
Min := '0' + Min;
If H > 12 Then
BEGIN
Str(H - 12, Hour);
IF Length(Hour) = 1 Then Hour := ' ' + Hour;
Time := Hour + ':' + Min + ':' + Sec+' pm'
END
ELSE
BEGIN
If H = 0 Then
Time := '12:' + Min + ':' + Sec + ' am'
ELSE
Time := Hour +':'+Min+':'+Sec+' am';
END;
If H = 12 Then
Time := Hour + ':' + Min + ':' + Sec + ' pm';
END;
FUNCTION WeekDate :STRING;
TYPE
WeekDays = Array[0..6] Of STRING[9];
Months = Array[1..12] Of STRING[9];
CONST
DayNames : WeekDays = ('Sunday','Monday','Tuesday','Wednesday',
'Thursday','Friday','Saturday');
MonthNames : Months = ('January','February','March','April','May',
'June','July','August','September',
'October','November','December');
VAR
Y,
M,
D,
DayOfWeek :WORD;
Year :STRING;
Day :STRING;
BEGIN
GetDate(Y,M,D,DayofWeek);
Str(Y,Year);
Str(D,Day);
WeekDate := DayNames[DayOfWeek] + ' ' + MonthNames[M] + ' ' + Day+ ', '
+ Year;
END;
FUNCTION DayOfWeek( Month, Day, Year :WORD ) :BYTE;
VAR ivar1, ivar2 : Integer;
BEGIN
IF (Day > 0) AND (Day < 32) AND (Month > 0) AND (Month < 13)
THEN
BEGIN
ivar1 := ( Year MOD 100 );
ivar2 := Day + ivar1 + ivar1 DIV 4;
CASE Month OF
4, 7 : ivar1 := 0;
1, 10 : ivar1 := 1;
5 : ivar1 := 2;
8 : ivar1 := 3;
2,3,11 : ivar1 := 4;
6 : ivar1 := 5;
9,12 : ivar1 := 6;
END; {case}
ivar2 := ( ivar1 + ivar2 ) MOD 7;
IF ( ivar2 = 0 ) THEN ivar2 := 7;
END {IF}
ELSE
ivar2 := 0;
DayOfWeek := BYTE( ivar2 );
END;
FUNCTION PrinterOK :BOOLEAN;
{ Determine whether printer is on or off line }
BEGIN
If (Port[$379]) And (16) <> 16 Then
PrinterOK := False
Else
PrinterOK := True;
END;
FUNCTION AdlibCard :BOOLEAN;
{ Routine to determine if a Adlib compatible card is installed }
VAR
Val1,Val2 :BYTE;
BEGIN
Port[$388] := 4; { Write 60h to register 4 }
Delay(3); { Which resets timer 1 and 2 }
Port[$389] := $60;
Delay(23);
Port[$388] := 4; { Write 80h to register 4 }
Delay(3); { Which enables interrupts }
Port[$389] := $80;
Delay(23);
Val1 := Port[$388]; { Read status byte }
Port[$388] := 2; { Write ffh to register 2 }
Delay(3); { Which is also Timer 1 }
Port[$389] := $FF;
Delay(23);
Port[$388] := 4; { Write 21h to register 4 }
Delay(3); { Which will Start Timer 1 }
Port[$389] := $21;
Delay(85); { wait 85 microseconds }
Val2 := Port[$388]; { read status byte }
Port[$388] := 4; { Repeat the first to steps }
Delay(3); { Which will reset both Timers }
Port[$389] := $60;
Delay(23);
Port[$388] := 4;
Delay(3);
Port[$389] := $80; { Now test the status bytes saved }
If ((Val1 And $E0) = 0) And ((Val2 And $E0) = $C0) Then
AdlibCard := True { Card was found }
Else
AdlibCard := False; { No Card Installed }
END;
FUNCTION TrueDosVer :WORD; ASSEMBLER;
{ Returns true Dos Version. Not affected by Setver }
ASM
Mov AX,$3306 { get true dos ver }
Int $21 { Call Dos }
Mov AX,BX { Return proper results }
{ DL = Revision Number }
{ DH = V Flags, 8h = Dos in ROM, 10h Dos in HMA }
END;{TrueDosVer}
PROCEDURE SetPrtScr( On_OFF :BOOLEAN );
{ Routine to Enable or disable Print screen key }
BEGIN
If On_OFF Then { Turn it on }
Mem[$0050:0000] := 0
Else
Mem[$0050:0000] := 1; { Turn it off }
END;
FUNCTION CpuType :WORD; ASSEMBLER;
{ Returns a value depending on the type of CPU }
{ 0 = 8088/V20 or compatible }
{ 1 = 80286 2 = 80386/80486+ }
ASM
Xor DX,DX { Clear DX }
Push DX
PopF { Clear Flags }
PushF
Pop AX { Load Cleared Flags }
And AX,$0F000 { Check hi bits for F0h }
Cmp AX,$0F000
Je @Quit { Quit if 8088 }
Inc DX
Mov AX,$0F000 { Now Check For 80286 }
Push AX
PopF
PushF
Pop AX
And AX,$0F000 { If The top 4 bits aren't set }
Jz @Quit { Its a 80286+ }
Inc DX { Else its a 80386 or better }
@Quit:
Mov AX,DX { Return Result in AX }
END;{CpuType}
procedure idepause;
begin
gotoxy(1,25);
write('Press any key to return to IDE');
pausekey;
end;
FUNCTION RingDetect( CPort :WORD) :BOOLEAN;
{ Routine to detect whether or not the }
{ phone is ringing by checking the comport}
BEGIN
RingDetect := ODD( PORT[CPort] SHR 6 );
END;
function DetectOs2: Boolean;
begin
{ if you use Tpro, then write Hi(TpDos.DosVersion) }
DetectOs2 := (Lo(Dos.DosVersion) > 10);
end;
FUNCTION HiWord( Long :LONGINT ) :WORD; ASSEMBLER;
{ Routine to return high word of a LongInt. }
ASM
Mov AX,Long.WORD[2] { Move High word into AX. }
END;
FUNCTION LoWord( Long :LONGINT ) :WORD; ASSEMBLER;
{ Routine to return low word of a LongInt. }
ASM
Mov AX,Long.WORD[0] { Move low word into AX. }
END;
FUNCTION Running4DOS : Boolean;
VAR Regs : Registers;
begin
With Regs do
begin
ax := $D44D;
bx := $00;
end;
Intr ($2F, Regs);
if Regs.ax = $44DD then Running4DOS := TRUE
else Running4DOS := FALSE
end;
PROCEDURE Reboot( BootCode :WORD );
{ Routine to reboot system according to boot code.}
{ Also flushes all DOS buffers. }
{ NOTE: Doesn't update directory entries. }
BEGIN
Inline(
$BE/$0D/ { MOV AH,0Dh }
$CD/$21/ { INT 21h }
$FB/ { STI }
$B8/Bootcode/ { MOV AX,BootCode }
$8E/$D8/ { MOV DS,AX }
$B8/$34/$12/ { MOV AX,1234h }
$A3/$72/$04/ { MOV [0472h],AX }
$EA/$00/$00/$FF/$FF); { JMP FFFFh:0000h }
END;
FUNCTION GetChar( X,Y :WORD; VAR Attrib:BYTE ) :CHAR;
{ Retrieves the character and attribute of }
{ coordinates X,Y. }
VAR
Ofs :WORD;
BEGIN
Ofs := ((Y-1) * 160) + ((X SHL 1) - 1);
Attrib := MEM[$B800:Ofs];
GetChar := CHR( MEM[$B800:Ofs-1] );
END;
BEGIN
END.
[Back to MISC SWAG index] [Back to Main SWAG index] [Original]