unit2.pas

界面精美

unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, registry, ImgList, TeeProcs,
  TeEngine, Chart, Series, Buttons, TLHelp32, clipbrd, FileCtrl;

type
  TProcessInfo=record
     ExeFile:string;
     ProcessId:DWORD;
  end;
  ProcessInfo=^TProcessInfo;
  TForm2 = class(TForm)
    PagCtrlInfo: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    TabSheet4: TTabSheet;
    LabSystemName: TLabel;
    Label2: TLabel;
    StaBarSysInfo: TStatusBar;
    LabCompany: TLabel;
    LabUser: TLabel;
    LabID: TLabel;
    LabKey: TLabel;
    ImageWinLogo: TImage;
    Label3: TLabel;
    LabLanguage: TLabel;
    Label5: TLabel;
    LabStartModel: TLabel;
    ImageList1: TImageList;
    Label1: TLabel;
    ComboBoxEx1: TComboBoxEx;
    Label4: TLabel;
    Label6: TLabel;
    Panel1: TPanel;
    Panel2: TPanel;
    LabUse: TLabel;
    LabFree: TLabel;
    Label9: TLabel;
    EdtVolume: TEdit;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    LabDriveType: TLabel;
    LabFileSystem: TLabel;
    LabSerial: TLabel;
    Label16: TLabel;
    LabTotal: TLabel;
    Label7: TLabel;
    LabFileSysflag: TLabel;
    Chart1: TChart;
    Series1: TPieSeries;
    BtnSetVol: TButton;
    SBtnHDD: TSpeedButton;
    SBtnFPD: TSpeedButton;
    SBtnCD: TSpeedButton;
    Panel4: TPanel;
    Panel5: TPanel;
    Label8: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    Label17: TLabel;
    Label18: TLabel;
    Chart2: TChart;
    Chart3: TChart;
    LabTotalPhys: TLabel;
    LabMemoryLoad: TLabel;
    LabTotalPhys1: TLabel;
    LabAvailPhys: TLabel;
    LabTotalVirtual: TLabel;
    LabAvailVirtual: TLabel;
    Series2: TPieSeries;
    Series3: TPieSeries;
    LabPsnP: TLabel;
    LabPsnV: TLabel;
    Panel3: TPanel;
    Label19: TLabel;
    EdtPcName: TEdit;
    BtnSetPcName: TButton;
    Label20: TLabel;
    LabCpu: TLabel;
    LabPageSize: TLabel;
    Label21: TLabel;
    Label22: TLabel;
    Label24: TLabel;
    Label25: TLabel;
    LabDisplay: TLabel;
    LabBitPerPel: TLabel;
    BtnSetMode: TButton;
    LstBoxVideoMode: TListBox;
    SBtnNet: TSpeedButton;
    SBtnRam: TSpeedButton;
    Image1: TImage;
    TabSheet5: TTabSheet;
    LstBoxRunFile: TListBox;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    CheckBox1: TCheckBox;
    Timer1: TTimer;
    TabSheet6: TTabSheet;
    LstBoxWindows: TListBox;
    BitBtn3: TBitBtn;
    TabSheet7: TTabSheet;
    LBInfo: TListBox;
    Label23: TLabel;
    EdtEnvValue: TEdit;
    BtnFix: TBitBtn;
    Label26: TLabel;
    LabVCardName: TLabel;
    DriveComboBox1: TDriveComboBox;
    procedure FormCreate(Sender: TObject);
    procedure PagCtrlInfoChange(Sender: TObject);
    procedure TabSheet2Show(Sender: TObject);
    procedure BtnSetVolClick(Sender: TObject);
    procedure TabSheet3Show(Sender: TObject);
    procedure TabSheet4Show(Sender: TObject);
    procedure BtnSetPcNameClick(Sender: TObject);
    procedure BtnSetModeClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure ProcessList(var pList:TList);
    procedure My_RunFileScan(ListBoxRunFile:TListBox);
    procedure BitBtn1Click(Sender: TObject);
    procedure LstBoxWindowsMouseMove(Sender: TObject; Shift: TShiftState;
      X, Y: Integer);
    procedure LstBoxRunFileMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure TabSheet5Show(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure TabSheet6Show(Sender: TObject);
    procedure TabSheet7Show(Sender: TObject);
    procedure LBInfoMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure LBInfoMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure BtnFixClick(Sender: TObject);

   // Function GetOSVersion:integer;
   // Function GetOSName(OSCode:integer):string;
  private
    { Private declarations }
  public
     Current:TList;
     EnvField,EnvNewValue:string; //记录环境变量的名称和新值
    { Public declarations }
  end;

function ChangeDisplaySettings(lpDevMode:PDeviceMode; dwFlags: DWORD):Longint;stdcall;

const
 cOsUnknown:integer=-1;
 cOsWin95:integer=0;
 cOsWin98:integer=1;
 cOsWin98SE:integer=2;
 cOsWinME:integer=3;
 cOsWinNT:integer=4;
 cOsWin2000:integer=5;
 cOsWhistler:integer=6;


var
  Form2: TForm2;
  DevModeArray: TList;// holds a list of device mode information structures

implementation

uses Myfunction,Math;

{$R *.dfm}

{import the function}
function ChangeDisplaySettings; external user32 name 'ChangeDisplaySettingsA';

procedure TForm2.FormCreate(Sender: TObject);
var
  i:integer;
  RegistInfo:TRegistInfo;
  DevModeCount: Integer;   // 记录显示模式的数量
  DevModeInfo: ^TDevMode;  // 一个显示模式信息的指针
begin
  //----------页面1信息加载
  RegistInfo:=GetRegistInfo();
  with RegistInfo do
  begin
    labCompany.Caption:=company;
    labUser.Caption:=user;
    labID.Caption:=ProductID;
    labKey.Caption:=ProductKey;
  end;  //end of with
  labSystemName.Caption:=GetOSName(GetOSVersion);
  LabLanguage.Caption:=GetOSLanguage;
  LabStartModel.Caption:=GetOSStartModel;

  //----------页面2信息加载
  ComboBoxEx1.Items.Clear;
  for i:=1 to length(NewGetLogicalDrives) do
    ComboBoxEx1.Items.Add(AnsiString(char(NewGetLogicalDrives[i]))+':');
  ComboBoxEx1.ItemIndex:=1;

  {创建记录显示模式结构的列表}
  DevModeArray := TList.Create;

  {初始化计算变量}
  DevModeCount := 0;

  {分配本地内存记录显示模式信息}
  GetMem(DevModeInfo, SizeOf(TDevMode));

  {开始计算显示模式}
  while EnumDisplaySettings(NIL, DevModeCount, DevModeInfo^) do
  begin
    {往列表里增加信息}
     DevModeArray.Add(DevModeInfo);

    {计算变量加一}
    Inc(DevModeCount);

    {显示所有列举的显示模式}
    LstBoxVideoMode.Items.Add(IntToStr(DevModeInfo^.dmPelsWidth)+'x'+
                              IntToStr(DevModeInfo^.dmPelsHeight)+', '+
                              IntToStr(Trunc(IntPower(2, DevModeInfo^.dmBitsPerPel)))+
                              ' colors');

    {分配另一个记录设备模式信息的内存块}
    GetMem(DevModeInfo, SizeOf(TDevMode));
  end; //end of while

  {上面的循环退出时,没有用的内存块应释放它}
  FreeMem(DevModeInfo, SizeOf(TDevMode));

  {选择列表的第一项}
  LstBoxVideoMode.ItemIndex := 0;

end;

procedure TForm2.PagCtrlInfoChange(Sender: TObject);
begin
   case PagCtrlInfo.ActivePageIndex of
    0:StaBarSysInfo.SimpleText:='查看系统常规信息';
    1:StaBarSysInfo.SimpleText:='查看当前的窗口信息';
    2:StaBarSysInfo.SimpleText:='查看磁盘驱动器信息';
    3:StaBarSysInfo.SimpleText:='查看内存资源信息';
    4:StaBarSysInfo.SimpleText:='查看设备信息';
    5:StaBarSysInfo.SimpleText:='查看环境变量信息';
    6:StaBarSysInfo.SimpleText:='查看当前进程信息';
  end; //end of case
end;


//----------获取当前ComboBoxEx所选驱动器的详细信息
procedure TForm2.TabSheet2Show(Sender: TObject);
const
   i64GB=1024*1024*1024;
   i64MB=1024*1024;
var
  dtDriveType:TDriveType;
  Mydrive:int64;            //记录驱动器下拉列表框的盘符代码
                            //0：当前盘 1:A  2:B  3:C 等等
  drive:char;               //记录驱动器下拉列表框的盘符
  VolumeInfo:TVolumeInfo;
  Flags:String;
  TotalBytes:Int64;
  TotalFree:Int64;
begin
  Mydrive:=Ord(DriveComboBox1.Drive)-Ord('A')+1;
  drive:=DriveComboBox1.Drive;

  TotalFree := DiskFree(Mydrive);
  TotalBytes := DiskSize(Mydrive);

  if  TotalBytes/i64GB > 1 then
     LabTotal.Caption:=format('%.3f GB',[TotalBytes/i64GB])
  else
     LabTotal.Caption:=format('%.3f MB',[TotalBytes/i64MB]);
     
  if  (TotalBytes-TotalFree)/i64GB > 1 then
   begin
     LabUse.Caption:=format('%.3f GB',[(TotalBytes-TotalFree)/i64GB]);
     LabFree.Caption:=format('%.3f GB',[TotalFree/i64GB]);
   end
  else
   begin
     LabUse.Caption:=format('%.3f MB',[(TotalBytes-TotalFree)/i64MB]);
     LabFree.Caption:=format('%.3f MB',[TotalFree/i64MB]);
   end;
  Chart1.Series[0].Clear;
  Chart1.Series[0].Add((TotalBytes-TotalFree),'已用空间',clBlue);
  Chart1.Series[0].Add(TotalFree,'可用空间',clFuchsia);

  //--DriveType函数获得“drive”盘的类型
  dtDriveType:=DriveType(drive);
  case dtDriveType of
    dtUnknown:LabDriveType.Caption:='未知类型驱动器';
    dtNoDrive:LabDriveType.Caption:='不存在';
    dtFloppy: begin
               LabDriveType.Caption:='可移动驱动器';
               SBtnCD.Visible:=False;
               SBtnHDD.Visible:=False;
               SBtnNet.Visible:=False;
               SBtnRam.Visible:=False;
               SBtnFPD.Visible:=True;
              end;
    dtFixed:begin
             LabDriveType.Caption:='硬盘驱动器';
             SBtnCD.Visible:=False;
             SBtnFPD.Visible:=False;
             SBtnNet.Visible:=False;
             SBtnRam.Visible:=False;
             SBtnHDD.Visible:=True;
            end;
    dtNetwork: begin
                 LabDriveType.Caption:='网络驱动器';
                 SBtnCD.Visible:=False;
                 SBtnFPD.Visible:=False;
                 SBtnNet.Visible:=True;
                 SBtnRam.Visible:=False;
                 SBtnHDD.Visible:=False;
               end ;
    dtCDROM: begin
              LabDriveType.Caption:='光盘驱动器';
              SBtnCD.Visible:=True;
              SBtnFPD.Visible:=False;
              SBtnNet.Visible:=False;
              SBtnRam.Visible:=False;
              SBtnHDD.Visible:=False;
             end;
    dtRAM: begin
             LabDriveType.Caption:='内存虚拟驱动器';
             SBtnCD.Visible:=False;
             SBtnFPD.Visible:=False;
             SBtnNet.Visible:=False;
             SBtnRam.Visible:=True;
             SBtnHDD.Visible:=False;
           end;

   end;  //end of case

   //--调用GetVolumeInformation获取磁盘卷标
   VolumeInfo:=GetVolumeInformation(drive);
   with VolumeInfo do
   begin
     if (FileSystemFlags and FS_CASE_IS_PRESERVED)<> 0 then
        if Length(flags)<> 0 then
           flags:=flags+#13#10'FS_CASE_IS_PRESERVED'
        else
           flags:='FS_CASE_IS_PRESERVED';
     if (FileSystemFlags and FS_CASE_SENSITIVE)<> 0 then
        if Length(flags)<> 0 then
           flags:=flags+#13#10'FS_CASE_SENSITIVE'
        else
           flags:='FS_CASE_SENSITIVE';
     if (FileSystemFlags and FS_UNICODE_STORED_ON_DISK)<> 0 then
        if Length(flags)<> 0 then
           flags:=flags+#13#10'FS_UNICODE_STORED_ON_DISK'
        else
           flags:='FS_UNICODE_STORED_ON_DISK';
     if (FileSystemFlags and FS_PERSISTENT_ACLS)<> 0 then
        if Length(flags)<> 0 then
           flags:=flags+#13#10'FS_PERSISTENT_ACLS'
        else
           flags:='FS_PERSISTENT_ACLS';
     if (FileSystemFlags and FS_FILE_COMPRESSION)<> 0 then
        if Length(flags)<> 0 then
           flags:=flags+#13#10'FS_FILE_COMPRESSION'
        else
           flags:='FS_FILE_COMPRESSION';
     if (FileSystemFlags and FS_VOL_IS_COMPRESSED)<> 0 then
        if Length(flags)<> 0 then
           flags:=flags+#13#10'FS_VOL_IS_COMPRESSED'
        else
           flags:='FS_VOL_IS_COMPRESSED';