'===========================================================================
' Subject: GET INFORMATION ON CPU             Date: 08-09-97 (22:06)       
'  Author: Mike Ginger                        Code: QB, QBasic, PDS        
'  Origin: FidoNet QUIK_BAS Echo            Packet: DOS.ABC
'===========================================================================
' CPU-INFO.BAS: QuickBASIC SUB to return CPU ID & information.
' by Mike Ginger, 24 July 1997 [FidoNet (2:251/21)] <M.Ginger@emarkt.com>
'
' You must invoke QuickBASIC with "QB /L"
' ----------------------------------------------------------------------
DEFINT A-Z

DECLARE SUB CPUInfo (CpuProc$, CpuMake$, CpuModel%, CpuStep%)

'-----------------------------------------------------------------------
' Some 'Play' Code to make 'Ready-to-Run':

CLS

CALL CPUInfo(CpuProc$, CpuMake$, CpuModel%, CpuStep%)

PRINT "CPU Manufacturer "; CpuMake$
PRINT "CPU Type         "; CpuProc$;
IF CpuModel% THEN
  PRINT TAB(30); "Model"; CpuModel%; TAB(50); "Stepping"; CpuStep%
ELSE PRINT
END IF
     
END

' End of Play Code.
'-----------------------------------------------------------------------

SUB CPUInfo (CpuProc$, CpuMake$, CpuModel%, CpuStep%)


  RESTORE CPUInfoASM                    ' Dimension string array
  READ nASMBYTES%                       ' to hold machine code.
  DIM CpuType%(1 TO nASMBYTES%)

  DEF SEG = VARSEG(CpuType%(1))         ' Set Segment to Machine Code.
  MemAddr% = VARPTR(CpuType%(1))        ' Get Address/OffSet of M/Code.

  FOR i% = 0 TO (nASMBYTES% - 1)        ' Load string array with
    READ Code$                          ' machine code.
    POKE MemAddr% + i%, VAL("&H" + Code$)
  NEXT i%

  Cpu1% = 1111                           ' Give CPU1% & CPU2% dummy
  CPU2% = 1111                           ' values to pass.


Offset% = VARPTR(CpuType%(1))           ' Set OffSet to call machine code ..
CALL ABSOLUTE(CPU2%, Cpu1%, Offset%)    ' .. and pass control to it.

DEF SEG                                 ' Restore Segment pointer.

Cpu1$ = HEX$(Cpu1%)
SELECT CASE Cpu1$
        CASE "20": CpuProc$ = "V20": CPU2% = 5
        CASE "30": CpuProc$ = "V30": CPU2% = 5
        CASE "86": CpuProc$ = "8086"
        CASE "88": CpuProc$ = "8088"
        CASE "186": CpuProc$ = "80186"
        CASE "188": CpuProc$ = "80188"
	CASE "286": CpuProc$ = "80286"
	CASE "385": CpuProc$ = "80386SX"
	CASE "386": CpuProc$ = "80386DX"
	CASE "486": CpuProc$ = "80486"
CASE ELSE
	IF LEN(Cpu1$) < 4 THEN
	  CpuProc% = VAL("&H" + LEFT$(Cpu1$, 1))
	  CpuProc$ = "80" + LTRIM$(STR$(CpuProc%)) + "86"
	  CpuModel% = VAL("&H" + (MID$(Cpu1$, 2, 1)))
	ELSE
	  CpuProc% = VAL("&H" + LEFT$(Cpu1$, 2))
	  CpuProc$ = "80" + LTRIM$(STR$(CpuProc%)) + "86"
	  CpuModel% = VAL("&H" + (MID$(Cpu1$, 3, 1)))
	END IF
	CpuStep% = VAL("&H" + (RIGHT$(Cpu1$, 1)))
END SELECT


CPU2$ = HEX$(CPU2%)
SELECT CASE CPU2$
        CASE "746E": CpuMake$ = "Intel"         ' "GenuineIntel"
        CASE "4163": CpuMake$ = "AMD"           ' "AuthenticAMD"
        CASE "6976": CpuMake$ = "NexGen"        ' "NexGenDevice"  or
        CASE "7669": CpuMake$ = "NexGen"        ' "NexGenDriven"
        CASE "4D55": CpuMake$ = "UMC"           ' "UMC UMC UMC "
        CASE "6574": CpuMake$ = "Cyrix"         ' "CyrixInstead"
	CASE "5": CpuMake$ = "NEC"
	CASE "457": CpuMake$ = "Intel"
CASE ELSE
	CpuMake$ = "Unknown"
END SELECT

END SUB

'-----------------------------------------------------------------------
' The machine code of the assembler procedure for CPUInfo.
'-----------------------------------------------------------------------
CPUInfoASM:
' Number of Bytes
DATA  311 
' Machine Code
DATA 55,89,E5,56,57,9C,54,58,3B,E0,74,55,B8,FF,FF,B1
DATA 21,D3,E0,75,0D,9D,9C,33,C0,B0,40,F6,E0,74,18,E9
DATA 2A,00,E8,F0,00,FB,83,FA,04,75,06,BA,88,01,E9,76
DATA 00,BA,86,01,E9,70,00,E8,DB,00,FB,83,FA,04,75,06
DATA BA,20,00,E9,61,00,BA,30,00,E9,5B,00,E8,C6,00,FB
DATA 83,FA,04,75,06,BA,88,00,E9,4C,00,BA,86,00,E9,46
DATA 00,5F,5E,BA,86,02,9C,58,0D,00,40,50,9D,9C,58,A9
DATA 00,40,74,35,BA,86,03,8B,DC,83,E4,FC,66,9C,66,58
DATA 66,89,C1,66,35,00,00,04,00,66,50,66,9D,66,9C,66
DATA 58,66,33,C1,BA,86,03,8B,E3,74,4C,83,E4,FC,66,51
DATA 66,9D,8B,E3,E9,05,00,5F,5E,E9,5A,00,BA,86,04,66
DATA 89,C8,66,35,00,00,20,00,66,50,66,9D,66,9C,66,58
DATA 66,33,C1,74,41,BA,00,00,66,33,C0,40,0F,A2,80,E4
DATA 0F,8B,D0,8B,5E,06,89,17,33,C0,0F,A2,66,89,C8,8B
DATA 5E,08,89,07,E9,29,00,0F,20,C0,66,50,24,EF,0F,22
DATA C0,0F,20,C0,A8,10,66,58,0F,22,C0,75,03,E9,06,00
DATA BA,85,03,E9,00,00,8B,C2,8B,5E,06,89,07,E9,00,00
DATA 9D,5D,CA,04,00,B0,42,B9,07,00,51,0E,07,BF,33,02
DATA 57,FD,F3,AA,B0,90,5F,59,33,D2,FA,F3,AA,42,42,42
DATA 42,42,42,42,FB,FC,C3