mainck.pas

来自「网络控制--在局与网络内控制网络流量,现实等,实现网络的控制及其管理」· PAS 代码 · 共 343 行

unit mainck;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  NMUDP,Winsock, ComCtrls, StdCtrls, Spin, ImgList, Menus, ExtCtrls;

type
  Tmainform = class(TForm)
    NMUDP1: TNMUDP;
    TreeView1: TTreeView;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Label1: TLabel;
    CheckBox1: TCheckBox;
    SpinEdit1: TSpinEdit;
    ImageList1: TImageList;
    edit1: TComboBox;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    Timer1: TTimer;
    Button8: TButton;
    Button9: TButton;
    procedure FormCreate(Sender: TObject);
    procedure NMUDP1DataReceived(Sender: TComponent; NumberBytes: Integer;
      FromIP: String; Port: Integer);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
  private
    { Private declarations }
  public
  ip:string;
  name:string;
  t1:ttreenode;
  userlist:tstringlist;
  msgstream:tmemorystream;
  broadcastip:string;
  ss:string;
  sfj:string;
  function GetLocalIP:String;
  procedure SetIp(localip:string);
  procedure sendlogin;
  function FindIP(const IP1: String): Integer;
  procedure sendmsg;
    { Public declarations }
  end;

var
  mainform: Tmainform;

implementation

{$R *.DFM}
procedure tmainform.sendlogin;
var
msg:string;
begin
Msg:=Format('%-15s%-6s%-2s%-255s',[ip,'login','s',Name]);
Msg:=Trim(Msg);
msgstream.Position:=0;
msgstream.Size:=0;
nmudp1.RemoteHost:=broadcastip;
msgstream.Write(msg[1],length(msg));
nmudp1.SendStream(msgstream);
end;

procedure tmainform.sendmsg;
var
msg:string;
ipss:string;
i:integer;
itime:string;
begin
if checkbox1.Checked then
  itime:=inttostr(spinedit1.Value)
else
  itime:='';
ipss:=treeview1.Selected.Text;
i:=pos('[',ipss);
if i<>0 then
  ipss:=copy(ipss,i+1,length(ipss)-i-1)
else
  ipss:=broadcastip;
if itime<>'' then
  Msg:=Format('%-15s%-6s%-2s%-255s%-100s%-4s',[ip,ss,'s',Name,sfj,itime])
else
  Msg:=Format('%-15s%-6s%-2s%-255s%-100s',[ip,ss,'s',Name,sfj]);
Msg:=Trim(Msg);
msgstream.Position:=0;
msgstream.Size:=0;

nmudp1.RemoteHost:=ipss;
msgstream.Write(msg[1],length(msg));
nmudp1.SendStream(msgstream);

end;


function TMainForm.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 Tmainform.FormCreate(Sender: TObject);
var
pname:pchar;
plen:dword;
begin
plen:=255;
t1:=treeview1.Items.Add(nil,'所有计算机');
msgstream:=tmemorystream.Create;
userlist:=tstringlist.Create;
getmem(pname,plen);
if getcomputername(pname,plen) then
   name:=string(pname)
   else
   name:='no name';
freemem(pname);
ip:=getlocalip;
setip(ip);
sendlogin;
end;

procedure TMainForm.SetIp(localip:string);
var
  i,j,iHead:Integer;
  sHead,s:String;
  ai:array [1..3] of integer;
begin

j:=1;
for i:=0 to Length(LocalIP) do
  begin
  if LocalIP[i]='.' then
    begin
    ai[j]:=i;
    Inc(j);
    end;
  if j>3 then break;
  end;
sHead:=Copy(LocalIp,1,ai[1]-1);
iHead:=StrToInt(sHead);
if iHead<128 then
  begin
  BroadCastIP:=sHead+'.255.255.255';
  end
else
  begin
  if iHead<192 then
    begin
    s:=Copy(LocalIP,1,ai[2]-1);
    BroadCastIP:=s+'.255.255';
    end
  else
    begin
    s:=Copy(LocalIP,1,ai[3]-1);
    BroadCastIP:=s+'.255';
    end;
  end;
end;


function TMainForm.FindIP(const IP1: String): Integer;
var
  i:Integer;
  ts:String;
begin
Result:=-1;
for i:=0 to UserList.Count-1 do
  begin
  ts:=Trim(Copy(UserList.Strings[i],1,15));
  if ts=IP1 then
    begin
    Result:=i;
    exit;
    end;
  end;
end;


procedure Tmainform.NMUDP1DataReceived(Sender: TComponent;
  NumberBytes: Integer; FromIP: String; Port: Integer);
var msg:string; i:integer;
newip,saction,ser_cli,comname:string;
begin
msgstream.Position:=0;
msgstream.Size:=0;
nmudp1.ReadStream(msgstream);
setlength(msg,numberbytes);
msgstream.Read(msg[1],numberbytes);
newip:=trim(copy(msg,1,15));
saction:=trim(copy(msg,16,6));
ser_cli:=trim(copy(msg,22,2));
comname:=trim(copy(msg,24,length(msg)-23));

//if newip=trim(ip) then
//   exit;
if saction='login' then
begin
   if findip(newip)=-1 then
   begin
     userlist.Add(newip);
     treeview1.Items.addchild(t1,comname+'['+newip+']');
   end;
end;
if saction='logout' then
begin
   userlist.Find(newip,i);
   userlist.Delete(i);
   treeview1.Items.delete(treeview1.Items.Item[i+1]);
end;
end;


procedure Tmainform.Button1Click(Sender: TObject);
begin
ss:='wi3';
sfj:='';
sendmsg;

end;

procedure Tmainform.Button2Click(Sender: TObject);
begin
ss:='wi1';
sfj:='';
sendmsg;

end;

procedure Tmainform.Button5Click(Sender: TObject);
begin
ss:='wi4';
sfj:='';
sendmsg;
end;

procedure Tmainform.Button3Click(Sender: TObject);
begin
 ss:='hi';
 sfj:='';
 sendmsg;
end;

procedure Tmainform.Button4Click(Sender: TObject);
begin
ss:='sh';
sfj:='';
 sendmsg;
end;

procedure Tmainform.Button6Click(Sender: TObject);
begin
ss:='ch';
sfj:=edit1.Text;
 sendmsg;
end;

procedure Tmainform.Button7Click(Sender: TObject);
begin
ss:='ex';
sfj:=edit1.Text;
 sendmsg;
end;

procedure Tmainform.CheckBox1Click(Sender: TObject);
begin
spinedit1.Enabled:=checkbox1.Checked;
end;

procedure Tmainform.N1Click(Sender: TObject);
begin
userlist.Clear;
treeview1.Items.Clear;
t1:=treeview1.Items.Add(nil,'所有计算机');
sendlogin;
end;

procedure Tmainform.Timer1Timer(Sender: TObject);
begin
userlist.Clear;
treeview1.Items.Clear;
t1:=treeview1.Items.Add(nil,'所有计算机');
sendlogin;
end;

procedure Tmainform.Button8Click(Sender: TObject);
begin
ss:='no';
sfj:='';
sendmsg;
end;

procedure Tmainform.Button9Click(Sender: TObject);
begin
ss:='ye';
sfj:='';
sendmsg;
end;

end.