lbtoolsunit.pas

检测CPU信息和硬盘温度,以及硬盘使用时间和IP地址的小软件。

unit LbToolsUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, xpWindow,IniFiles, StdCtrls, xpCombo, ComCtrls, xpPages,xpCtrlStyle,
  xpCheckBox,Registry, IconTray, xpButton,NB30,WinInet,winsock, ExtCtrls,
  xpGroupBox, Menus, SaveFormSize, OBMagnet, TFlatPanelUnit;

type
  tMSR = packed record
    HiPart,
    LowPart: DWord;
  end;

const
  METHOD_BUFFERED = 0;
  MSR_TYPE = 40000;
  FILE_ANY_ACCESS = 0;
type
  TMainForm = class(TForm)
    xpWindow: TxpWindow;
    xpgMain: TxpPageControl;
    tsShow: TxpTabSheet;
    tsIP: TxpTabSheet;
    stTray: TSysTray;
    tsSet: TxpTabSheet;
    Label8: TLabel;
    cbStyle: TxpComboBox;
    chkAutorun: TxpCheckBox;
    Label17: TLabel;
    Label18: TLabel;
    lblComputerName: TLabel;
    lblIP2: TLabel;
    Label1: TLabel;
    lblIP1: TLabel;
    Label2: TLabel;
    lblState: TLabel;
    Label4: TLabel;
    mmoList: TMemo;
    btnOpen: TxpButton;
    lblTime: TLabel;
    chkNetWork: TxpCheckBox;
    grp1: TxpGroupBox;
    lbl2: TLabel;
    Label3: TLabel;
    chkMeans1: TxpCheckBox;
    chkMeans2: TxpCheckBox;
    cbbTime: TxpComboBox;
    tmrTime: TTimer;
    lbl1: TLabel;
    obfrmgntMain: TOBFormMagnet;
    SaveFormSize: TSaveFormSize;
    pmMain: TPopupMenu;
    nShow: TMenuItem;
    N2: TMenuItem;
    nClose: TMenuItem;
    tmrDiskTemp: TTimer;
    grpCPU: TxpGroupBox;
    Label5: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    fpCPUName: TFlatPanel;
    fpFrequency: TFlatPanel;
    fpCoreNumber: TFlatPanel;
    fpCPUTemp: TFlatPanel;
    tmrCPU: TTimer;
    Label12: TLabel;
    xpGroupBox1: TxpGroupBox;
    Label6: TLabel;
    Label7: TLabel;
    Label9: TLabel;
    fpDiskName: TFlatPanel;
    fpDiskTemp: TFlatPanel;
    fpDiskTime: TFlatPanel;
    procedure cbStyleChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure chkAutorunClick(Sender: TObject);
    procedure stTrayIconDoubleClick(Sender: TObject; Button: TMouseButton;
      X, Y: Integer);
    procedure FormShow(Sender: TObject);
    procedure btnOpenClick(Sender: TObject);
    procedure chkMeans1Click(Sender: TObject);
    procedure chkMeans2Click(Sender: TObject);
    procedure chkNetWorkClick(Sender: TObject);
    procedure cbbTimeChange(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure tmrDiskTempTimer(Sender: TObject);
    procedure tmrCPUTimer(Sender: TObject);
  private
    { Private declarations }
    WindowStyle: Integer;
    iMeans:byte;
    procedure ShowData;
    procedure WMSysCommand(var Msg: TMessage);message WM_SYSCOMMAND;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;
  IniFile: TIniFile;
  AMSRreg: TMSR;
  TJunction: Cardinal;
  DriverHandle: THandle;
implementation
uses DiskInfo,cpuid;
{$R *.dfm}

function CTL_CODE(Device,Funct,Method,Access:word):DWord;
begin
  result:=(Device SHL 16) or (access SHL 14) or (funct SHL 2) or method;
end;

function ReadMSRNT(ulECX:DWord; var MSRreg:tmsr):boolean;
var
  IOCTL_READ_MSR: longint;
  ReturnedLength: DWord;
  IoctlResult: boolean;
  buf:array[1..2] of DWord;
begin
  IOCTL_READ_MSR := CTL_CODE(MSR_TYPE, $981, METHOD_BUFFERED, FILE_ANY_ACCESS);
	IoctlResult := DeviceIoControl(
					DriverHandle,				// Handle to device
					IOCTL_READ_MSR,		  // RDMSR code
					@ulECX,				      // Buffer to driver
					sizeof(ulECX),		  // Length of buffer in bytes.
					@buf,				        // Buffer from driver.
					sizeof(buf),		    // Length of buffer in bytes.
					ReturnedLength,	    // Bytes placed in outbuf.
					nil				          //
					);
  MSRreg.LowPart:=buf[1];
  MSRreg.HiPart:=buf[2];
  result := IoctlResult;
end;

procedure NBGetMac(Strings: TStrings);//取网卡地址（MAC）列表
 function HexBL(by: Byte): String;
 begin 
   Result := Format('%x', [by]); 
   if Length(Result) < 2 then 
     Result := '0' + Result; 
 end;
var
 NCB: TNCB;
 Adapter: TAdapterStatus; 
 LanaEnum: TLanaEnum; 
 I, J: Integer; 
 Str: String; 
begin
 Strings.Clear;
 ZeroMemory(@NCB,SizeOf(NCB));

 NCB.ncb_command := Chr(NCBENUM); 
 NetBios(@NCB); 
                            
 NCB.ncb_buffer := @LanaEnum; 
 NCB.ncb_length := SizeOf(LanaEnum); 
 NCB.ncb_command := Chr(NCBENUM);
 NetBios(@NCB); 

 for I := 0 to Ord(LanaEnum.length) - 1 do 
 begin 
   ZeroMemory(@NCB,SizeOf(NCB)); 
   NCB.ncb_command := Chr(NCBRESET); 
   NCB.ncb_lana_num := LanaEnum.lana[I]; 
   NetBios(@NCB); 

   ZeroMemory(@NCB,SizeOf(NCB)); 
   NCB.ncb_command := Chr(NCBASTAT); 
   NCB.ncb_lana_num := LanaEnum.lana[I]; 
   StrPCopy(NCB.ncb_callname,'*'); 
   NCB.ncb_buffer := @Adapter; 
   NCB.ncb_length := SizeOf(Adapter); 
   NetBios(@NCB); 

   Str := ''; 
   for J := 0 to 5 do 
   begin 
     if J > 0 then Str := Str + '-'; 
     Str := Str + HexBL(Byte(Adapter.adapter_address[J])); 
   end; 
   Strings.Add(Str); 
 end;
end; 

function NBGetFirstMac: String; //取第一个非零的网卡地址
var 
 Strings: TStringList; 
 I, J: Integer; 
begin 
 Result := ''; 
 Strings := TStringList.Create; 
 try 
   NBGetMac(Strings); 
   for I := 0 to Strings.Count - 1 do 
   begin 
     for J := 1 to Length(Strings.Strings[I]) do 
       if (Strings.Strings[I][J] <> '0') and 
         (Strings.Strings[I][J] <> '-') then 
       begin 
         Result := Strings.Strings[I]; 
         Break; 
       end; 
     if Result <> '' then Break; 
   end; 
 finally 
   Strings.Free; 
 end; 
end; 

function NBIsMacInList(Mac: String): Boolean; //判断指定网卡地址是否存在
var 
 Strings: TStringList; 
 I: Integer; 
begin 
 Result := False; 
 Strings := TStringList.Create; 
 try 
   NBGetMac(Strings); 
   for I := 0 to Strings.Count - 1 do 
   begin 
     if Strings.Strings[I] = Mac then 
     begin 
       Result := True; 
       Break; 
     end; 
   end; 
 finally 
   Strings.Free; 
 end; 
end;

function GetLocalIP(var LocalIp: string): Boolean;
var
  HostEnt: PHostEnt;
  Ip: string;
  addr: pchar;
  Buffer: array [0..63] of char;
  GInitData: TWSADATA;
begin
  Result := False;
  try
    WSAStartup(2, GInitData);
    GetHostName(Buffer, SizeOf(Buffer));
    HostEnt := GetHostByName(buffer);
    if HostEnt = nil then
      Exit;
    addr := HostEnt^.h_addr_list^;
    ip := Format('%d.%d.%d.%d', [byte(addr [0]),
    byte (addr [1]), byte (addr [2]), byte (addr [3])]);
    LocalIp := Ip;
    Result := True;
    finally
      WSACleanup;
  end;
end;

function ComputerName:string;
var
  Pcname:PChar;
  Size:DWORD;
begin
  Getmem(Pcname,255);
  size:=255;
  If GetComPuterName(Pcname,size)=false then
  begin
    Result:='获取计算机名失败';
    FreeMem(pcname);
    exit;
  end  else
  begin
    Result:=Pcname;
    FreeMem(pcname);
  end;
end;

function GetNnetWorkIP:string;
type
  TaPInAddr = Array[0..10] of PInAddr;
  PaPInAddr = ^TaPInAddr;
var
  phe: PHostEnt;
  pptr: PaPInAddr;
  Buffer: Array[0..63] of Char;
  I: Integer;
  GInitData: TWSAData;
  IP: String;
begin
  Screen.Cursor := crHourGlass;
  try
    WSAStartup($101, GInitData);
    IP:='0.0.0.0';
    GetHostName(Buffer, SizeOf(Buffer));
    phe := GetHostByName(buffer);
    if phe = nil then
    begin
      Result:=IP;
      Exit;
    end;
    pPtr := PaPInAddr(phe^.h_addr_list);
    I := 0;
    while pPtr^[I] <> nil do
    begin
      IP := inet_ntoa(pptr^[I]^);