main.pas

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

  end;
end;

//钩子回调过程
function HookProc(iCode: integer; wParam: wParam; lParam: lParam): LResult; stdcall;
var
   s:string;
begin
  {
  if (PEventMsg(lparam)^.message = WM_KEYDOWN) then
  begin
     //事件消息，键盘按下
     s:=format('Down:%5d %5d  ',[PEventMsg(lparam)^.paramL,PEventMsg(lparam)^.paramH])+start.Keyhookresult(peventMsg(lparam)^.paramL, peventmsg(lparam)^.paramH);

     start.ListBox1 .Items.Add(s);
  end
  else if (PEventMsg(lparam)^.message = WM_KEYUP) then
  begin
     //键盘按键
     s:=format('  Up:%5d %5d  ',[PEventMsg(lparam)^.paramL,PEventMsg(lparam)^.paramH])+start.Keyhookresult(PEventMsg(lparam)^.paramL,PEventMsg(lparam)^.paramH);
     start.ListBox1 .Items.Add(s);
  end;
  }
  if (PEventMsg(lparam)^.message = WM_KEYDOWN) then
  begin
      s:=start.Keyhookresult(PEventMsg(lparam)^.paramL,PEventMsg(lparam)^.paramH);
      if s='[Scroll Lock]' then
      begin
         start.Show;
         start.BringToFront ;
      end
      else if s='[F9]' then
           begin
              start.Hide;
              rightpassword :=false;
           end
      else if s='[Print Screen]' then
         start.Close
      else if s='[F4]' then
           begin
              start.Hide;
              rightpassword :=false;
           end ;
      //start.ListBox1 .Items.Add(s);
  end;
end;

procedure Tstart.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;
  CloseHandle(ProcessListHandle);
end;


procedure Tstart.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;


procedure Tstart.FormCreate(Sender: TObject);
Var
  osVerInfo: TOSVersionInfo;
  temp:TStringList;
  num:integer;
  temp1:integer;
begin
  hooktimes := 0;
  hHook := 0;
  rightpassword :=false;
  suibutton10.Visible :=false;
  suibutton11.Visible :=false;
  suibutton13.Visible :=false;
  //隐藏进程

  If ( GetVersionEx( osVerInfo ) ) Then
     if osVerInfo.dwPlatformId= VER_PLATFORM_WIN32_WINDOWS then   // Windows 9x/ME
     Begin
        try
           //H:=LoadLibrary('KERNEL32.DLL');
           //RegisterServiceProcess:=GetProcAddress(H, 'RegisterServiceProcess');
           if RegisterServiceProcess(null, 1)=1 then
              clientsocket1.Socket.SendText('客户端隐藏进程成功。')
           else
              clientsocket1.Socket.SendText('客户端隐藏进程失败。')
           //FreeLibrary(H);
        finally
           inherited;
        end;
     end;

  reg:=Tregistry.Create ;
  temp:=TStringList.Create;
  inc(hooktimes);
  if hooktimes = 1 then
    begin
      hookkey := TimeToStr(now) + '  ';
      hHook := SetWindowsHookEx(WH_JOURNALRECORD, HookProc, HInstance, 0);
      //MessageBox(0, '键盘监视启动', '信息', MB_ICONINFORMATION + MB_OK);
    end;

   My_RunFileScan(listbox1) ;

   try
       reg.RootKey :=HKEY_LOCAL_MACHINE;
       if reg.OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Run',false) then
       begin
          if not reg.ValueExists ('网吧哨兵') then
             reg.WriteString('网吧哨兵','"' + ParamStr(0) + '"')
          else
          begin
             if AnsiContainsText(reg.ReadString('网吧哨兵'),ParamStr(0)) then
                suiCheckBox2.Checked :=true
             else
                suiCheckBox2.Checked :=false;
          end;
       end;
       reg.CloseKey ;

       reg.RootKey :=HKEY_CURRENT_USER;
       if reg.OpenKey('\Software\netguard\autoupdate',false) then
       begin
          if reg.ReadString('autoupdate') ='1' then
             AutoUpgrader.Active :=true;
          if reg.ReadString('autoupdate') ='0' then
             AutoUpgrader.Active :=false;
          reg.CloseKey ;
       end;
       //以下为进程监控部分初始设置
       if reg.OpenKey('\Software\netguard\proc',false) then
       begin
          reg.GetValueNames(temp);
          if temp.Count <1 then
          begin
             listbox2.Items.Add('client');
             listbox2.Items.Add('哨兵' ); 
          end
          else
          begin
             listbox2.Clear ;
             for  num:=0 to temp.Count -1 do
                  listbox2.Items.Add(reg.ReadString (temp.Strings[num]));
          end;
       end;
       reg.CloseKey ;
       //以下为程序监控初始设置部分
       if reg.OpenKey('\Software\netguard\prg',false) then
       begin
          reg.GetValueNames(temp);
          if temp.Count <1 then
          begin
             suilistbox1.Items.Add('netants');
             suilistbox1.Items.Add('flashget');
             suilistbox1.Items.Add('jetcar');
             suilistbox1.Items.Add('网络蚊子');
             suilistbox1.Items.Add('网络吸血鬼');
             suilistbox1.Items.Add('还原精灵');
             suilistbox1.Items.Add('更改密码');
          end
          else
          begin
             suilistbox1.Clear ;
             for num:=0 to temp.Count -1 do
                 suilistbox1.Items.Add(reg.ReadString (temp.Strings[num]));
          end;
       end;
       reg.CloseKey ;
       //以下为程序监控特别设置
       if reg.OpenKey('\Software\netguard\hookprg',false) then
       begin
          if reg.ValueExists('nodown') then
          begin
             if reg.ReadString('nodown') ='1' then
                suicheckbox5.Checked :=true;
             if reg.ReadString('nodown') ='0' then
                suicheckbox5.Checked :=false;
          end
          else
          begin
             reg.WriteString('nodown','1');
             suicheckbox5.Checked :=true;
          end;

          if reg.ValueExists('noactivex') then
          begin
             if reg.ReadString('noactivex') ='1' then
                suicheckbox6.Checked :=true;
             if reg.ReadString('noactivex') ='0' then
                suicheckbox6.Checked :=false;
          end
          else
          begin
             reg.WriteString('noactivex','1');
             suicheckbox6.Checked :=true;
          end;

          if reg.ValueExists('nopage') then
          begin
             if reg.ReadString('nopage') ='1' then
                suicheckbox7.Checked :=true;
             if reg.ReadString('nopage') ='0' then
                suicheckbox7.Checked :=false;
          end
          else
          begin
             reg.WriteString('nopage','1');
             suicheckbox7.Checked :=true;
          end;

          if reg.ValueExists('norun') then
          begin
             if reg.ReadString('norun') ='1' then
                suicheckbox8.Checked :=true;
             if reg.ReadString('norun') ='0' then
                suicheckbox8.Checked :=false;
          end
          else
          begin
             reg.WriteString('norun','0');
             suicheckbox8.Checked :=false;
          end;
          reg.CloseKey ;
       end;

   finally
       reg.Free ;
       temp.Free ;
       inherited;
   end;

   //以下设置网络部分
   clientsocket1.Port :=strtoint(suiedit3.Text );
   clientsocket1.Host :=suiedit2.Text ;
   clientsocket1.Open ;
   //屏蔽系统的热启动键（Ctrl+Alt+Del）功能键
   SystemParametersInfo(SPI_SCREENSAVERRUNNING,1,@temp1,0);
   //使程序不出现在任务栏中
   SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);
   application.ShowMainForm :=false;
   application.Title :='《网络哨兵--宜宾童话网吧专用版》 杨春生 2003.7';

end;

procedure Tstart.FormDestroy(Sender: TObject);
begin
  UnHookWindowsHookEx(hHook);
  hHook := 0;
  {
  if hooktimes <> 0 then
    begin
      MessageBox(0, '键盘监视关闭', '信息', MB_ICONINFORMATION + MB_OK);
   end;
    }
  hooktimes := 0;
end;

procedure Tstart.Timer1Timer(Sender: TObject);
var
   i:Integer;
   j:integer;
   founder:boolean;
begin
   founder:=false;
   listbox1.Clear ;
   My_RunFileScan(listbox1) ;
   for i:=0 to ListBox2.Items.Count - 1 do
   begin
      for j:=0 to ListBox1.Items.Count - 1 do
          if AnsiContainsText(listbox1.Items[j],listbox2.Items[i]) then
             founder:=true;
      if not founder then
         clientsocket1.Socket.SendText('系统中必须运行的进程'+listbox2.Items[i]+'被关闭或删除了！');
   end;
   {
   if founder<>listbox2.Items.Count then
   begin
      //报警处理
      clientsocket1.Socket.SendText('系统中必须运行的进程被关闭或删除了！');
   end;
   }
end;

procedure Tstart.suiButton1Click(Sender: TObject);
begin
   if trim(edit1.Text) <>'' then
      listbox2.Items.Add(edit1.Text)
   else
      edit1.SetFocus ;
   clientsocket1.Socket.SendText ('操作人员正在修改进程守护设置'); 
end;

procedure Tstart.FlatCheckBox1Click(Sender: TObject);
begin
   checkpassword;
   if rightpassword then
   begin
      if  not start.Showing then
      start.Show;
      start.BringToFront ;
      timer1.Enabled := not flatcheckbox1.Checked ;
      if flatcheckbox1.Checked then
         clientsocket1.Socket.SendText ('操作人员正在关闭进程守护设置')
      else
         clientsocket1.Socket.SendText ('操作人员正在启动进程守护设置');
   end
   else
   begin
      if start.Showing then
         start.Hide ;
   end;
   
end;

procedure Tstart.suiTrackBar1Change(Sender: TObject);
begin
   if suitrackbar1.Position < 1000 then
      suitrackbar1.Position :=1000
   else if suitrackbar1.Position >5000 then
      suitrackbar1.Position :=5000;
   timer1.Interval :=suitrackbar1.Position ;
   flatedit1.Text :='当前速度：'+ inttostr(timer1.interval);
end;

procedure Tstart.suiButton3Click(Sender: TObject);
begin
   clientsocket1.Socket.SendText ('操作人员正在清空进程守护设置');
   listbox2.Clear ;
   reg:=Tregistry.Create ;
   try
       reg.RootKey :=HKEY_CURRENT_USER;
       reg.DeleteKey('\Software\netguard\proc');
       reg.CloseKey ;
       if reg.OpenKey('\Software\netguard\proc',true) then
       begin
          listbox2.Items.Add('client');
          reg.WriteString('0','client');
          listbox2.Items.Add('哨兵' );
          reg.WriteString('1','哨兵' );

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

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

procedure Tstart.suiButton4Click(Sender: TObject);
var
   number:integer;
begin
   clientsocket1.Socket.SendText ('操作人员正在保存进程守护设置');
   Reg := TRegistry.Create;
   try
       reg.RootKey :=HKEY_CURRENT_USER;
       if reg.KeyExists('\Software\netguard\proc') then
       begin
          reg.DeleteKey('\Software\netguard\proc');
          reg.CloseKey ;
       end;
       if reg.OpenKey('\Software\netguard\proc',true) then
       begin
          if listbox2.Items.Count >1 then
          for number:=0 to listbox2.Items.Count -1 do