lbtoolsunit.pas

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

      Inc(I);
    end;
    WSACleanup;
    Result:=IP;//如果上网则为上网ip否则是网卡ip
  finally
    Screen.Cursor := crDefault;
  end;
end;

function GetOnlineStatus(Means:Byte):Boolean;
var
  ConTypes : Integer;
begin
  if Means=1 then
  begin
    ConTypes := INTERNET_CONNECTION_MODEM + INTERNET_CONNECTION_LAN + INTERNET_CONNECTION_PROXY;
    if (InternetGetConnectedState(@ConTypes, 0) = False) then
      Result := False
    else
      Result := True;
  end else if Means=2 then
  begin
    if (InternetCheckConnection('http://www.sohu.com',1,0))
          or (InternetCheckConnection('http://www.baidu.com',1,0)) then
      Result:=true
    else
      Result:=false;
  end;
end;

function GetFrequency: String;
var
  SFSB, SFreq, SMUL: String;
  CPUSpeed: Double;
begin
  GetCPUSpeed(CpuSpeed);  //取到的数据 = 真实数据 * 10 单位MHz
  with CpuInfo do
  begin
    if CPUType = CPU_TYPE_INTEL then
    begin
      if ReadMSRNT($2A, AMSRReg) then
        multiplier := (AMsrReg.LowPart shr 22) and $1F
    end
    else begin
      if ReadMSRNT($C0010042, AMSRReg) then
        Multiplier := (AMsrReg.LowPart and $3F) * 0.5 + 4
    end;
    if Multiplier = 0 then Multiplier := MaxMultiplier;
                        
    FSB := CpuSpeed / Maxmultiplier;
    Frequency := FSB * Multiplier;
    Frequency := Round(Frequency) * 0.1;
    FSB := Round(FSB) * 0.1;
    SFSB := FloatToStr(FSB);
    SFreq := FloatToStr(Frequency);
    SMUL := FloatToStr(Multiplier);
    Result := Format('%s MHz * %s = %s MHz',   [SFSB, SMUL, SFreq]);//kol库的Format不支持%f参数，郁闷
  end;
end;

procedure TMainForm.cbStyleChange(Sender: TObject);
begin
  case cbStyle.ItemIndex of
    0: xpWindow.Style := xwsCustom;
    1: xpWindow.Style := xwsXPBlue;
    2: xpWindow.Style := xwsXPSilver;
    3: xpWindow.Style := xwsXPOlive;
    4: xpWindow.Style := xwsMSN;
    5: xpWindow.Style := xwsICQ;
  end;
  IniFile.WriteInteger('设置', 'WindowStyle', cbStyle.ItemIndex);
end;

procedure TMainForm.WMSysCommand(var Msg: TMessage);
begin
  case Msg.WParam of
    SC_MINIMIZE:
      begin
        Application.Minimize;
        ShowWindow(Application.Handle, SW_HIDE);
      end;
      else inherited;
  end;
end;

procedure TMainForm.FormCreate(Sender: TObject);
var
  reg: TRegistry;
  x,y: Integer;
  str:string;
begin
  x := GetSystemMetrics(SM_CXSCREEN);
  y := GetSystemMetrics(SM_CYSCREEN);
  Self.Left:=(x-Width) div 2;
  Self.Top:=(y-Height) div 2;
  KeyPreview := true;
  reg := TRegistry.Create;
  try
    reg.RootKey := HKEY_LOCAL_MACHINE;
    reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Run', true);
    chkAutorun.Checked := reg.ValueExists('LbTools');
    if chkAutorun.Checked then
      Application.ShowMainForm := false;
    reg.CloseKey;
  finally
    reg.Free;
  end;
  IniFile := TIniFile.Create(ExtractFilePath(
    Application.ExeName) + 'LbTool.ini');

  cbStyle.Items.CommaText := 'xwsCustom, xwsXPBlue, xwsXPSilver, xwsXPOlive, xwsMSN, xwsICQ';
  WindowStyle := IniFile.ReadInteger('设置', 'WindowStyle', 0);
  cbStyle.ItemIndex := WindowStyle;
  case WindowStyle of
    0: xpWindow.Style := xwsCustom;
    1: xpWindow.Style := xwsXPBlue;
    2: xpWindow.Style := xwsXPSilver;
    3: xpWindow.Style := xwsXPOlive;
    4: xpWindow.Style := xwsMSN;
    5: xpWindow.Style := xwsICQ;
  end;
  if IniFile.ReadInteger('设置', 'NetWork', 0)=1 then
  begin
    chkNetWork.Checked:=true;
    lblTime.Enabled:=True;
    cbbTime.Enabled:=True;
    tmrTime.Enabled:=true;
  end else
  begin
    lblTime.Enabled:=False;
    cbbTime.Enabled:=False;
  end;

  if IniFile.ReadInteger('设置','iMeans',0)=1 then
  begin
    chkMeans1.Checked:=true ;
    iMeans:=1;
  end else
  begin
    chkMeans2.Checked:=true;
    iMeans:=2;
  end;

  for x:=10 to 120 do
    cbbTime.Items.Add(IntToStr(x));
  cbbTime.ItemIndex:=IniFile.ReadInteger('设置','cbbTime',0);
  tmrTime.Interval:=(cbbTime.ItemIndex+10)*1000;

  lblComputerName.Caption:=ComputerName;
  if GetLocalIP(str) then
    lblIP1.Caption:=str;
  lblIP2.Caption:=GetNnetWorkIP;
  if Trim(lblIP1.Caption)=Trim(lblIP2.Caption) then
    lblIP2.Caption:='未知IP';

  if GetOnlineStatus(iMeans) then
    lblState.Caption:='已连接'
  else
    lblState.Caption:='未连接';
  stTray.Hint:= '网络连接状态：'+lblState.Caption;

  NBGetMac(mmoList.Lines);
  xpgMain.ActivePage:=tsShow;
  Self.Height:=376;
  self.Width:=291;
  SaveFormSize.load;
  ShowData;
end;

procedure TMainForm.chkAutorunClick(Sender: TObject);
var
  reg: TRegistry;
begin
  reg := TRegistry.Create;
  try
    reg.RootKey := HKEY_LOCAL_MACHINE;
    reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Run', true);
    if chkAutorun.Checked then
      reg.WriteString('LbTools', '"' + Application.ExeName + '"')
    else
      reg.DeleteValue('LbTools');
    reg.CloseKey;
  finally
    reg.Free;
  end;
end;

procedure TMainForm.stTrayIconDoubleClick(Sender: TObject;
  Button: TMouseButton; X, Y: Integer);
begin
  Application.Restore;
  ShowWindow(Application.Handle, SW_HIDE);
end;

procedure TMainForm.FormShow(Sender: TObject);
begin
  ShowWindow(Application.Handle, SW_HIDE);
  fpDiskName.Caption:=ADiskInfo.ModelNumber;

  CPUInfo:= GetCpuInfo;

  if Cpuinfo.CPUType = CPU_TYPE_INTEL then
  begin
    ReadMSRNT($EE, AMSRReg);
    if (AMsrReg.lowPart and $40000000) = $40000000 then   //相对温度
      Tjunction := 85         //第30位是1
    else
      Tjunction := 100;
    ReadMSRNT($198, AMSRReg);  //最大倍频
    CpuInfo.Maxmultiplier := (AMsrReg.HiPart shr 8) and $1F;
  end;

  if CpuInfo.CPUType = CPU_TYPE_AMD then
  begin
    ReadMSRNT($C0010042, AMSRReg);   //最大倍频
    CpuInfo.Maxmultiplier := (AMSrReg.LowPart shr 16) and $3F;
    CpuInfo.Maxmultiplier := CpuInfo.Maxmultiplier * 0.5 + 4;
  end;

  fpCPUName.Caption:=CpuInfo.CpuName;
  fpCoreNumber.Caption:=IntToStr(Cpuinfo.PhysicalCore);
  fpFrequency.Caption := GetFrequency;
end;

procedure TMainForm.btnOpenClick(Sender: TObject);
var
  str:string;
begin
  NBGetMac(mmoList.Lines);
  lblComputerName.Caption:=ComputerName;
  if GetLocalIP(str) then
    lblIP1.Caption:=str;
  lblIP2.Caption:=GetNnetWorkIP;
  if Trim(lblIP1.Caption)=Trim(lblIP2.Caption) then
    lblIP2.Caption:='未知IP';
  if GetOnlineStatus(iMeans) then
    lblState.Caption:='已连接'
  else
    lblState.Caption:='未连接';
  stTray.Hint:= '网络连接状态：'+lblState.Caption;
end;

procedure TMainForm.chkMeans1Click(Sender: TObject);
begin
  chkMeans2.Checked:=false;
  iMeans:=1;
  IniFile.WriteInteger('设置','iMeans',1);
end;

procedure TMainForm.chkMeans2Click(Sender: TObject);
begin
  chkMeans1.Checked:=false;
  iMeans:=2;
  IniFile.WriteInteger('设置','iMeans',2);
end;

procedure TMainForm.chkNetWorkClick(Sender: TObject);
begin
  if chkNetWork.Checked then
  begin
    tmrTime.Enabled:=True;
    lblTime.Enabled:=True;
    cbbTime.Enabled:=True;
    IniFile.WriteInteger('设置', 'NetWork', 1);
  end else
  begin
    tmrTime.Enabled:=false;
    lblTime.Enabled:=False;
    cbbTime.Enabled:=False;
    IniFile.WriteInteger('设置', 'NetWork', 0);
  end;
end;

procedure TMainForm.cbbTimeChange(Sender: TObject);
begin
  IniFile.WriteInteger('设置','cbbTime',cbbTime.ItemIndex);
  tmrTime.Interval:=(cbbTime.ItemIndex+10)*1000;
end;

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  SaveFormSize.save;
end;

procedure TMainForm.ShowData;
begin
  GetDiskInfo;
  if ADiskInfo.Smart  then
  begin
    DoPrintData;
    fpDiskTemp.Caption:=Format('%d ℃', [ADiskInfo.Temperature]);
    fpDiskTime.Caption:=InttoStr(ADiskInfo.PowerOnTime);
  end;
end;

procedure TMainForm.tmrDiskTempTimer(Sender: TObject);
begin
  ShowData;
end;

procedure TMainForm.tmrCPUTimer(Sender: TObject);
begin
  fpFrequency.Caption := GetFrequency;
end;

end.