home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Phoenix CD 2.0
/
Phoenix_CD.cdr
/
24b
/
machinfo.zip
/
MACHINFO.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1986-04-27
|
17KB
|
697 lines
PROGRAM MachineInformation;
{
By: Drew O. Letcher
Iowa City, IA
April, 1986
Figures out your machine configuration including:
Machine Type
BIOS Version Date
Amount of Memory - Dip switches, tested, available to DOS
Number and Size of Disk Drives
Number and Size of Hard Drives
Adapter Boards Installed
Monitor Mode
DOS version
These routines try to use the highest level access to the system that is
possible. In this order:
DOS services
BIOS services
System Data Area
Chip registers
}
{ *** set compiler directives *** }
{$C+} { use of ^C and ^S during I/O }
{$U+} { user interrupt with ^C }
{$I+} { disk I/O error checking }
{$B+} { set con/term as standard I/O device }
{ $G128} { console input buffer }
{ $P128} { console output buffer }
{$D+} { logical device checking for text files }
{$F16} { number of open files }
{$R+} { array index range checking }
{$V+} { type checking of string parameters }
{$K+} { check stack space for variables on procedure calls }
CONST
Debug = false;
VAR
Registers : RECORD CASE integer OF
1 : ( AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : integer );
2 : ( AL, AH, BL, BH, CL, CH, DL, DH : byte );
END;
I,
L,
NumFloppy,
NumFixed : byte;
EquipByte1,
EquipByte2 : byte;
Machine : string[ 2 ];
DOS : byte;
{$I CharAttr.tur }
{$I Box.tur }
PROCEDURE WriteHex( Val, Len : integer );
{ write Val as a hexidecimal Number with len digits }
VAR
X : integer;
BEGIN
IF Val < 0 THEN
BEGIN
Val := Val + 32767 + 1;
X := ( Val DIV 16 ) + 2048;
Val := Val MOD 16;
END
ELSE
BEGIN
X := Val DIV 16;
Val := Val MOD 16;
END;
IF Len > 1 THEN WriteHex( X, Len-1 );
IF Val < 10 THEN
BEGIN
Write( CHR( Val + Ord('0') ) );
END
ELSE
BEGIN
Write( CHR( ( Val - 10 ) + Ord( 'A' ) ) );
END;
END (* Procedure WriteHex *);
PROCEDURE Time;
VAR
Hour, Min, Sec : string[2];
BEGIN
WITH Registers DO
BEGIN
AH := $2C;
MSDOS( Registers );
Str( CH, Hour);
Str( CL, Min);
IF Length( Min ) < 2 THEN Min := '0' + Min;
Str( DH, Sec);
IF Length( Sec ) < 2 THEN
Sec := '0' + Sec;
END;
GotoXY( 1,L ); L := L + 1;
Write( 'Time: ':25, Hour, ':', Min, ':', Sec );
END; { ** Procedure Time ** }
PROCEDURE Date;
CONST
Days : ARRAY[ 0..6 ] OF string[5] =
( 'SUN', 'MON', 'TUES', 'WED', 'THURS', 'FRI', 'SAT' );
VAR
Month, Day : string[2];
Year : string[4];
DayOfWeek : string[5];
BEGIN
WITH Registers DO
BEGIN
AH := $2A;
MsDos( Registers );
Str( CX - 1900, Year );
Str( DL, Day );
IF Length( Day ) < 2 THEN Day := '0' + Day;
Str( DH, Month );
DayOfWeek := Days[ ( AL ) ];
END;
GotoXy( 1,L ); L := L + 1;
Write( 'Date: ':25, DayOfWeek, ' ', Month, '/', Day, '/', Year );
END; { ** Function Date ** }
PROCEDURE MachineType;
VAR
MachType : byte;
BEGIN
MachType := Mem[ $F000:$FFFE ];
GotoXY( 1,L ); L := L + 1;
Write( 'Machine Type: ':25 );
Machine := '';
CASE MachType OF
$FC : Machine := 'AT';
$FD : Machine := 'jr';
$FE : Machine := 'XT';
$FF : Machine := 'PC';
ELSE
WriteHex( MachType, 2 );
END; { Case }
Write( Machine );
END; { Procedure MachineType }
PROCEDURE ROMBIOSDate;
VAR
BIOSDate : string[ 8 ];
I : byte;
BEGIN
BIOSDate := '';
FOR I := 5 TO 12 DO
BIOSDate := BiosDate + Chr( Mem[ $FFFF:I ] );
GotoXY( 1,L ); L := L + 1;
Write( 'ROM BIOS Date: ':25, BIOSDate );
END;
PROCEDURE DOSVersion;
BEGIN
WITH Registers DO
BEGIN
AH := $30;
MSDOS( Registers );
DOS := AL;
GotoXY( 1,L ); L := L + 1;
Write( 'DOS Version: ':25, AL, '.', AH );
END;
END; { Procedure DOSVersion }
PROCEDURE MemorySize;
VAR
Address : integer;
Bank : byte;
ActualMem : integer;
ConfMem : integer;
DOSMem : real;
OrigByte,
TestByte : byte;
BEGIN
{ test memory by writing and reading a byte every 64K }
Bank := 1;
ActualMem := 64;
TestByte := $5E;
WHILE Bank < 11 DO
BEGIN
Address := Bank * $1000;
OrigByte := Mem[ Address:0 ];
Mem[ Address:0 ] := TestByte;
IF Mem[ Address:0 ] = TestByte THEN
BEGIN
Mem[ Address:0 ] := OrigByte;
ActualMem := ActualMem + 64;
Bank := Bank + 1;
END { If }
ELSE
Bank := 99;
END; { While }
GotoXY( 1,L ); L := L + 1;
Write( 'Actual Tested Memory: ':25, ActualMem:4, 'k' );
WITH Registers DO
BEGIN
{ get configured system memory }
Intr( $12, Registers );
ConfMem := AX;
GotoXY( 1,L ); L := L + 1;
Write( 'Configured Memory Size: ':25, ConfMem:4, 'k' );
{ get DOS free memory by figuring out where this program starts }
IF DOS >= 3 THEN
BEGIN
{ get PSP address }
AH := $62;
MSDOS( Registers );
DOSMem := BX;
GotoXY( 1,L ); L := L + 1;
Write( 'DOS free memory: ':25, ( ConfMem - DOSMem / 64.0 ):4:0, 'k' );
END
ELSE { just use code segment value }
BEGIN
GotoXY( 1,L ); L := L + 1;
Write( 'DOS free memory: ':25, ( ConfMem - CSeg / 64.0 ):4:0, 'k' );
END;
END; { With }
{ check for ROM extensions }
Address := $C000;
WHILE Address <> $F700 DO
BEGIN
IF Mem[ Address:0 ] = $55 THEN
BEGIN
GotoXY( 1,L ); L := L + 1;
Write( 'ROM extension: ':25 );
WriteHex( Address, 4 );
Write( 'h' );
END;
Address := Address + $100;
END;
END; { Procedure MemorySize }
PROCEDURE Equipment;
BEGIN
WITH Registers DO
BEGIN
Intr( $11, Registers );
EquipByte1 := AL;
EquipByte2 := AH;
END;
END; { Procedure Equipment }
PROCEDURE MathUnit;
BEGIN
{ this info just comes from the system dip switches and may be
unreliable since humans set dip switches. }
GotoXY( 1,L ); L := L + 1;
Write( 'Math Coprocessor: ':25 );
IF ( EquipByte1 AND $02 ) = $02 THEN
Write( 'installed' )
ELSE
Write( 'not installed' );
END; { Procedure MathUnit }
PROCEDURE Drives;
VAR
DiskType,
DriveType,
Drive1,
Drive2 : byte;
Path : string [ 64 ];
TotalSpace,
FreeSpace,
TotalClusters,
FreeClusters,
SectorsPerCluster,
BytesPerSector : real;
BEGIN
{ check number of floppy drives }
IF ( EquipByte1 AND $01 ) = $01 THEN
BEGIN
GotoXY( 1,L ); L := L + 1;
Write( '# of diskette drives: ':25 );
NumFloppy := ( EquipByte1 AND $C0 ) DIV 64 + 1;
Write( NumFloppy );
END;
{ check number of fixed disk drives }
NumFixed := Mem[ $0040:$0075 ];
GotoXY( 1,L ); L := L + 1;
Write( '# of fixed disks: ':25, NumFixed );
WITH Registers DO
BEGIN
{ get AT disk info }
IF Machine = 'AT' THEN
BEGIN
{ get AT floppy disk drive types }
Port[ $70 ] := $10;
DriveType := Port[ $71 ];
Drive1 := DriveType DIV 16;
Drive2 := DriveType MOD 16;
GotoXY( 1,L ); L := L + 1;
Write( 'Type of drive A: ':25 );
CASE Drive1 OF
0 : Write( 'no drive' );
1 : Write( 'DD' );
2 : Write( 'HD' );
END; { Case }
IF NumFloppy > 1 THEN
BEGIN
GotoXY( 1,L ); L := L + 1;
Write( 'Type of drive B: ':25 );
CASE Drive2 OF
0 : Write( 'no drive' );
1 : Write( 'DD' );
2 : Write( 'HD' );
END; { Case }
END;
{ get AT fixed disk drive types }
Port[ $70 ] := $12;
DriveType := Port[ $71 ];
Drive1 := DriveType DIV 16;
Drive2 := DriveType MOD 16;
GotoXY( 1,L ); L := L + 1;
Write( 'Type of drive C: ':25 );
IF Drive1 = 0 THEN
Write( 'no drive' )
ELSE
Write( Drive1 );
IF NumFixed > 1 THEN
BEGIN
GotoXY( 1,L ); L := L + 1;
Write( 'Type of drive D: ':25 );
IF Drive2 = 0 THEN
Write( 'no drive' )
ELSE
Write( Drive2 );
END;
END; { If 'AT' }
{ get default drive }
AH := $19;
MSDOS( Registers );
GotoXY( 1,L ); L := L + 1;
Write( 'Default Drive: ':25, Chr( 65 + AL ) + ':' );
{ check for logical drives }
AH := $0E;
DL := AL; { use default drive we just got }
MSDOS( Registers ); { use function to set default drive }
GotoXY( 1,L ); L := L + 1;
Write( 'Logical Drives: ':25, 'A:..', Chr( 64 + AL ), ':' );
{ get default directory }
AH := $47;
DL := 0; { default drive }
DS := Seg( Path ); { pass address of a string varible }
SI := Ofs( Path ) + 1;
MSDOS( Registers );
Path[ 0 ] := Chr( 0 ); { set string length to zero }
I := 1; { determine length of path string }
WHILE Path[ I ] <> Chr( 0 ) DO { returned path ends with Chr(0) }
BEGIN
Path[ 0 ] := Chr( I );
I := I + 1;
END;
Path := '\' + Path;
GotoXY( 1,L ); L := L + 1;
Write( 'Current Directory: ':25, Path );
{ get FAT info, current drive }
AH := $1B;
MSDOS( Registers );
DiskType := Mem[ DS:BX ];
GotoXY( 1,L ); L := L + 1;
Write( 'Disk type: ':25 );
CASE DiskType OF
$FF : Write( 'DS DD 8-sec' );
$FE : Write( 'SS DD 8-sec' );
$FD : Write( 'DS DD 9-sec' );
$FC : Write( 'SS DD 9-sec' );
$F9 : Write( 'DS HD 15-sec' );
$F8 : Write( 'fixed disk' );
$CD : Write( 'not installed' );
END; { Case }
GotoXY( 1,L ); L := L + 1;
Write( 'Cluster Size: ':25, AL * CX, ' bytes' );
{ get disk space info }
AH := $36;
DL := 0; { current drive }
MSDOS( Registers );
TotalClusters := DX;
FreeClusters := BX;
SectorsPerCluster := AX;
BytesPerSector := CX;
TotalSpace := TotalClusters * SectorsPerCluster * BytesPerSector;
FreeSpace := FreeClusters * SectorsPerCluster * BytesPerSector;
GotoXY( 1,L ); L := L + 1;
Write( 'Total Disk Space: ':25, ( TotalSpace / 1024 ):6:0, 'k' );
GotoXY( 1,L ); L := L + 1;
Write( 'Free Disk Space: ':25, ( FreeSpace / 1024 ):6:0, 'k' );
END; { With }
END; { Procedure Drives }
PROCEDURE ComPorts;
VAR
I : byte;
BEGIN
{ GotoXY( 1,L ); L := L + 1;
Write( 'Number of COM Ports: ':25, ( EquipByte2 AND $0E ) DIV 2 );
}
FOR I := 0 TO 3 DO
IF Mem[ $0040:I*2 ] <> 0 THEN
BEGIN
GotoXY( 1,L ); L := L + 1;
Write( 'Com':8, I+1, ' Port Address: ' );
WriteHex( Mem[ $0040:I*2+1 ], 2 );
WriteHex( Mem[ $0040:I*2 ], 2);
Write( 'h' );
{ check com port status register }
WITH Registers DO
BEGIN
AH := 3;
DX := I;
Intr( $14, Registers );
IF Debug THEN
BEGIN
Write( ' ' );
WriteHex( AX, 4 );
END;
IF ( AL AND $B0 ) > 0 THEN
BEGIN
GotoXY( 1,L ); L := L + 1;
Write( '- Device attached':29 );
END;
END; { With }
END
ELSE
BEGIN
{ port not installed }
END;
END; { Procedure ComPorts }
PROCEDURE LptPorts;
VAR
I : byte;
BEGIN
{ GotoXY( 1,L ); L := L + 1;
Write( 'Number of LPT Ports: ':25, ( EquipByte2 AND $C0 ) DIV 64 );
}
FOR I := 0 TO 3 DO
IF Mem[ $0040:I*2+8 ] <> 0 THEN
BEGIN
GotoXY( 1,L ); L := L + 1;
Write( 'LPT':8, I+1, ' Port Address: ' );
WriteHex( Mem[ $0040:I*2+9 ], 2 );
WriteHex( Mem[ $0040:I*2+8 ], 2);
Write( 'h' );
{ check printer status register }
WITH Registers DO
BEGIN
AH := 2;
DX := I;
Intr( $17, Registers );
IF Debug THEN
BEGIN
Write( ' ' );
WriteHex( AH, 2 );
END;
IF AH = $90 THEN
BEGIN
GotoXY( 1,L ); L := L + 1;
Write( '- Printer attached':29 );
END;
END; { With }
END
ELSE
BEGIN
{ port not installed }
END;
END; { Procedure LptPorts }
PROCEDURE GamePort;
BEGIN
GotoXY( 1,L ); L := L + 1;
Write( 'Game Port: ':25 );
IF ( EquipByte2 AND $10 ) = $10 THEN
Write( 'installed' )
ELSE
Write( 'not installed' );
END; { Procedure GamePort }
PROCEDURE Video;
VAR
VideoMode : byte;
I : integer;
Status : byte;
Herc : boolean;
BEGIN
{ get current video mode }
WITH Registers DO
BEGIN
AH := $0F;
Intr( $10, Registers );
GotoXY( 1,L ); L := L + 1;
Write( 'Current Video Mode: ':25 );
CASE AL OF
0 : Write( 'B/W 40x25' );
1 : Write( 'Color 40x25' );
2 : Write( 'B/W 80x25' );
3 : Write( 'Color 80x25' );
7 : Write( 'Monochrome' );
END; { Case }
END; { With }
{ test for EGA card }
{ this probably isn't the best way to do this test, but it works for now }
IF Mem[ $C000:$0000 ] = $55 THEN
BEGIN
IF ( Mem[ $C000:$001E ] = Ord( 'I' ) ) AND
( Mem[ $C000:$001F ] = Ord( 'B' ) ) AND
( Mem[ $C000:$0020 ] = Ord( 'M' ) ) THEN
BEGIN
GotoXY( 1,L ); L := L + 1;
Write( 'EGA adapter ':25 );
END;
END;
{ Test for Hercules card - info recieved from Hercules Computer Tech. }
{ With the Hercules card, bit 7 of the Display Status Port changes
on vertical retrace. }
Status := Port[ $03BA ] AND $80;
I := 0;
Herc := false;
WHILE ( I < 3000 ) AND ( Herc = false ) DO
{ wait to see if bit 7 changes }
BEGIN
I := I + 1;
Herc := Status <> ( Port[ $03BA ] AND $80 );
END;
IF Herc THEN
BEGIN
GotoXY( 1,L ); L := L + 1;
Write( 'Hercules graphics ':25 );
END;
{ test for Mono card }
Port[ $03B4 ] := $0F;
I := Port[ $0B5 ];
Port[ $03B5 ] := 100;
IF Port[ $03B5 ] = 100 THEN
BEGIN
GotoXY( 1,L ); L := L + 1;
Write( 'Monochrome adapter ':25 );
Port[ $03B5 ] := I;
END;
{ test for color/graphics card }
Port[ $03D4 ] := $0F;
I := Port[ $03D5 ];
Port[ $03D5 ] := 100;
IF Port[ $03D5 ] = 100 THEN
BEGIN
GotoXY( 1,L ); L := L + 1;
Write( 'Color/Graphics adapter ':25 );
Port[ $03D5 ] := I;
END;
END; { Procedure Video }
BEGIN { ** Main Routine ** }
ClrScr;
Box( 1,1, 40,9, 'General' );
L := 1;
Date;
Time;
MachineType;
ROMBIOSDate;
MathUnit;
DOSVersion;
Box( 41,1, 80,7, 'Memory' );
L := 1;
MemorySize;
Equipment;
Box( 1,10, 40,24, 'Drives' );
L := 1;
Drives;
Box( 41,8, 80,13, 'Video' );
L := 1;
Video;
Box( 41,14, 80,24, 'Peripherals' );
L := 1;
GamePort;
ComPorts;
LptPorts;
Window( 1,1, 80,25 );
GotoXY( 2,24 );
Write( '┤' );
LowIntensity;
ReverseVideo;
Write( ' MachineInfo -- (c) 1986 Information Software Assoc. ' );
HighIntensity;
Write( '├' );
END.