serverpas.pas

网络控制--在局与网络内控制网络流量,现实等,实现网络的控制及其管理

unit ServerPas;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, NMUDP, StdCtrls, Buttons, ExtCtrls, Winsock, Spin, ComCtrls, IniFiles,
  Registry, ShellAPI, Menus;

const MY_MESSAGE=WM_USER+113;  

type
  TFrmServer = class(TForm)
    NMUDP1: TNMUDP;
    BitBtn1: TBitBtn;
    Timer1: TTimer;
    BitBtn2: TBitBtn;
    Edit1: TEdit;
    Label2: TLabel;
    Edit2: TEdit;
    Label3: TLabel;
    Label4: TLabel;
    UpDown1: TUpDown;
    UpDown2: TUpDown;
    Label1: TLabel;
    GroupBox1: TGroupBox;
    ListBox1: TListBox;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure NMUDP1DataReceived(Sender: TComponent; NumberBytes: Integer;
      FromIP: String; Port: Integer);
    procedure BitBtn1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
  private
  procedure WMQueryEndSession(var Msg: TWMQueryEndSession);message WM_QUERYENDSESSION;
  procedure OnIconNotify(var Message: TMessage);message MY_MESSAGE;
    { Private declarations }
  public
  LocalIp,ExePath,InterTime,Delaytime:string;
  Busy:Boolean;
  procedure AddIp(Const Ip:string);
  procedure DelIp(Const Ip:string);
    { Public declarations }
  end;

var
  FrmServer: TFrmServer;
  function Getosversion:string;
  function GetLocalIP:String;
  procedure ExitWindowsNT(uFlags:integer);
  procedure AdjustToken;

implementation

{$R *.dfm}

procedure AdjustToken;
var
  hdlProcessHandle:Cardinal;
  hdlTokenHandle:Cardinal;
  tmpLuid:Int64;
  tkp:TOKEN_PRIVILEGES;
  tkpNewButIgnored:TOKEN_PRIVILEGES;
  lBufferNeeded:Cardinal;
  Privilege:array[0..0] of _LUID_AND_ATTRIBUTES;
begin
hdlProcessHandle:=GetCurrentProcess;
OpenProcessToken(hdlProcessHandle,(TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY),hdlTokenHandle);
// Get the LUID for shutdown privilege.
LookupPrivilegeValue('','SeShutdownPrivilege',tmpLuid);
Privilege[0].Luid:=tmpLuid;
Privilege[0].Attributes:=SE_PRIVILEGE_ENABLED;
tkp.PrivilegeCount:=1;   // One privilege to set
tkp.Privileges[0]:=Privilege[0];
// Enable the shutdown privilege in the access token of this process.
AdjustTokenPrivileges(hdlTokenHandle,False,tkp,Sizeof(tkpNewButIgnored),tkpNewButIgnored,lBufferNeeded);
end;

procedure ExitWindowsNT(uFlags:integer);
var
 hToken:THANDLE;
 tkp,tkDumb:TTokenPrivileges;
 DumbInt:DWORD;// DumbInt:integer; d5中用integer类型
begin
FillChar(tkp, sizeof(tkp), 0);
if not (OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken)) then
  raise Exception.create('OpenProcessToken failed with code '+ inttostr(GetLastError));
LookupPrivilegeValue(nil, pchar('SeShutdownPrivilege'),tkp.Privileges[0].Luid);
tkp.PrivilegeCount:=1;
tkp.Privileges[0].Attributes:=SE_PRIVILEGE_ENABLED;
AdjustTokenPrivileges(hToken, false, tkp, sizeof(tkDumb), tkDumb, DumbInt);
if GetLastError <> ERROR_SUCCESS then
  Raise Exception.create('AdjustTokenPrivileges failed with code '+ inttostr(GetLastError));
if not ExitWindowsEx(uFlags, 0) then
  Raise Exception.create('退出程序发生错误,请手工执行退出！'+ inttostr(GetLastError));
end;

function Getosversion:string;
begin
if (Win32MajorVersion >= 5) and (Win32Platform = VER_PLATFORM_WIN32_NT) then //NT
  result:='NT';
if (Win32MajorVersion <= 5) and (Win32Platform = VER_PLATFORM_WIN32_WINDOWS) then //WIN9X
  result:='9X';
end;

function GetLocalIP:String;
type
    TaPInAddr = array [0..10] of PInAddr;
    PaPInAddr = ^TaPInAddr;
var
    phe:PHostEnt;
    pptr:PaPInAddr;
    Buffer:array [0..63] of char;
    I:Integer;
    GInitData:TWSADATA;
begin
WSAStartup($101, GInitData);
try
    Result:='';
    GetHostName(Buffer, SizeOf(Buffer));
    phe :=GetHostByName(buffer);
    if phe = nil then Exit;
    pptr := PaPInAddr(Phe^.h_addr_list);
    I := 0;
    while pptr^[I] <> nil do
      begin
      result:=StrPas(inet_ntoa(pptr^[I]^));
      Inc(I);
      end;
finally
    WSACleanup;
end;
end;

procedure TFrmServer.OnIconNotify(var Message: TMessage);
begin
if not Busy then
  begin
  Busy:=true;
  if Message.LParam=WM_LBUTTONDOWN then
    PopupMenu1.Popup(mouse.CursorPos.x,mouse.CursorPos.y);
  Busy:=false;
  end;
end;

procedure TFrmServer.WMQueryEndSession(var Msg: TWMQueryEndSession);
begin
  inherited;
Msg.Result:=0;
close;
if Getosversion='9X' then
  ExitWindowsEx(EWX_SHUTDOWN,1)
else
  begin
  try AdjustToken; except end;
  ExitWindowsEx(EWX_POWEROFF,0);
  End;
  //ExitWindowsNT(EWX_SHUTDOWN or EWX_FORCE);
end;

procedure TFrmServer.AddIp(Const Ip:string);
begin
If ListBox1.Items.IndexOf(Ip)=-1 Then
  ListBox1.Items.Add(IP); 
end;

procedure TFrmServer.DelIp(Const Ip:string);
begin
Try ListBox1.Items.Delete(ListBox1.Items.IndexOf(Ip)); Except End;
end;

procedure TFrmServer.Timer1Timer(Sender: TObject);
var
  Str:Array [1..22] of Char;
  date:string;
  i,m:integer;
begin
date:=formatdatetime('yyyy-mm-dd hh:mm:ss',now)+Edit1.Text;
For i:=1 to length(date) do
  Str[i]:=Date[i];
For m:=i to 22 Do
  Str[m]:=' ';
For i:=0 to ListBox1.Items.Count-1 Do
  Begin
  NMUDP1.RemoteHost:=Trim(Copy(ListBox1.Items.Strings[i],4,15));
  NMUDP1.SendBuffer(Str,22);
  End;
end;

procedure TFrmServer.FormCreate(Sender: TObject);
Var
   MyRegist:TRegistry;
   zclj:string;
   nid:TNotifyIconData;
begin
MyRegist:=TRegistry.Create;
zclj:='\software\microsoft\windows\currentversion\Run';
MyRegist:=tregistry.Create;
MyRegist.RootKey:=hkey_local_machine;
MyRegist.OpenKey(zclj,False);
MyRegist.writeString('Moniter',application.ExeName);
MyRegist.Free;
LocalIp:=GetLocalIP;
ExePath:=extractfiledir(application.exename);
if length(ExePath)=3 then
  delete(ExePath,3,1);
nid.cbSize:=sizeof(nid);
nid.Wnd:=Handle;
nid.uID:=0;
nid.hIcon:=Application.Icon.Handle;
nid.szTip:='局域网通讯_监控端';
nid.uCallbackMessage:=MY_MESSAGE;
nid.uFlags:=NIF_ICON or NIF_TIP or NIF_MESSAGE;
if not Shell_NotifyIcon(NIM_ADD, @nid) then
  begin
  ShowMessage('失败！');
  Application.Terminate;
  end;
SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
end;

procedure TFrmServer.BitBtn2Click(Sender: TObject);
var ini:TIniFile;
begin
Ini:=TIniFile.Create(ExePath+'\TimeParam.ini');
ini.WriteString('TimeParam','InterTime',edit2.Text);
ini.WriteString('TimeParam','Delaytime',edit1.Text);
ini.Free;
If BitBtn2.Caption='结束连接' Then
  If application.MessageBox('当结束连接后，客户端计'+#10#13+
                            '算机将全部显示断网状态'+#10#13+#10#13+
                            '    是否结束连接？    '
                            ,'提示',mb_yesno+mb_iconquestion+MB_DEFBUTTON2)=Id_no Then
    Exit;
Timer1.Interval:=strtoint(edit2.Text)*1000;
Timer1.Enabled:=Timer1.Enabled=False;
If Timer1.Enabled then
  BitBtn2.Caption:='结束连接'
Else
  BitBtn2.Caption:='开通连接';
end;

procedure TFrmServer.NMUDP1DataReceived(Sender: TComponent;
  NumberBytes: Integer; FromIP: String; Port: Integer);
var
  C:array [1..100] of Char;
  str:string;
  I:Integer;
begin
NMUDP1.ReadBuffer(C,I);
str:=c;
If (copy(Str,1,1)<>'A') And (copy(Str,1,1)<>'D') Then
  Exit;
If copy(Str,1,1)='A' Then
  AddIp(trim(copy(str,2,99)));
If copy(Str,1,1)='D' Then
  DelIp(trim(copy(str,2,99)));
Timer1Timer(Self);
end;

procedure TFrmServer.BitBtn1Click(Sender: TObject);
begin
Hide;
end;

procedure TFrmServer.FormClose(Sender: TObject; var Action: TCloseAction);
var ini:TIniFile;
nid:TNotifyIconData;
begin
If application.MessageBox('当关闭监控端后客户端计'+#10#13+
                          '算机将全部显示断网状态'+#10#13+#10#13+
                          '    是否关闭监控端？  '
                          ,'提示',mb_yesno+mb_iconquestion+MB_DEFBUTTON2)=Id_no Then
    Abort;
Ini:=TIniFile.Create(ExePath+'\TimeParam.ini');
ini.WriteString('TimeParam','InterTime',edit2.Text);
ini.WriteString('TimeParam','Delaytime',edit1.Text);
ini.Free;
nid.cbSize:=sizeof(nid);
nid.uID:=0;
nid.Wnd:=Handle;
Shell_NotifyIcon(NIM_DELETE,@nid);
Action:=cafree;
end;

procedure TFrmServer.FormShow(Sender: TObject);
var ini:TIniFile;
begin
Ini:=TIniFile.Create(ExePath+'\TimeParam.ini');
UpDown1.Position:=strtoint(ini.ReadString('TimeParam','InterTime','3'));
UpDown2.Position:=strtoint(ini.ReadString('TimeParam','Delaytime','5'));
Ini.Free;
end;

procedure TFrmServer.N1Click(Sender: TObject);
begin
show;
end;

procedure TFrmServer.N2Click(Sender: TObject);
begin
close;
end;

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

end.