Arsip: Get Prosessor Info


by yayaretina in Sistem more 13 years ago 1674
code di bawah ini mungkin berguna bagi para delphiers indonesia... code di bawah ini berfungsi untuk mendapatkan info prosessor... yach seperti EVEREST lah...
silah kan di coba-coba...

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.
Local Business Directory, Search Engine Submission & SEO Tools FreeWebSubmission.com SonicRun.com