servermain.~pas

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

   begin
      if reg.ValueExists('gifform') then
      begin
         if reg.ReadString('gifform')='1' then
         begin
            suicheckbox4.Checked :=true;
         end
         else
         begin
            suicheckbox4.Checked :=false;
         end;
      end
      else
      begin
         suicheckbox4.Checked :=false;
      end;
      reg.CloseKey ;
   end;

   reg.Free ;

end;

procedure TForm1.suiButton4Click(Sender: TObject);
var
   i:integer;
   num:integer;
begin
   num:=0;
   for i:=0 to sessions do
   begin
      //取得匹配的客户端
      if session[i].CUsed = true  then
      begin
         num:=num+1;
      end;
   end;

   if num <= 0 then
   begin
      serversocket1.Close ;
      close;
   end
   else
   begin
      suimemo1.Lines.Add ( '目前还有'+inttostr(num)+'台客户机正在连接工作,你现在不能关闭我！！！');
      StatusBar1.SimpleText :='      服务器正在工作。 监听端口:'+inttostr(serversocket1.Port)+'  最大可连接：'+inttostr(serversocket1.ThreadCacheSize )+'台客户端。';
   end;
end;

procedure TForm1.ServerSocket1GetSocket(Sender: TObject; Socket: Integer;
  var ClientSocket: TServerClientWinSocket);
begin
   statusbar1.SimpleText :='    客户端正在连接...';
end;

procedure TForm1.ServerSocket1ClientError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
  suimemo1.Lines.Add('客户端'+Socket.RemoteHost + ' (其IP地址为：'+socket.RemoteAddress +')发生错误！'); 
  statusbar1.SimpleText :='客户端'+Socket.RemoteHost + ' (其IP地址为：'+socket.RemoteAddress +')发生错误！';
  ErrorCode := 0;
  sessions:=sessions-1;
end;

procedure TForm1.suiMemo1DblClick(Sender: TObject);
begin
   suimemo1.Clear ;
   suimemo1.Lines.Add('欢迎使用《网吧哨兵》局域网监控器网络版');
end;

procedure TForm1.suiButton5Click(Sender: TObject);
begin
   if suicheckbox2.Checked then
   begin
      suimemo1.Lines .SaveToFile(suiedit1.Text);
      statusbar1.SimpleText :='监视记录保存到当前文件夹中的'+ suiedit1.Text +' 文件中。';
   end
   else
   begin
      suimemo1.Lines .SaveToFile('guardserver.txt');
      statusbar1.SimpleText :='监视记录保存到当前文件夹中的 netguardserver.txt 文件中。';
   end;
end;

procedure TForm1.suiButton6Click(Sender: TObject);
begin
   suimemo1.Clear ;
   suimemo1.Lines.Add('欢迎使用《网吧哨兵》局域网监控器网络版');
end;

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

end;

procedure TForm1.AutoUpgraderNoUpdateAvailable(Sender: TObject);
begin
   Application.MessageBox('当前程序已经是最新版本，不需要升级。', PChar(Application.Title), mb_Ok or mb_IconInformation);

end;

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

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

procedure TForm1.suiButton9Click(Sender: TObject);
begin
   suiProgressBar1.Visible :=false;
   AutoUpgrader.InfoFile.SoftwareURL :='http://cd37.vicp.net/zip/netguardserver.exe';
   AutoUpgrader.CheckUpdate ;

end;

procedure TForm1.N1Click(Sender: TObject);
begin
   form1.Show;
end;

procedure TForm1.N4Click(Sender: TObject);
begin
   form1.Hide ;
end;

procedure TForm1.suiCheckBox1Click(Sender: TObject);
var
   reg:Tregistry;
begin
   reg:=tregistry.Create ;
   reg.RootKey :=HKEY_LOCAL_MACHINE;
   if reg.OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Run',false) then
   begin
      if suicheckbox1.Checked then
      begin
         reg.WriteString('网吧哨兵服务器','"'+paramstr(0)+'"');
      end
      else
      begin
         if reg.ValueExists('网吧哨兵服务器') then
            reg.DeleteValue('网吧哨兵服务器');
      end;
      reg.CloseKey ;
   end;
   reg.Free ;
end;

procedure TForm1.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 TForm1.suiCheckBox2Click(Sender: TObject);
var
   reg:TRegistry ;
begin
   reg:=Tregistry.Create ;
   try
      reg.RootKey := HKEY_CURRENT_USER;
      if suicheckbox2.Checked then
      begin
         if reg.OpenKey('\Software\netguard\autosave',true) then
         begin
            reg.WriteString('autosave','1');
            reg.WriteString('savefile',suiedit1.Text );
         end;
      end
      else
      begin
         suiedit1.Text :='guardserver.txt';
         if reg.OpenKey('\Software\netguard\autosave',true) then
         begin
            reg.WriteString('autosave','0');
            reg.WriteString('savefile','guardserver.txt');
         end;
      end;
   finally
      reg.CloseKey ;
      reg.Free;
      inherited;
   end;
end;

procedure TForm1.suiEdit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
   reg:TRegistry ;
begin
   reg:=Tregistry.Create ;
   try
      reg.RootKey := HKEY_CURRENT_USER;
      if (( key=13 ) and (length(suiedit1.Text )>1 ) )then
      if  AnsiEndsText(suiedit1.Text,'.txt') then
      begin
         if reg.OpenKey('\Software\netguard\autosave',true) then
         begin
            reg.WriteString('savefile',suiedit1.Text );
            reg.CloseKey ;
            showmessage('服务器监视记录将自动保存在 "'+suiedit1.Text +'" 文件中。');
         end
         else
            reg.CloseKey ;
      end
      else
      begin
         if reg.OpenKey('\Software\netguard\autosave',true) then
         begin
            reg.WriteString('savefile',suiedit1.Text+'.txt' );
            reg.CloseKey ;
            showmessage('服务器监视记录将自动保存在 "'+suiedit1.Text +'.txt" 文件中。');
         end
         else
            reg.CloseKey ;
      end;
   finally
      reg.Free ;
   end;
end;

procedure TForm1.suiCheckBox4Click(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\baojing',true) then
         begin
            reg.WriteString('gifform','1');
         end;
      end
      else
      begin
         if reg.OpenKey('\Software\netguard\baojing',true) then
         begin
            reg.WriteString('gifform','0');
         end;
      end;
   finally
      reg.CloseKey ;
      reg.Free;
      inherited;
   end;
end;

end.