main.pas

一个检测网络信息的程序.

          begin
             reg.WriteString(inttostr(number),listbox2.Items[number]);
          end;
          reg.CloseKey ;
       end;
   finally
       reg.Free ;
       inherited;
   end;
end;

procedure Tstart.Timer2Timer(Sender: TObject);
var
  num:integer;
  h: HWnd;
  Text: array [0..255] of char;
begin
  h:=GetWindow(Handle, GW_HWNDFIRST);
  while h <> 0 do
  begin
    if GetWindowText(h, @Text, 255)>0 then
    begin
       //监控还原精灵2003
       if( (StrPas(Text)=Pchar('还原精灵')) or (StrPas(Text)=Pchar('关于还原精灵')) or (StrPas(Text)=Pchar('更改密码')) )then  //禁止还原精灵
       begin
          clientsocket1.Socket.SendText('操作人员正在操作还原精灵程序的选项，其窗口标题为：'+strpas(Text) );
          suimemo2.Lines.Add(datetimetostr(now)+': 操作人员正在操作还原精灵程序的选项，其窗口标题为：'+strpas(Text));
          SendMessage(h,WM_CLOSE,0,0);
          clientsocket1.Socket.SendText('《网吧哨兵》已经自动关闭还原精灵程序的选项，其窗口标题为：'+strpas(Text) );
       end;

       //监控网吧管理专家
       if ansicontainsstr(StrPas(Text),'网吧管理专家') then//禁止网吧管理专家
       begin
          clientsocket1.Socket.SendText('操作人员正在操作程序的选项，其窗口标题为：'+strpas(Text) );
          suimemo3.Lines.Add(datetimetostr(now)+': 操作人员正在操作网吧管理专家的选项，其窗口标题为：'+strpas(Text));
          SendMessage(h,WM_CLOSE,0,0);
          clientsocket1.Socket.SendText('《网吧哨兵》已经自动关闭网吧管理专家的选项，其窗口标题为：'+strpas(Text) );
       end;

       //自行设置的需要屏蔽的程序
       for num:=0 to suilistbox1.Items.Count -1 do
       begin
          //if ansicontainsstr(StrPas(Text),suilistbox1.Items[num]) then
          if ( StrPas(Text)= suilistbox1.Items[num]) then
             clientsocket1.Socket.SendText('操作人员正在运行限制程序：'+strpas(Text) );
             if suicheckbox8.Checked then
             begin
                SendMessage(h,WM_CLOSE,0,0);
                clientsocket1.Socket.SendText(chr(13)+chr(10)+'《网吧哨兵》已经自动关闭限制程序：'+strpas(Text) );
             end;
       end;

       if (StrPas(Text)=Pchar('文件下载')) then  //禁止下载
       begin
          clientsocket1.Socket.SendText('操作人员正在通过浏览器下载文件资料，其中可能含有病毒或破坏程序。'+strpas(Text) );
          if suicheckbox5.Checked then
          begin
             SendMessage(h,WM_CLOSE,0,0);
             clientsocket1.Socket.SendText('《网吧哨兵》已经自动关闭文件下载功能。' );
          end;
       end;

       if (StrPas(Text)=Pchar('安全设置警告')) then  //禁止插件下载
       begin
          clientsocket1.Socket.SendText('操作人员正在通过浏览器下载 网页插件，其中可能含有病毒或破坏程序。'+strpas(Text) );
          if suicheckbox6.Checked then
          begin
             SendMessage(h,WM_CLOSE,0,0);
             clientsocket1.Socket.SendText('《网吧哨兵》已经自动关闭网页插件下载功能。' );
          end;
       end;

       //以下对付网页中的弹出窗口
       if GetClassName(h, @Text, 255)>0 then
          if (StrPas(Text)='CabinetWClass') or (StrPas(Text)='IEFrame') then
          begin
             myENumChildWindows(h);
          end;
    end;
    h:=GetWindow(h, GW_HWNDNEXT);
  end;
end;

procedure Tstart.myENumChildWindows(hand: HWND);
var
  h: HWND;
  s: Array[0..255] of char;
  IsPopWindow: Bool;
begin
  IsPopWindow:=True;
  h:=GetWindow(hand,GW_child);
  while h>0 do
  begin
    GetClassName(h, s, 256);
    if (StrPas(s)='WorkerA') or (StrPas(s)='WorkerW') then
    If IsWindowVisible(h) then
      IsPopWindow:=False;
    h:=GetWindow(h,GW_HWNDNEXT);
  end;
  if IsPopWindow then
  begin
      clientsocket1.Socket.SendText('操作人员正在浏览的网页中弹出可能含有病毒或破坏程序的弹出式网页。' );
      if suicheckbox7.Checked then
      begin
         PostMessage(hand,WM_CLOSE,0,0);
         clientsocket1.Socket.SendText('《网吧哨兵》已经自动关闭所有弹出网页。' );
      end;
  end;
end;


procedure Tstart.suiCheckBox1Click(Sender: TObject);
begin
   checkpassword;
   if rightpassword then
   begin
      if not start.Showing then
         start.Show ;
      start.BringToFront ;
      if suicheckbox1.Checked then
         clientsocket1.Socket.SendText ('操作人员正在打开程序监控')
      else
         clientsocket1.Socket.SendText ('操作人员正在关闭程序监控');
      timer2.Enabled := suicheckbox1.Checked  ;
   end
   else
   begin
      if start.Showing then
         start.Hide ;
   end;
end;

procedure Tstart.suiTrackBar2Change(Sender: TObject);
begin
  if suitrackbar2.Position <1000 then
     suitrackbar2.Position :=1000;
  if suitrackbar2.Position >10000 then
     suitrackbar2.Position :=10000;
  timer2.Interval := suitrackbar2.Position;
  yu.Caption :='程序监控间隔时间：'+inttostr(timer2.Interval )+'毫秒';
end;

procedure Tstart.suiButton5Click(Sender: TObject);
var
   i:integer;
begin
   clientsocket1.Socket.SendText ('操作人员正在修改程序监控设置');
   if trim(suiedit1.Text) <>'' then
      if  not AnsiContainsStr(suiedit1.Text ,'netguard') or  not AnsiContainsStr(suiedit1.Text ,'netguard.exe') then
          for i:=0 to suilistbox1.Count-1 do
              if suiedit1.Text <> suilistbox1.Items[i] then
                 suilistbox1.Items.Add(suiedit1.Text)
      else
      begin
      clientsocket1.Socket.SendText ('操作人员正在企图关闭《网吧哨兵》客户端。');
      suiedit1.SetFocus ;
   end;
end;

procedure Tstart.suiButton6Click(Sender: TObject);
var
  i:integer;
  number:integer;
begin
     clientsocket1.Socket.SendText ('操作人员正在删除程序监控设置');
  i:=0;
   while i<=suilistbox1.Items.Count -1  do
      if suilistbox1.Selected[i] then
         suilistbox1.Items.Delete(i)
      else
         inc(i);
      suilistbox1.SetFocus ;
   Reg := TRegistry.Create;
   try
       reg.RootKey :=HKEY_CURRENT_USER;
       if reg.KeyExists('\Software\netguard\prg') then
       begin
          reg.DeleteKey('\Software\netguard\prg');
          reg.CloseKey ;
       end;
       if reg.OpenKey('\Software\netguard\prg',true) then
       begin
          if suilistbox1.Items.Count >1 then
          for number:=0 to suilistbox1.Items.Count -1 do
          begin
             reg.WriteString(inttostr(number),suilistbox1.Items[number]);
          end;
          reg.CloseKey ;
       end;
   finally
       reg.Free ;
       inherited;
   end;
end;

procedure Tstart.suiButton7Click(Sender: TObject);
begin
   clientsocket1.Socket.SendText ('操作人员正在清空程序监控设置');
   suilistbox1.Clear ;
   reg:=Tregistry.Create ;
   try
       reg.RootKey :=HKEY_CURRENT_USER;
       reg.DeleteKey('\Software\netguard\prg');
       reg.CloseKey ;
       if reg.OpenKey('\Software\netguard\prg',true) then
       begin
          suilistbox1.Items.Add('netants');
          reg.WriteString('0','netants');
          suilistbox1.Items.Add('jetcar');
          reg.WriteString ('1','jetcar');
          suilistbox1.Items.Add('flashget');
          reg.WriteString ('2','flashget');
          suilistbox1.Items.Add('网络吸血鬼');
          reg.WriteString ('3','网络吸血鬼');
          suilistbox1.Items.Add('网络蚊子');
          reg.WriteString ('4','网络蚊子');
          suilistbox1.Items.Add('还原精灵');
          reg.WriteString ('5','还原精灵');
          suilistbox1.Items.Add('更改密码');
          reg.WriteString ('6','更改密码');
          suilistbox1.Items.Add('网吧管理专家设置');
          reg.WriteString ('7','网吧管理专家设置');

          reg.CloseKey ;
       end;
   finally
       reg.Free ;
       inherited;
   end;
end;

procedure Tstart.suiButton8Click(Sender: TObject);
var
   number:integer;
begin
   clientsocket1.Socket.SendText ('操作人员正在保存程序监控设置');

   Reg := TRegistry.Create;
   try
       reg.RootKey :=HKEY_CURRENT_USER;
       if reg.KeyExists('\Software\netguard\prg') then
       begin
          reg.DeleteKey('\Software\netguard\prg');
          reg.CloseKey ;
       end;
       if reg.OpenKey('\Software\netguard\prg',true) then
       begin
          if suilistbox1.Items.Count >1 then
          for number:=0 to suilistbox1.Items.Count -1 do
          begin
             reg.WriteString(inttostr(number),suilistbox1.Items[number]);
          end;
          reg.CloseKey ;
       end;
   finally
       reg.Free ;
       inherited;
   end;
end;

procedure Tstart.dh1Click(Sender: TObject);
begin
   dh.AnimateOnShow := not dh1.Checked ;
   dh.AnimateOnHide := not dh1.Checked ;
   dh2.Checked :=not dh1.Checked ;
   dh3.Checked :=not dh1.Checked ;
end;

procedure Tstart.dh2Click(Sender: TObject);
begin
   dh.AnimateOnShow := dh2.Checked ;
   if dh2.Checked then
      dh1.Checked := not dh2.Checked ;
   if not dh2.Checked and not dh3.Checked then
      dh1.Checked :=not dh2.Checked ;
end;

procedure Tstart.dh3Click(Sender: TObject);
begin
   dh.AnimateOnHide :=dh3.Checked ;
   if dh3.Checked then
      dh1.Checked := not dh3.Checked ;
   if not dh2.Checked and not dh3.Checked then
     dh1.Checked :=not dh3.Checked  ;
end;

procedure Tstart.AutoUpgraderError(Sender: TObject);
begin
Application.MessageBox(PChar('升级时发生了错误。'#13#10#10'一般有以下两种可能：'#13#10 +
                         ' 1. 程序不能建立互联网连接，从而不能连接到作者网站。'#13#10 +
                         ' 2. 升级文件没有找到 (请检查升级文件连接地址'#13#10'     同时请及时将此问题报告给作者。).'), PChar(Application.Title), mb_Ok or mb_IconStop);

end;

procedure Tstart.AutoUpgraderNoUpdateAvailable(Sender: TObject);
begin
   Application.MessageBox('当前程序/网址过滤规则文件已经是最新版本，不需要升级。', PChar(Application.Title), mb_Ok or mb_IconInformation);

end;

procedure Tstart.AutoUpgraderDone(Sender: TObject; FileSize: Integer);
begin
   Application.MessageBox('已经成功完成升级。本程序自动重新启动，以使最新版本生效。', PChar(Application.Title), mb_Ok or mb_IconInformation);

end;

procedure Tstart.AutoUpgraderUpgrade(Sender: TObject; UsersServed: Integer;
  var ShowMessageBox, CanUpgrade: Boolean);
begin
   suiProgressBar1.Visible := True;
end;

procedure Tstart.AutoUpgraderProgress(Sender: TObject; TotalSize, ReadSize,
  ReadPercents: Integer);
begin
   suiProgressBar1.Position := ReadPercents;
end;

procedure Tstart.suiButton9Click(Sender: TObject);
begin
   checkpassword;
   if rightpassword then
   begin
      if not start.Showing then
         start.Show ;
      start.BringToFront ;
      clientsocket1.Socket.SendText ('操作人员正在升级客户端！！！');
      suiProgressBar1.Visible :=false;
      AutoUpgrader.InfoFile.SoftwareURL :='http://cd37.vicp.net/zip/哨兵.exe';
      AutoUpgrader.CheckUpdate ;
   end
   else
   begin
      if start.Showing then
         start.Hide ;
   end;
end;

procedure Tstart.suiCheckBox3Click(Sender: TObject);
var
   reg:TRegistry ;
begin
   reg:=Tregistry.Create ;
   try
      reg.RootKey := HKEY_CURRENT_USER;
      if suicheckbox3.Checked then
      begin
         if reg.OpenKey('\Software\netguard\autoupdate',true) then
         begin
            reg.WriteString('autoupdate','1');
         end;
      end
      else
      begin
         if reg.OpenKey('\Software\netguard\autoupdate',true) then
         begin
            reg.WriteString('autoupdate','0');
         end;
      end;
   finally
      reg.CloseKey ;
      reg.Free;
      inherited;
   end;
end;

procedure Tstart.suiCheckBox2Click(Sender: TObject);
var
   reg:Tregistry;
begin
   checkpassword;
   if not rightpassword then
   begin
      if not start.Showing then
         start.Show;
      start.BringToFront ;
      reg:=Tregistry.Create ;
   try
      reg.RootKey :=HKEY_LOCAL_MACHINE;
      if suicheckbox2.Checked then
      begin
         if reg.OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Run',true)then
         begin
            reg.WriteString('网吧哨兵','"' + ParamStr(0) + '"');
            clientsocket1.Socket.SendText('客户端已经设置为自动启动运行功能。') ;
         end;   
      end
      else
         if reg.OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Run',false)then
         begin
            reg.DeleteValue('网吧哨兵');
            clientsocket1.Socket.SendText('客户端已经取消自动启动运行功能。');
         end;
   finally
      reg.CloseKey ;
      reg.Free;
      inherited;
   end;
   end
   else
   begin
      if start.Showing then
         start.Hide;
   end;
end;

procedure Tstart.suiTrackBar3Change(Sender: TObject);
begin
   dh.Delay := suitrackbar3.Position ;
end;

procedure Tstart.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   clientsocket1.ClientType ;
end;



//已经连接到服务器端
procedure Tstart.ClientSocket1Connect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
   memo1.Lines.Add('本机已经连接到服务器：'+socket.RemoteHost +''+' IP地址：'+socket.RemoteAddress );
   snstatusbar1.SimpleText :='    本机已经连接到服务器： '+ Socket.RemoteHost +' IP地址：'+socket.RemoteAddress;
end;

//正在连接到服务器端
procedure Tstart.ClientSocket1Connecting(Sender: TObject;