[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]