clientpas.~pas

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

unit ClientPas;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, NMUDP, ExtCtrls, StdCtrls, Winsock, Buttons;

type
  TFrmClient = class(TForm)
    NMUDP1: TNMUDP;
    Timer1: TTimer;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Edit1: TEdit;
    Label5: TLabel;
    Edit2: TEdit;
    Label6: TLabel;
    Edit4: TEdit;
    Timer2: TTimer;
    procedure NMUDP1DataReceived(Sender: TComponent; NumberBytes: Integer;
      FromIP: String; Port: Integer);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
  Timer:Integer;
  LocalIp,ComputerName:string;
    { Public declarations }
  end;

var
  FrmClient: TFrmClient;
  function GetLocalIP:String;
  function Getcomputname:string;

implementation

{$R *.dfm}

function Getcomputname:string;
var computname:array[0..30] of char;
  size:dword;
begin
size:=sizeof(computname);
FillChar(computname,Size, ' ');
getcomputername(computname,size);
result:=UpperCase(trim(computname));  
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 TFrmClient.FormCreate(Sender: TObject);
begin
LocalIp:=Trim(GetLocalIP);
ComputerName:=Trim(GetComputName);
Edit4.Text:=LocalIp;
end;

procedure TFrmClient.NMUDP1DataReceived(Sender: TComponent;
  NumberBytes: Integer; FromIP: String; Port: Integer);
var
  Str:array [1..22] of Char;
  I:Integer;
begin
If FromIp=LocalIp Then
  exit;
NMUDP1.ReadBuffer(Str,I);
Label2.Caption:=Copy(Trim(str),1,19);
Edit1.Text:=Trim(Copy(str,20,3)); IF Trim(Edit1.Text)='' Then Edit1.Text:='3';
If NumberBytes=22 Then
  Begin
  Timer:=0;
  Label1.Caption:='联网';
  End
Else
  Label1.Caption:='断网';
end;

procedure TFrmClient.Timer1Timer(Sender: TObject);
begin
Timer:=Timer+1;
If Timer>strtoint(edit1.Text) Then
  Label1.Caption:='断网';
end;


procedure TFrmClient.Timer2Timer(Sender: TObject);
var
  Str:Array [1..100] of Char;
  SendStr:string;
  i,m:integer;
begin
If (Trim(Edit2.Text)='') or (Label1.Caption='联网') Then
  exit;
SendStr:=LocalIp;
For i:=length(Sendstr) to 14 Do
  SendStr:=SendStr+' ';
SendStr:='AIP:'+SendStr+' CpName:'+ComputerName;
For I:=1 to length(SendStr) Do
  Str[i]:=SendStr[i];
For M:=i to 100 Do
  Str[m]:=' ';
NMUDP1.RemoteHost:=Edit2.Text;
Try NMUDP1.SendBuffer(Str,100); Except End; 
end;

procedure TFrmClient.FormClose(Sender: TObject; var Action: TCloseAction);
var
  Str:Array [1..100] of Char;
  SendStr:string;
  i,m:integer;
begin
SendStr:=LocalIp;
For i:=length(Sendstr) to 14 Do
  SendStr:=SendStr+' ';
SendStr:='DIP:'+SendStr+' CpName:'+ComputerName;
For I:=1 to length(SendStr) Do
  Str[i]:=SendStr[i];
For M:=i to 100 Do
  Str[m]:=' ';
NMUDP1.RemoteHost:=Edit2.Text;
Try NMUDP1.SendBuffer(Str,100); Except End;
sleep(100);
action:=cafree;
end;

end.