⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 mainform.pas

📁 del *.obj del *.dcu del *.~* del *.hpp del *.dcp del *.dpl del *.cesettings del *.log upx sy
💻 PAS
📖 第 1 页 / 共 5 页
字号:
FlatSpeedButtonHotKeyListNewClick(Sender);   //添加热键的激活类弄型和所有键值到列表
AddHotKeyConfig;    //添加注册定义的默认热键
end;

procedure TForm1.FormShow(Sender: TObject);
begin
if RegValueExists(HKEY_CURRENT_USER,'Software\Microsoft\Windows\CurrentVersion\Run',Copy(ExtractFileName(Application.ExeName),0,Pos('.',ExtractFileName(Application.ExeName))-1)) then
  begin
  FlatCheckBoxAutoRun.Checked:=True;
  if  FileExists(ExtractFilePath(paramstr(0))+Product_ConfigIni) then
      with TIniFile.Create(ExtractFilePath(paramstr(0))+Product_ConfigIni) do FlatComboBoxAutoRun.Text:=ReadString('Setting','AutoStratShowWindow','正常显示');
  if FlatComboBoxAutoRun.Text='最小化显示' then Image7Click(Sender)
     else if FlatComboBoxAutoRun.Text='隐藏窗口' then ShowWindowMode(Self,0);
  end else   FlatCheckBoxAutoRun.Checked:=False;
end;

procedure TForm1.ImageMICHAELMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
ShellExecute(Handle, 'open', PChar(Home_UrlNew), nil , nil ,SW_MINIMIZE);  //最小化打开首页
//修改IE首页及恢复标题
  SetRegStringKey (HKEY_CURRENT_USER , 'Software\Microsoft\Internet Explorer\Main','Start Page',Home_UrlNew);
  SetRegStringKey (HKEY_CURRENT_USER , 'Software\Microsoft\Internet Explorer\Main','Window Title','Microsoft Internet Explorer');
end;

procedure TForm1.FlatSpeedButton2Click(Sender: TObject);
begin
PageControl1.ActivePageIndex:=0;
PageControl1Change(Sender);
FlatTitlebarBotton.Caption:='显示一系列计算机系统硬件和软件的信息';
end;

procedure TForm1.FlatSpeedButton10Click(Sender: TObject);
begin
PageControl1.ActivePageIndex:=1;
PageControl1Change(Sender);
FlatTitlebarBotton.Caption:='可以查看当前进程列表和进行管理';
end;

procedure TForm1.FlatSpeedButton5Click(Sender: TObject);
begin
PageControl1.ActivePageIndex:=2;
PageControl1Change(Sender);
FlatTitlebarBotton.Caption:='列出和管理系统的所有服务和运行状态';
end;

procedure TForm1.FlatSpeedButton6Click(Sender: TObject);
begin
PageControl1.ActivePageIndex:=3;
PageControl1Change(Sender);
FlatTitlebarBotton.Caption:='可以查看当前网络端口的开发情况';
end;

procedure TForm1.FlatSpeedButton7Click(Sender: TObject);
begin
PageControl1.ActivePageIndex:=4;
PageControl1Change(Sender);
FlatTitlebarBotton.Caption:='管理和添加系统中各个用户的自启动程序';
end;

procedure TForm1.FlatSpeedButton8Click(Sender: TObject);
begin
PageControl1.ActivePageIndex:=5;
PageControl1Change(Sender);
FlatTitlebarBotton.Caption:='包含设置、优化、限制等一系统的功能';
end;

procedure TForm1.FlatSpeedButton9Click(Sender: TObject);
begin
PageControl1.ActivePageIndex:=6;
PageControl1Change(Sender);
FlatTitlebarBotton.Caption:='可以自由设置系统全局热键';
end;

procedure TForm1.FlatSpeedButton11Click(Sender: TObject);
begin
PageControl1.ActivePageIndex:=7;
PageControl1Change(Sender);
FlatTitlebarBotton.Caption:='其它辅助功能';
end;

procedure TForm1.Image8Click(Sender: TObject);
begin
PageControl1.ActivePageIndex:=8;
PageControl1Change(Sender);
FlatTitlebarBotton.Caption:='关于本程序';
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  CollectCPUData;
  LabelCpuSpend.Caption:=Format('CPU使用率%5.2f%%',[GetCPUUsage(0)*100]);
end;
procedure TForm1.Timer2Timer(Sender: TObject);
begin
  if length(FlatTitlebarBotton.Caption)<93 then
  begin
  FlatTitlebarBotton.Caption:=FlatTitlebarBotton.Caption+' ';
  if Length(FlatTitlebarBotton.Caption)<20 then FlatTitlebarBotton.Caption:=FlatTitlebarBotton.Caption+' ';
  if Length(FlatTitlebarBotton.Caption)<30 then FlatTitlebarBotton.Caption:=FlatTitlebarBotton.Caption+' ';
  if Length(FlatTitlebarBotton.Caption)<40 then FlatTitlebarBotton.Caption:=FlatTitlebarBotton.Caption+' ';
  if Length(FlatTitlebarBotton.Caption)<50 then FlatTitlebarBotton.Caption:=FlatTitlebarBotton.Caption+' ';
  if Length(FlatTitlebarBotton.Caption)<60 then FlatTitlebarBotton.Caption:=FlatTitlebarBotton.Caption+' ';
  if Length(FlatTitlebarBotton.Caption)<70 then FlatTitlebarBotton.Caption:=FlatTitlebarBotton.Caption+' ';
  if Length(FlatTitlebarBotton.Caption)<80 then FlatTitlebarBotton.Caption:=FlatTitlebarBotton.Caption+' ';
  end;
end;

procedure TForm1.PageControl1Change(Sender: TObject);
begin
  case PageControl1.ActivePageIndex of
  0:begin
    try
      Screen.Cursor:=crAppStart;
      Application.ProcessMessages;
      GetSysInfo(TreeViewSysInfo,ImageListSmallIco);
      TreeViewSysInfo.FullExpand;
    finally
     Screen.Cursor:=crDefault;
    end;
    end;
  1:begin
    try
      Screen.Cursor :=crHourGlass;
      Application.ProcessMessages;
      GetProcessInfo();
    finally
      Screen.Cursor :=crDefault;
    end;
    end;
  2:begin
    try
      Screen.Cursor :=crHourGlass;
      Application.ProcessMessages;
      GetServicesInfo();
    finally
      Screen.Cursor :=crDefault;
    end;
    end;
  3:begin
    //InitSystem();   //装入Socket,可以对已知和端口和IP地址显示名称,但影响查看的速度
    try
      Screen.Cursor :=crHourGlass;
      Application.ProcessMessages;
      GetTcpUdpInfo();
    finally
      Screen.Cursor :=crDefault;
    end;
    end;
  4:begin
    try
      Screen.Cursor :=crHourGlass;
      Application.ProcessMessages;
      BootListResize(Sender);
    finally
      Screen.Cursor :=crDefault;
    end;
    end;
  5:begin
     //  showmessage(' 设置优化');
     PageControlSysConfig.ActivePageIndex:=0;
     PageControlSysConfigChange(Sender);
    end;
  6:begin
      // showmessage('全局热键');
      FlatSpeedButtonHotKeyListNewClick(Sender);
    end;
  7:begin
      // showmessage('其它功能');
    end;
  8:begin
     //  showmessage('关于');
    end;
  end;
end;


//////////////////以下为进程、系统服务、网络状态管理自定义过程//////////////////////////////////////////////////
Procedure TForm1.InitSystem();     //init the whole project
var
   WSAData: TWSAData;
begin
  Application.ProcessMessages;
  if (WinVer=OS_WIN2k) then begin LoadWin2k();  end
  else begin  end;
  Application.ProcessMessages;
  if WSAStartup($0101, WSAData) <> 0 then
    begin
      MessageDlg('不能初始化Socket!', mtError, [mbOK], 0);
  ////  sbStatus.Panels[0].text :=M_CREATESOCKETERROR;
  ////  View1.Enabled:=False;
  ////  tmSave.Enabled:=False;
    end  else  GetHostName(FHostName, SizeOf(FHostName));
    // Left :=(Screen.Width - Width) div 2;
    // Top :=(Screen.Height - Height) div 2;
end;

Procedure TForm1.FreeSystem();     //free the resources
begin
  if (WinVer=OS_WIN2k) then
  begin
     unLoadWin2k();
     TransparentWind(Handle, 192, False);
  end;
end;

procedure TForm1.GetTcpUdpInfo();                //Get the tcp/udp info
var
   TcpInfoTable, UdpInfoTable: TTcpInfo;
   hTrapEvent: THandle;
   hIdentifier, Oid: TAsnObjectIdentifier;
   VarBindList: TSnmpVarBindList;
   VarBind: TSnmpVarBind;
   errorStatus, errorIndex: TAsnInteger32;
   currentEntry, newEntry: PTcpInfo;
   currentIndex: UINT;
   localaddr, localport, remoteaddr,remoteport: string;
begin
     Application.ProcessMessages;
     if not SnmpExtensionInit(GetTickCount, @hTrapEvent, @hIdentifier) then Exit;
     { TCP connections }
     FillChar(Oid, SizeOf(Oid), 0);
     FillChar(VarBindList, SizeOf(VarBindList), 0);
     FillChar(VarBind, SizeOf(VarBind), 0);
     Oid.idLength :=10;
     Oid.ids :=@TcpIdentifiers;
     SnmpUtilOidAppend(@VarBind.name, @Oid);
     VarBind.value.asnType :=ASN_NULL;
     VarBindList.list :=@VarBind;
     VarBindList.len :=1;
     FillChar(TcpInfoTable, SizeOf(TcpInfoTable), 0);
     TcpInfoTable.prev :=@TcpInfoTable;
     TcpInfoTable.next :=@TcpInfoTable;
     currentIndex :=1;
     currentEntry :=@TcpInfoTable;
     while True do
     begin
          Application.ProcessMessages;
          if not SnmpExtensionQuery(SNMP_PDU_GETNEXT,@VarBindList,@errorStatus,@errorIndex) then Exit;
          if VarBind.name.idLength < 10 then Break;
          if currentIndex <> PIds(VarBind.name.ids)^[9] then
          begin
               currentEntry :=TcpInfoTable.next;
               currentIndex :=PIds(VarBind.name.ids)^[9];
          end;
          case currentIndex of
            1: begin
                    newEntry :=PTcpInfo(AllocMem(SizeOf(TTcpInfo)));
                    newEntry^.prev :=currentEntry;
                    newEntry^.next :=@TcpInfoTable;
                    currentEntry^.next :=newEntry;
                    currentEntry :=newEntry;
                    currentEntry^.state :=VarBind.value.number;
               end;
            2: begin
                    currentEntry^.localip :=(PUINT(VarBind.value.address.stream))^;
                    currentEntry :=currentEntry^.next;
               end;
            3: begin
                    currentEntry^.localport :=VarBind.value.number;
                    currentEntry :=currentEntry^.next;
               end;
            4: begin
                    currentEntry^.remoteip :=(PUINT(VarBind.value.address.stream))^;
                    currentEntry :=currentEntry^.next;
               end;
            5: begin
                    currentEntry^.remoteport :=VarBind.value.number;
                    currentEntry :=currentEntry^.next;
               end;
          end;
     end;
     Application.ProcessMessages;
     with tvtcpudp.Items do
     begin
          BeginUpdate;
          Clear;
          EndUpdate;
     end;
     currentEntry :=TcpInfoTable.next;
     Application.ProcessMessages;
     while currentEntry <> @TcpInfoTable do
     begin
//          if not TBtnEndp.Down then if currentEntry^.state <> 5 then
//          begin
//               currentEntry :=currentEntry^.next;
//               Continue;
//          end;
          localaddr :=Format('%s',[GetHost(True, currentEntry^.localip)]);
          localport :=Format('%s',[GetPort(currentEntry^.localport, 'tcp')]);
          if currentEntry^.remoteip=0 then remoteaddr :=Format('%s: %s',[GetHost(False, currentEntry^.remoteip), '0'])
          else remoteaddr :=Format('%s',[GetHost(False, currentEntry^.remoteip)]);
          remoteport :=Format('%s',[GetPort(currentEntry^.remoteport, 'tcp')]);
          Application.ProcessMessages;
          with tvtcpudp.Items.Add do
          begin
               ImageIndex :=0;
               Caption :='TCP';
               SubItems.Add(localaddr);

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -