function CPU_Name: string; 
const s = 'Nicht erkannt'; 
var 
  reg: TRegistry; 
begin 
  reg := TRegistry.create; 
  result := s; 
  try 
    reg.RootKey := HKEY_LOCAL_MACHINE; 
    if reg.OpenKey('Hardware\Description\System\CentralProcessor\0', false) 
      then 
      result := reg.readstring('ProcessorNameString') 
        + #13#10 + reg.readstring('Identifier'); 
  finally 
    reg.free; 
  end; 
  if result = '' then result := s; 
end; 

procedure TForm1.Button1Click(Sender: TObject); 
begin 
  showmessage(CPU_Name); 
end;

function CPUSN: string; 
var 
  sa, sb, sc, sx: string; 
  a, b, c, d: Cardinal; 
  function teil: string; 
    function btc(w: cardinal): string; 
    var 
      i: integer; 
    begin 
      result := ''; 
      for i := 0 to 3 do 
      begin 
        result := result + chr(lo(w)); 
        w := w shr 8; 
      end; 
    end; 
  begin 
    result := btc(a) + btc(b) + btc(c) + btc(d); 
  end; 
begin 
// CPU Name ----------------------------------------- 
  asm 
    mov eax,-2147483646 
    db $F,$A2 
    mov a,eax 
    mov b,ebx 
    mov c,ecx 
    mov d,edx 
  end; 
  sx := teil; 
  asm 
    mov eax,-2147483645 
    db $F,$A2 
    mov a,eax 
    mov b,ebx 
    mov c,ecx 
    mov d,edx 
  end; 
  sx := sx + teil; 
  asm 
    mov eax,-2147483644 
    db $F,$A2 
    mov a,eax 
    mov b,ebx 
    mov c,ecx 
    mov d,edx 
  end; 
  sx := trim(sx + teil) + #13#10; 
// Serien Nr ------------------------------------------- 
  asm 
    mov eax,1 
    db $F,$A2 
    mov c,eax 
  end; 
  sa := IntToHex(c, 8); 
  asm 
    mov eax,3 
    db $F,$A2 
    mov c,ecx 
    mov d,edx 
  end; 
  sb := IntToHex(d, 8); 
  sc := IntToHex(c, 8); 
  sa := copy(sa, 1, 4) + #32 + copy(sa, 5, 4) + #32; 
  sb := copy(sb, 1, 4) + #32 + copy(sb, 5, 4) + #32; 
  Insert(#32, sc, 5); 
// ---------------------------------------------------- 
  Result := sx + sa + sb + sc; 
end; 
 
 
procedure TForm1.Button5Click(Sender: TObject); 
begin 
  showmessage(CPUSN); 
end;