Arsip: Get Prosessor Info

unit GetProsesor;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;
const
	//flag
	MMX_FLAG = $00800000; 		// MMX technology
  FPU_FLAG = $00000001;			// MathCoProcessor
type
  TForm1 = class(TForm)
    listInfo: TListBox;
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
    procedure CPUID;
  public
    { Public declarations }
  end;
var
  Form1: TForm1;
implementation
{$R .DFM}
{ TForm1 }
procedure TForm1.CPUID;
const
   isPresent: array [FALSE..TRUE] of string = ( 'Tidak ada', 'Ada');
type
	//record ini digunakan untuk membagi2x register menjadi byte-byte
 	//agar mudah dibaca
	RegConvert = record
		bits0_7		: byte;
    bits8_15	: byte;
    bits16_23	: byte;
    bits24_31	: byte;
	end;
var
  //variabel2x u/ menyimpan data prosesor
  VendorIDString,
  Manufacturer,
  MerkProsesor		: String;
  PType,
  Family,
  Model,
  Stepping				: Byte;
  Features				: Cardinal;
  MMX, FPU				: Boolean;
  //variabel2x u/ proses pendeteksian
  rEBX, rEDX, rECX: Cardinal;
  S								: string;
begin
	asm
		//inisialisasi
    mov  [PType], 0
    mov  [Model], 0
    mov  [Stepping], 0
    mov  [Features], 0
    //buat jaga-jaga kita "selamatkan" dulu isi register
    //untuk dikembalikan lagi setelah selesai
    push eax
    push ebp
    push ebx
    push ecx
    push edi
    push edx
    push esi
	//periksa dulu apakah prosesor mendukung instruksi CPUID
	@@Check_CPUID:
    //sebagai inisialisasi bahwa jika tidak mendukung
    //instruksi CPUID, berarti termasuk Family 4 (selevel 486)
    mov  [Family], 4
    //inisialisasi
    mov  rEBX, 0
    mov  rEDX, 0
    mov  rECX, 0
    pushfd							//ambil nilai EFLAGS...
    pop  eax						//...simpan di register EAX
    mov  ecx,  eax			//copy ke register ECX
    xor  eax,  200000h	//ubah bit ke-21
    push eax						//kembalikan...
    popfd								//...masukkan ke EFLAGS
    pushfd							//ambil lagi EFLAGS...
    pop  eax						//...untuk di simpan ke register EAX
    cmp  eax,  ecx			//bandingkan EAX dengan ECX
    je   @@Selesai			//jika sama...
    										//...berarti tidak mendukung instruksi CPUID
                        //langsung loncat ke @@Selesai
  //jika masuk ke "zona" ini berarti prosesor mendukung CPUID
	@@InstruksiCPUID:
    mov  eax,  0				//parameter 0
    dw   0A20Fh					//CPUID
    mov  rEBX, ebx			//copy return value EBX:EDX:ECX ke
    mov  rEDX, edx			//rEBX:rEDX:rECX untuk diterjemahkan nanti
    mov  rECX, ecx			//sebagai "vendor id string"
    mov  eax,  1				//parameter 1
    dw   0A20Fh					//CPUID
    mov  [Features], edx	//copy fitur prosesor untuk nanti
    											//diterjemahkan bit-bit nya
    mov  ecx,  eax			//copy dulu nilai EAX ke ECX
    and  eax,  3000h		//ambil tipe prosesor dg cara mengambil
    shr  eax,  12				//bit ke 15..12
    mov  [PType], al		//masukkan ke variabel PType
    mov  eax,  ecx			//kembalikan lagi nilai EAX dari ECX
    and  eax,  0F00h		//ambil family prosesor dg cara mengambil
    shr  eax,  8				//bit ke 11..8
    mov  [Family], al		//masukkan ke variabel Family
    mov  eax,  ecx			//kembalikan lagi nilai EAX dari ECX
    and  eax,  00F0h		//ambil model prosesor dg cara mengambil
    shr  eax,  4				//bit ke 7..4
    mov  [Model], al		//masukkan ke variabel Model
    mov  eax,  ecx			//kembalikan lagi nilai EAX dari ECX
    and  eax,  000Fh		//ambil stepping (mask revision) pada
    mov  [Stepping], al	//bit ke 3..0
    										//kita tidak perlu lagi mengembalikan
                        //isi register EAX dari ECX, karena isi
                        //register EAX sudah tidak terpakai lagi
  @@Selesai:
  	//kembalikan isi register kepada sebelum kita menjalankan
    //prosedur ini
    pop  esi
    pop  edx
    pop  edi
    pop  ecx
    pop  ebx
    pop  ebp
    pop  eax
	end;
	{               
               Memulai proses penterjemahan bit
	               }
  //jika Family=4, rEBX=0, rEDX=0, rECX=0
  //berarti tidak mendukung CPUID,
  //diasumsikan prosesornya 486 biasa
	if (rEBX = 0) and (rEDX = 0) and (rECX = 0) and (Family = 4) then
  begin
		VendorIDString := 'Unknown';
    Manufacturer := 'Unknown';
    MerkProsesor := 'Generic 486';
	end
  //jika masuk blok ini, berarti prosesor mendukung CPUID
  //kita akan melakukan proses penterjemahan bit
  else
  begin
		//lakukan typecasting variabel 32-bit menjadi record RegConvert
   	//agar terpisah2x menjadi byte-byte, sehingga akan lebih mudah
   	//menterjemahkan tiap byte menjadi karakter.
   	//Cara ini dilakukan pada saat mengambil Vendor ID String
		with regconvert(rEBX) do begin
    	S := CHR(bits0_7) + CHR(bits8_15) + CHR(bits16_23) + CHR(bits24_31);
    end;
		with regconvert(rEDX) do begin
    	S := S + CHR(bits0_7) + CHR(bits8_15) + CHR(bits16_23) + CHR(bits24_31);
		end;
    with regconvert(rECX) do begin
			S := S + CHR(bits0_7) + CHR(bits8_15) + CHR(bits16_23) + CHR(bits24_31);
		end;
    //setelah selesai, kita masukkan ke variabel VendorIDString
    VendorIDString := S;
    //Jika VendorIDString = 'GenuineIntel'...
    if (VendorIDString = 'GenuineIntel') then begin
    	//...sudah jelas manufacturernya Intel
			Manufacturer := 'Intel';
      //periksa Family dan Model-nya
			case Family of
				4:	case Model of
				  	  0,1: MerkProsesor := 'Intel 486DX Processor';
                2: MerkProsesor := 'Intel 486SX Processor';
                3: MerkProsesor := 'Intel DX2 Processor';
                4: MerkProsesor := 'Intel 486 Processor';
                5: MerkProsesor := 'Intel SX2 Processor';
                7: MerkProsesor := 'Write-Back Enhanced Intel DX2 Processor';
                8: MerkProsesor := 'Intel DX4 Processor';
						else
           		 MerkProsesor := 'Intel 486 Processor';
           	end;
        5:	case Model of
            	1..3: MerkProsesor := 'Pentium';
               	 4: MerkProsesor := 'Pentium MMX';
        		end;
        6:	case Model of
             	0,1: MerkProsesor := 'Pentium Pro';
              	3: MerkProsesor := 'Pentium II "Klamath"';
              5,6: MerkProsesor := 'Pentium Celeron';
        				7: MerkProsesor := 'Pentium III "Katmai"';
                8: MerkProsesor := 'Pentium III "Coppermine", Celeron w/SSE';
                9: MerkProsesor := 'Pentium M';
               10: MerkProsesor := 'Pentium III Xeon Model A';
               11: MerkProsesor := 'Pentium III Model B';
        		else
            	MerkProsesor := Format('Pentium Family %d (Model %d)', [Family,Model]);
            end;
        15: case Model of
        			0: MerkProsesor := 'Pentium 4/Xeon (0.18 micron process)';
              1: MerkProsesor := 'Pentium 4/Celeron/Xeon/Xeon MP (0.18 micron process)';
              2: MerkProsesor := 'Pentium 4/P4 Mobile/Celeron Mobile (0.13 micron process)';
              3: MerkProsesor := 'Pentium 4/Celeron (90 nm process)';
        		else
            	MerkProsesor := Format('Pentium 4 Family %d (Model %d)', [Family,Model]);
            end;
      else
      	MerkProsesor := Format('P%d', [Family]);
      end; //case
    end //if
    //Jika VendorIDString = 'CyrixInstead'
    else if (VendorIDString = 'CyrixInstead') then begin
			//berarti prosesor buatan Cyrix
      Manufacturer := 'Cyrix';
      case Family of
      	4: case Model of
        		4: MerkProsesor := 'Cyrix MediaGX';
        		9: MerkProsesor := 'Cyrix 5x86';
					 else
      				MerkProsesor := 'Another Cyrix 5x86';
					 end;
        5: MerkProsesor := 'Cyrix 6x86';
        6: case Model of
        		0: MerkProsesor := 'Cyrix M2';
            5: MerkProsesor := 'VIA Cyrix III "Joshua"';
        	 else
           	MerkProsesor := 'Another Cyrix 6x86MX';
        	 end;
      else
        MerkProsesor := Format('%dx86', [Family]);
      end;
    end
    //Selain dari yang di atas, dianggap AMD
    else if (VendorIDString = 'AuthenticAMD') then begin
      Manufacturer := 'AMD';
      case Family of
        4: MerkProsesor := 'Am486 or Am5x86';
        5: 	case Model of
              0: MerkProsesor := 'AMD-K5 (Model 0)';
              1: MerkProsesor := 'AMD-K5 (Model 1)';
              2: MerkProsesor := 'AMD-K5 (Model 2)';
              3: MerkProsesor := 'AMD-K5 (Model 3)';
              6: MerkProsesor := 'AMD-K6 (Model 6)';
              7: MerkProsesor := 'AMD-K6 (Model 7)';
              8: MerkProsesor := 'AMD K6-2';
              9: MerkProsesor := 'AMD K6-III';
             14: MerkProsesor := 'AMD K6-2+/K6-III+';
            else
              MerkProsesor := Format('AMD Family %d (Model %d)', [Family,Model]);
            end;
        6: 	case Model of
              0: MerkProsesor := 'AMD-K7 Athlon (Model 0) --   ENGINEERING SAMPLE * --';
              1: MerkProsesor := 'AMD-K7 Athlon (Model 1)';
              2: MerkProsesor := 'AMD-K7 Athlon (Model 2)';
              3: MerkProsesor := 'AMD-K7 Duron';
              4: MerkProsesor := 'AMD-K7 Athlon (Model 4)';
              8: MerkProsesor := 'AMD-K7 Athlon XP 1700+'
            else
              MerkProsesor := Format('AMD K7 Family %d (Model %d)', [Family,Model]);
            end;
      else
        MerkProsesor := 'Unknown AMD Chip';
      end;
    end
    else begin
      VendorIDString := S;
      Manufacturer := 'Unknown';
      MerkProsesor := 'Unknown';
    end;
	end;
  //Apakah sudah mendukung MMX?
  MMX := (Features and MMX_FLAG) = MMX_FLAG;
  //Apakah ada MathCoProcessor?
  FPU := (Features and FPU_FLAG) = FPU_FLAG;
  //tampilkan informasi prosesor
  with listInfo.Items do begin
    Clear;
    Add('Vendor IDString : '+ VendorIDString);
    Add('Manufacturer    : '+ Manufacturer);
    Add('Merk            : '+ MerkProsesor);
    Add('Tipe            : '+ FloatToStr(PType));
    Add('Family          : '+ FloatToStr(Family));
    Add('Model           : '+ FloatToStr(Model));
    Add('Stepping        : '+ FloatToStr(Stepping));
    Add('MMX             : '+ isPresent[MMX]);
    Add('FPU             : '+ isPresent[FPU]);
  end;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
	CPUID;
end;
end.