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