unit2.pas

界面精美

     EdtVolume.Text:=Name;
     LabFileSystem.Caption:=FileSystemName;
     LabSerial.Caption:=IntToHex(SerialNumber,8);
     //LabSerial.Caption:=Copy(IntToHex(SerialNumber,0),0,4)+
     //                  '-'+Copy(IntToHex(SerialNumber,0),4,4);
     LabFileSysFlag.Caption:=flags;
   end;
end;

procedure TForm2.BtnSetVolClick(Sender: TObject);
var
  drive:char;
begin
  drive:=comboBoxEx1.Items.Strings[ComboBoxEx1.ItemIndex][1];
  Windows.SetVolumeLabel(PChar(drive+':\'),PChar(EdtVolume.Text));
end;

procedure TForm2.TabSheet3Show(Sender: TObject);
var
   use,free,total:integer;
begin
    LabTotalPhys.Caption:=format('%.d KB',[NewGlobalMemoryStatus(2)]);
    LabMemoryLoad.Caption:=format('%.d ',[NewGlobalMemoryStatus(1)])+'%';
    LabTotalPhys1.Caption:=format('%.d KB',[NewGlobalMemoryStatus(2)]);
    LabAvailPhys.Caption:=format('%.d KB',[NewGlobalMemoryStatus(3)]);
    LabTotalVirtual.Caption:=format('%.d KB',[NewGlobalMemoryStatus(6)]);
    LabAvailVirtual.Caption:=format('%.d KB',[NewGlobalMemoryStatus(7)]);
    total:=newGlobalMemoryStatus(2);
    free:=NewGlobalMemoryStatus(3);
    use:=total-free;
    Chart2.Series[0].Clear;
    Chart2.Series[0].Add(free,'',clAqua);
    Chart2.Series[0].Add(use,'',clBlue);
    LabPsnP.Caption:=format('%.f',[(free/total*100)])+'%';
    total:=NewGlobalMemoryStatus(6);
    free:=NewGlobalMemoryStatus(7);
    use:=total-free;
    Chart3.Series[0].Clear;
    Chart3.Series[0].Add(free,'',RGB(255,128,0));
    Chart3.Series[0].Add(use,'',clRed);
    LabPsnV.Caption:=format('%.f',[(free/total)*100])+'%';
end;

procedure TForm2.TabSheet4Show(Sender: TObject);
var
  i:integer;
  dm:TDeviceMode;
  osVerInfo:TOSVersionInfo;
  Reg:TRegistry; {用于对注册表操作的变量}

  //下面变量用于查看显示卡的名称
  lpDisplayDevice:TDisplayDevice;
  dwFlags:DWORD;
  cc:DWORD;
  //Mode:string;
begin
   //显示CPU相关信息
   LabCpu.Caption:='';
   EdtPcName.Text:=NewGetComputerName();
   LabPageSize.Caption:=inttostr((NewGetSystemInfoDWORD(1)div 1024))+' KB';

   Reg:=TRegistry.Create;   //创建键
   Reg.RootKey:=HKEY_LOCAL_MACHINE;//主键
   Reg.OpenKey('Hardware\Description\System\CentralProcessor\0',False);//打开有关CPU的键
   LabCpu.Caption:=Reg.ReadString('ProcessorNameString');    //CPU的类型的键值

   //判断是9x还是NT系统，再对相应的注册表进行操作
   osVerInfo.dwOSVersionInfoSize:=SizeOf(TOSVersionInfo);
   if(GetVersionEx(osVerInfo))then
   begin
     case(osVerInfo.dwPlatformId)of      //case(1)
      VER_PLATFORM_WIN32_NT:{Windows NT/2000}
        begin
         //在WIN2000下可以通过下面键值获取CPU的频率
         LabCpu.Caption:=Reg.ReadString('ProcessorNameString');    //CPU的类型的键值
         LabCpu.Caption:=LabCpu.Caption+' '+IntToStr(Reg.ReadInteger('~MHz'))+'MHz';
        end;
      VER_PLATFORM_WIN32_WINDOWS:{Windows 9x/ME}
         begin
          LabCpu.Caption:=Reg.ReadString('Identifier');    //CPU的类型的键值
          case NewGetSystemInfoWORD(2) of  //case(2)
           3:LabCpu.Caption:=LabCpu.Caption+' Intel 386' ;
           4:LabCpu.Caption:=LabCpu.Caption+' Intel 486' ;
           5:LabCpu.Caption:=LabCpu.Caption+' Pentium' ;
           6:LabCpu.Caption:=LabCpu.Caption+' Pentium Pro';
          else LabCpu.Caption:=LabCpu.Caption+' Unknown' ;
          end; //end of case (2)
         end;
     end; //end of case (1)
   end;  //end of if

  { case NewGetSystemInfoDWORD(4) of
     386:LabCpu.Caption:=LabCpu.Caption+'x86 family' ;
     486:LabCpu.Caption:=LabCpu.Caption+'x86 family' ;
     586:LabCpu.Caption:=LabCpu.Caption+'x86 family' ;
     else LabCpu.Caption:=LabCpu.Caption+'Not x86 family' ;
   end; //end of case
   }

   Reg.CloseKey; //关闭键
   Reg.Free;     //释放键

   //显示当前的分辨率
   LabDisplay.Caption:=IntToStr(GetSystemMetrics(SM_CXSCREEN))+
                      'x'+IntToStr(GetSystemMetrics(SM_CYSCREEN));

   //显示显示卡最大的颜色深度
   i:=0;
   while (EnumDisplaySettings(nil,i,dm)) do
     i:=i+1;
   LabBitPerPel.Caption:=IntToStr(dm.dmBitsPerPel);

   //显示显示卡的名称
   lpDisplayDevice.cb:=sizeof(lpDisplayDevice);
   dwFlags:=0;
   cc:=0;
   while EnumDisplayDevices(nil,cc,lpDisplayDevice,dwFlags) do
   begin
    Inc(cc);
    labVCardName.Caption:=lpDisplayDevice.DeviceString;
   end;//   end of while

end;

//----------设置计算机名
procedure TForm2.BtnSetPcNameClick(Sender: TObject);
begin
  Windows.SetComputerName(PChar(EdtPcName.Text));
end;

//-----------设置显示模式
procedure TForm2.BtnSetModeClick(Sender: TObject);
var
   ModeChange: Longint;// indicates if a Windows reboot is necessary
begin
   {change the display mode}
   ModeChange:=ChangeDisplaySettings(DevModeArray[LstBoxVideoMode.ItemIndex],
                                     CDS_UPDATEREGISTRY);

   {indicate if a dynamic change was successful or if Windows must be rebooted}
   if ModeChange=DISP_CHANGE_SUCCESSFUL then
      ShowMessage('Dynamic display mode change successful.');
   if ModeChange=DISP_CHANGE_RESTART then
      ShowMessage('Change successful; Windows must be restarted for the changes '+
                  'to take effect');
end;

procedure TForm2.FormDestroy(Sender: TObject);
var
  iCount: Integer;// a general loop counter
begin
   {free all memory pointed to by each item in the list}
   for iCount := 0 to DevModeArray.Count-1 do
   FreeMem(DevModeArray.Items[iCount], SizeOf(TDevMode));

   {free the list}
   DevModeArray.Free;
end;

procedure TForm2.ProcessList(var pList:TList);
var
  p:ProcessInfo;
  ok:Bool;
  ProcessListHandle:THandle;
  ProcessStruct:TProcessEntry32;
begin
  PList:=TList.Create;
  PList.Clear;
  {创建系统内核快照}
  ProcessListHandle:=CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS,0);
  {初始化结构}
  ProcessStruct.dwSize:=Sizeof(ProcessStruct);
  {取第一个进程}
  ok:=Process32First(ProcessListHandle,ProcessStruct);
  {直到最后一个进程为止}
  while Integer(ok)<>0 do
  begin
    new(p);
    p.ExeFile:=ProcessStruct.szExeFile;
    p.ProcessId:=ProcessStruct.th32ProcessID;
    PList.Add(p);
    {取下一个进程}
    ok:=Process32Next(ProcessListHandle,ProcessStruct);
  end;  //end of while
  CloseHandle(ProcessListHandle);
end;

//结束所选定的进程
procedure TForm2.BitBtn2Click(Sender: TObject);
var
  h:THandle;
  a:DWORD;
  p:ProcessInfo;
begin
  if LstBoxRunFile.ItemIndex >= 0 then
    begin
      p:=Current.Items[LstBoxRunFile.ItemIndex];
      {获取进程的完全访问权}
      h:=OpenProcess(Process_All_Access,true,p.ProcessId);
      {获取进程序的退出代码}
      GetExitCodeProcess(h,a);
      if Integer(TermInateProcess(h,a))<> 0 then
       begin
         My_RunFileScan(LstBoxRunFile);
       end;  //end of if
    end
  else
    showmessage('请选择一个进程');
end;

//下面过程是更新当前进程的
procedure TForm2.My_RunFileScan(ListboxRunFile:TListBox);
var
  i:integer;
  p:ProcessInfo;
begin
  current:=TList.Create;
  Current.Clear;
  ListboxRunFile.Clear;
  ProcessList(Current);
  for i:=0 to Current.Count-1 do
    begin
      p:=Current.Items[i];
      ListboxRunFile.Items.Add(P.ExeFile);
      dispose(p);
    end;  //end of for
end;

//调用My_RunFileScan刷新当前进程
procedure TForm2.BitBtn1Click(Sender: TObject);
begin
  My_RunFileScan(LstBoxRunFile);
end;

procedure TForm2.TabSheet5Show(Sender: TObject);
begin
  //为列表框增加水平滚动条
  SendMessage(LstBoxRunFile.Handle,LB_SetHorizontalExtent,700,longint(0));


end;

//用计时器实现定时更新进程
procedure TForm2.Timer1Timer(Sender: TObject);
begin
   BitBtn1Click(Sender);
end;

procedure TForm2.CheckBox1Click(Sender: TObject);
begin
   timer1.Enabled:=CheckBox1.Checked;
end;




procedure TForm2.LstBoxRunFileMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var
  i:integer;
begin
  i:=LstBoxRunFile.ItemAtPos(Point(x,y),true);
  if i<>-1 then
  begin
    LstBoxRunFile.Hint:=LstBoxRunFile.Items[i];
    Clipboard.AsText:=LstBoxRunFile.Items[i];
  end;//end of if
end;



//更新显示当前所用的窗口
procedure TForm2.BitBtn3Click(Sender: TObject);
var
  hCurrentWindow:HWnd;
  szText:array[0..254]of char;
begin
  LstBoxWindows.Clear;
  {获取第一个窗口}
  hCurrentWindow:=GetWindow(Handle,GW_HWNDFIRST);
  {枚举所有的窗口}
  While hCurrentWindow<>0 do
  begin
    if GetWindowText(hCurrentWindow,@szText,255)>0 then
      LstBoxWindows.Items.Add(Strpas(@szText));
      {取下一个窗口}
      hCurrentWindow:=GetWindow(hCurrentWindow,GW_HWNDNEXT);
  end; //end of while
end;

procedure TForm2.LstBoxWindowsMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
var
  i:integer;
begin
  i:=LstBoxWindows.ItemAtPos(Point(x,y),true);
  if i<>-1 then
  begin
    LstBoxWindows.Hint:=LstBoxWindows.Items[i];
    Clipboard.AsText:=LstBoxWindows.Items[i];
  end;//end of if
end;

procedure TForm2.TabSheet6Show(Sender: TObject);
begin
   SendMessage(LstBoxWindows.Handle,LB_SetHorizontalExtent,700,longint(0));
end;

procedure TForm2.TabSheet7Show(Sender: TObject);
var
  EnvPtr,SavePtr:PChar;
begin
  //为列表框增加水平滚动条
  SendMessage(LBInfo.Handle,LB_SetHorizontalExtent,700,longint(0));

  EnvPtr:=GetEnvironmentStrings;
  SavePtr:=EnvPtr;
  LBInfo.Items.Clear;
  repeat
    LBInfo.Items.Add(StrPas(EnvPtr));
    inc(EnvPtr,Strlen(EnvPtr)+1);
  until  EnvPtr^=#0;
  FreeEnvironmentStrings(SavePtr);
  
end;

procedure TForm2.LBInfoMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  i:integer;
begin
  i:=LBInfo.ItemAtPos(Point(x,y),true);
  if i<>-1 then
  begin
    LBInfo.Hint:=LBInfo.Items[i];
    Clipboard.AsText:=LBInfo.Items[i];
  end;//end of if
end;


procedure TForm2.LBInfoMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  i,j,CharIndex:integer;
  tempStr:string;
begin
  tempStr:='';
  EnvField:='';
  i:=LBInfo.ItemIndex;
  LBInfo.Hint:=LBInfo.Items[i];
  Clipboard.AsText:=LBInfo.Items[i];
  for j:=1 to length(LBInfo.Items[i])do
      if LBInfo.Items[i][j] = '=' then break;
  CharIndex:=j;

  //把当前环境变量值赋给新值的文本框，作默认值
  for j:=CharIndex+1 to length(LBInfo.Items[i]) do
      tempStr:=tempStr+LBInfo.Items[i][j];
  EdtEnvValue.Text:=tempStr;

  //把当前环境变量的变量名赋给全局量EnvField
  tempStr:='';
  for j:=1 to CharIndex-1 do
      tempStr:=tempStr+LBInfo.Items[i][j];
  EnvField:=tempStr;
end;


procedure TForm2.BtnFixClick(Sender: TObject);

begin
  EnvNewValue:='';
  EnvNewValue:=EdtEnvValue.Text;
  SetEnvironmentVariable(PChar(EnvField),PChar(EnvNewValue));
end;

end.