RT

解决方案 »

  1.   

    //cpu速度,名字
    uses
      Registry;
    {$R *.dfm}function GetCPUSpeed: Double;
    const
      DelayTime = 500;
    var
      TimerHi, TimerLo: DWORD;
      PriorityClass, Priority: Integer;
    begin
    try
      PriorityClass := GetPriorityClass(GetCurrentProcess);
      Priority := GetThreadPriority(GetCurrentThread);
      SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
      SetThreadPriority(GetCurrentThread,THREAD_PRIORITY_TIME_CRITICAL);
      Sleep(10);
      asm
        dw 310Fh // rdtsc
        mov TimerLo, eax
        mov TimerHi, edx
      end;
      Sleep(DelayTime);
      asm
        dw 310Fh // rdtsc
        sub eax, TimerLo
        sbb edx, TimerHi
        mov TimerLo, eax
        mov TimerHi, edx
      end;
      SetThreadPriority(GetCurrentThread, Priority);
      SetPriorityClass(GetCurrentProcess, PriorityClass);
      Result := TimerLo / (1000.0 * DelayTime);
      except
      Result := 0;
      end;
    end;
    function CPUname: string;
    var
      Reg: TRegistry;
    begin
      CPUname := '';
      Reg := TRegistry.Create;
      try
        Reg.RootKey := HKEY_LOCAL_MACHINE;
        if Reg.OpenKey('\Hardware\Description\System\CentralProcessor\0', False) then
          CPUname := Reg.ReadString('Identifier');
      finally
        Reg.Free;
      end;
    end;
      

  2.   

    可用驱动器:
    function myGetLogicalDrives : String;
    var
       drives  : set of 0..25;
       drive   : integer;
    begin
       Result := '';
       DWORD( drives ) := Windows.GetLogicalDrives;
       for drive := 0 to 25 do
          if drive in drives then
             Result := Result + Chr( drive + Ord( 'A' ));
    end;
      

  3.   

    用api可以得到的..
    可以看看超级猛料里帮贴一些 Test8086:测试CPU型号{ Will always be 2 (386 or later) } 
    Test8087:测试协处理器{ Will always be 3 (387 or later) }TestFDIV: 测试奔腾芯片是否有缺陷{ -1: 有缺陷, 0: 不能决定, 1: OK }Q: How do I detect for a co-processor?Q: How can I tell which CPU is being used?A: Here is the short version. The problem here is that it doesn't detect the pentium.var winFlags: LongInt;beginwinFlags := GetWinFlags;{ Get math coprocessor status }If winFlags And WF_80x87 > 0 Then Caption := 'Present'Else Caption := 'Not Present';{ Get CPU type }If winFlags And WF_CPU486 > 0 Then edit1.text := '486' {also pentium}else If winFlags And WF_CPU386 > 0 Then edit1.text := '386'else If winFlags And WF_CPU286 > 0 Then edit1.text := '286';end; Here is a version that will work with the pentium:{ This code comes from Intel, and has been modified for Delphi'sinline assembler.}unit Cpu;interfaceusesSysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,Forms, Dialogs, StdCtrls, Buttons;type{ All the types currently known. As new types are created,add suitable names, and extend the case statement inthe GetCpuType function.}TCPUType = (i8086CPU, i286CPU, i386CPU, i486CPU, iPentiumCPU);TForm1 = class(TForm)Edit1: TEdit;Label1: TLabel;BitBtn1: TBitBtn;procedure FormCreate(Sender: TObject);procedure BitBtn1Click(Sender: TObject);private{ Return the type of the current CPU }function CpuType: TCPUType;{ Return the type as a string }function GetCPUType: String;publicend;varForm1: TForm1;{ Define the winFlags variable for 286 check }winFlags: Longint;implementation{$R *.DFM} { Get CPU type }function TForm1.GetCPUType: String;varkind: TCPUType;beginif winFlags and WF_CPU286 > 0 thenResult := '80286'elsebeginkind := CpuType;case kind ofi8086CPU:Result := '8086';i386CPU:Result := '80386';i486CPU:Result := '80486';iPentiumCPU:Result := 'Pentium';else{ Try to be flexible for future cpu types, e.g., P6. }Result := Format('P%d', [Ord(kind)]);end;end;end;{ Assembly function to get CPU type including Pentium and later }function TForm1.CpuType: TCPUType; assembler;asmpush DS{ First check for an 8086 CPU }{ Bits 12-15 of the FLAGS register are always set on the }{ 8086 processor. }pushf { save EFLAGS }pop bx { store EFLAGS in BX }mov ax,0fffh { clear bits 12-15 }and ax,bx { in EFLAGS }push ax { store new EFLAGS value on stack }popf { replace current EFLAGS value }pushf { set new EFLAGS }pop ax { store new EFLAGS in AX }and ax,0f000h { if bits 12-15 are set, then CPU }cmp ax,0f000h { is an 8086/8088 }mov ax, i8086CPU { turn on 8086/8088 flag }je @@End_CpuType{ 80286 CPU check }{ Bits 12-15 of the FLAGS register are always clear on the }{ 80286 processor. }{ Commented out because 'pop ax' crashes it to the DOS prompt when running }{ with a Delphi form on some Machines.}{ or bx,0f000h } { try to set bits 12-15 }{ push bx }{ popf }{ pushf }{ pop ax } { This crashes Delphi programs on some machines }{ and ax,0f000h } { if bits 12-15 are cleared, CPU=80286 }{ mov ax, i286CPU } { turn on 80286 flag }{ jz @@End_CpuType }{ To test for 386 or better, we need to use 32 bit instructions,but the 16-bit Delphi assembler does not recognize the 32 bit opcodesor operands. Instead, use the 66H operand size prefix to changeeach instruction to its 32-bit equivalent. For 32-bit immediateoperands, we also need to store the high word of the operand immediatelyfollowing the instruction. The 32-bit instruction is shown in a commentafter the 66H instruction.}{ i386 CPU check }{ The AC bit, bit #18, is a new bit introduced in the EFLAGS }{ register on the i486 DX CPU to generate alignment faults. }{ This bit can not be set on the i386 CPU. }db 66h { pushfd }pushfdb 66h { pop eax }pop ax { get original EFLAGS }db 66h { mov ecx, eax }mov cx,ax { save original EFLAGS }db 66h { xor eax,40000h }xor ax,0h { flip AC bit in EFLAGS }dw 0004hdb 66h { push eax }push ax { save for EFLAGS }db 66h { popfd }popf { copy to EFLAGS }db 66h { pushfd }pushf { push EFLAGS }db 66h { pop eax }pop ax { get new EFLAGS value }db 66h { xor eax,ecx }xor ax,cx { can't toggle AC bit, CPU=Intel386 }mov ax, i386CPU { turn on 386 flag }je @@End_CpuType{ i486 DX CPU / i487 SX MCP and i486 SX CPU checking }{ Checking for ability to set/clear ID flag (Bit 21) in EFLAGS }{ which indicates the presence of a processor }{ with the ability to use the CPUID instruction. }db 66h { pushfd }pushf { push original EFLAGS }db 66h { pop eax }pop ax { get original EFLAGS in eax }db 66h { mov ecx, eax }mov cx,ax { save original EFLAGS in ecx }db 66h { xor eax,200000h }xor ax,0h { flip ID bit in EFLAGS }dw 0020hdb 66h { push eax }push ax { save for EFLAGS }db 66h { popfd }popf { copy to EFLAGS }db 66h { pushfd }pushf { push EFLAGS }db 66h { pop eax }pop ax { get new EFLAGS value }db 66h { xor eax, ecx }xor ax, cxmov ax, i486CPU { turn on i486 flag }je @@End_CpuType { if ID bit cannot be changed, CPU=486 }{ without CPUID instruction functionality }{ Execute CPUID instruction to determine vendor, family, }{ model and stepping. The use of the CPUID instruction used }{ in this program can be used for B0 and later steppings }{ of the P5 processor. }db 66h { mov eax, 1 }mov ax, 1 { set up for CPUID instruction }dw 0db 66h { cpuid }db 0Fh { Hardcoded opcode for CPUID instruction }db 0a2hdb 66h { and eax, 0F00H }and ax, 0F00H { mask everything but family }dw 0db 66h { shr eax, 8 }shr ax, 8 { shift the cpu type down to the low byte }sub ax, 1 { subtract 1 to map to TCpuType }@@End_CpuType:pop dsend; { Get the Windows Flags to check for 286. The 286 assembly codecrashes due to a problem when using with Delphi Forms on some machines. Thismethod is safer.}procedure TForm1.FormCreate(Sender: TObject);beginwinFlags := GetWinFlags;end;{ Call the CPU function and assign it to the Edit box }procedure TForm1.BitBtn1Click(Sender: TObject);beginEdit1.Text := GetCPUType;end;end.{This code came from Lloyd's help file!}
     
      

  4.   

    网卡信息
    在iphlpapi.dll里面有一个函数:GetAdaptersInfo() 
    好像是干这个用的。说明如下:GetAdaptersInfoThe GetAdaptersInfo function retrieves adapter information for the local computer.DWORD GetAdaptersInfo(PIP_ADAPTER_INFO pAdapterInfo, // buffer to receive dataPULONG pOutBufLen // size of data returned);ParameterspAdapterInfo[out] Pointer to a buffer that, , receives a linked list of IP_ADAPTER_INFO structures.pOutBufLen[in] Pointer to a ULONG variable that specifies the size of the buffer pointed to by the pAdapterInfo parameter. If this size is insufficient to hold the adapter information, GetAdaptersInfo fills in this variable with the required size, and returns an error code of ERROR_BUFFER_OVERFLOW.Return ValuesIf the function succeeds, the return value is ERROR_SUCCESS.If the function fails, the return value is one of the following error codes.Value MeaningERROR_BUFFER_OVERFLOW The buffer size indicated by the pOutBufLen parameter is too small to hold the adapter information. The pOutBufLen parameter points to the required size.ERROR_INVALID_PARAMETER The pOutBufLen parameter is NULL, or the calling process does not have read/write access to the memory pointed to by pOutBufLen, or the calling process does not have write access to the memory pointed to by the pAdapterInfo parameter.ERROR_NO_DATA No adapter information exists for the local computer.ERROR_NOT_SUPPORTED GetAdaptersInfo is not supported by the operating system running on the local computer.Other If the function fails, use FormatMessage to obtain the message string for the returned error. RequirementsWindows NT/2000: Requires Windows 2000.Windows 95/98: Requires Windows 98.Header: Declared in Iphlpapi.h.//没有Library: Use Iphlpapi.lib.//没有  IP_ADAPTER_INFOThe IP_ADAPTER_INFO structure contains information about a particular network adapter on the local computer.typedef struct _IP_ADAPTER_INFO {struct _IP_ADAPTER_INFO* Next;DWORD ComboIndex;char AdapterName[MAX_ADAPTER_NAME_LENGTH + 4];char Description[MAX_ADAPTER_DESCRIPTION_LENGTH + 4];UINT AddressLength;BYTE Address[MAX_ADAPTER_ADDRESS_LENGTH];DWORD Index;UINT Type;UINT DhcpEnabled;PIP_ADDR_STRING CurrentIpAddress;IP_ADDR_STRING IpAddressList;IP_ADDR_STRING GatewayList;IP_ADDR_STRING DhcpServer;BOOL HaveWins;IP_ADDR_STRING PrimaryWinsServer;IP_ADDR_STRING SecondaryWinsServer;time_t LeaseObtained;time_t LeaseExpires;} IP_ADAPTER_INFO, *PIP_ADAPTER_INFO;MembersNextPointer to the next adapter in the linked list of adapters.ComboIndexThis member is unused.AdapterName[MAX_ADAPTER_NAME_LENGTH + 4]Specifies the name of the adapter.Description[MAX_ADAPTER_DESCRIPTION_LENGTH + 4]Specifies a description for the adapter.AddressLengthSpecifies the length of the hardware address for the adapter.Address[MAX_ADAPTER_ADDRESS_LENGTH]Specifies the hardware address for the adapter. //这个是不是你想要的?IndexSpecifies the adapter index.TypeSpecifies the adapter type.DhcpEnabledSpecifies whether dynamic host configuration protocol (DHCP) is enabled for this adapter.CurrentIpAddressSpecifies the current IP address for this adapter.IpAddressListSpecifies the list of IP addresses associated with this adapter.GatewayListSpecifies the IP address of the default gateway for this adapter.DhcpServerSpecifies the IP address of the DHCP server for this adapter.HaveWinsSpecifies whether this adapter uses Windows Internet Name Service (WINS).PrimaryWinsServerSpecifies the IP address of the primary WINS server.SecondaryWinsServerSpecifies the IP address of the secondary WINS server.LeaseObtainedSpecifies the time when the current DHCP lease was obtained.LeaseExpiresSpecifies the time when the current DHCP lease will expire.RequirementsWindows NT/2000: Requires Windows 2000.Windows 95/98: Requires Windows 98.Header: Declared in Iptypes.h. 
     
      

  5.   

    内存,硬盘,光驱信息 几个基本的例子,由此可演化得到许多硬件信息。 
    结果放在Memo1中。procedure TForm1.Button1Click(Sender: TObject);varsysteminfo: SYSTEM_INFO;memory: MEMORYSTATUS;sector,byte,cluster,free: DWORD;freespace,totalspace: longint;CDtype: UINT;name: CHAR;drvname: string;volname,filesysname: PCHAR;sno,maxl,fileflag: DWORD;beginMemo1.Lines.Clear();//获得CPU型号GetSystemInfo(systeminfo);Memo1.Lines.Add('您的CPU类型是:' + inttostr(systeminfo.dwProcessorType));//获得内存状态memory.dwLength := sizeof(memory); //初始化GlobalMemoryStatus(memory);Memo1.Lines.Add('您的物理内存是(' + inttostr(integer(memory.dwTotalPhys div 1024 div 1024)) + 'MB)。');Memo1.Lines.Add('其中可用内存是(' + inttostr(integer(memory.dwTotalPhys div 1024)) + 'KB)。');//获得C盘可用空间GetDiskFreeSpace('C:', LPDWORD(@sector)^, LPDWORD(@byte)^, LPDWORD(@free)^, LPDWORD(@cluster)^); //获得返回参数totalspace := cluster * byte * sector div 1024 div 1024; //计算总容量freespace := free * byte * sector div 1024 div 1024; //计算可用空间Memo1.Lines.Add('C盘总空间(' + inttostr(integer(totalspace)) + 'MB)。');Memo1.Lines.Add('C盘可用空间(' + inttostr(integer(freespace)) + 'MB)。');//检测CD-ROM,是否有光盘GetMem(volname, 255);GetMem(filesysname, 100);for name :='C' to 'Z' do//循环检测A~Zbegindrvname := name + ':';CDtype := GetDriveType(PCHAR(@drvname[1])); //获得磁盘类型if (CDtype = DRIVE_CDROM) thenbeginMemo1.Lines.Add('您的光驱盘符为[' + drvname + ']');volname^ := Chr(0);filesysname^ := Chr(0);if ( not (GetVolumeInformation(PCHAR(@drvname[1]), volname, 250, LPDWORD(@sno), LPDWORD(@maxl)^, LPDWORD(@fileflag)^, filesysname,100))) thenMemo1.Lines.Add(drvname + '驱中没有发现光盘') //如果返回值为假else //如果返回值为真beginMemo1.Lines.Add (drvname + '驱中光盘卷标为: [' + String(volname) + ']');Memo1.Lines.Add (drvname + '驱中光盘序号为: [' + inttostr(sno) + ']');end;end;end;FreeMem(volname);FreeMem(filesysname)end;