DONGSHENG6/系统服务器/new/Unit1.pas

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, StdCtrls, RXShell, AppEvnts,Winsock, NMUDP, Menus,ShellApi;

const
  HeaderLen=6;
  IPLen    =15;
  
type
  TMainForm = class(TForm)
    NMUDP: TNMUDP;
    TrayIcon: TRxTrayIcon;
    ApplicationEvents1: TApplicationEvents;
    MainMenu1: TMainMenu;
    NetICQ1: TMenuItem;
    LoginItem: TMenuItem;
    LogoutItem: TMenuItem;
    N7: TMenuItem;
    ChatRoomItem: TMenuItem;
    N1: TMenuItem;
    AutoPopupItem: TMenuItem;
    N10: TMenuItem;
    N8: TMenuItem;
    N12: TMenuItem;
    N14: TMenuItem;
    PopupMenu: TPopupMenu;
    PLoginItem: TMenuItem;
    PLogoutItem: TMenuItem;
    N9: TMenuItem;
    PChatRoomItem: TMenuItem;
    N13: TMenuItem;
    PAutoPopupItem: TMenuItem;
    N16: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    GroupBox1: TGroupBox;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    LocalIP:      String;
    BroadCastIP:  String;
    ComputerName: String;
    MsgStream:    TMemoryStream;
    UserList:     TStringList;
    function  GetLocalIP:String;
    function  GetComputerNameByIP(const IP:String):String;
    procedure SetBroadCastIp;
    function  FindIP(const IP:String):Integer;
    procedure AddUser(const IP,UserName:string);
    procedure DelUser(const IP:String);
    procedure IniMsgStream;
    procedure SendMsg(const IP,Msg:String);
    procedure SendLoginMsg(const IP:String);
    procedure SendLogoutMsg;

    procedure ReceivedLoginMsg(const FromIP,Msg:String); //ÊÕµ½Á˵ǼÐÅÏ¢
    procedure ReceivedLogoutMsg(const FromIP:String);
    procedure ReceivedMsg(const FromIP,Msg:String);
    
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

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;

function TMainForm.GetComputerNameByIP(const IP: String): String;
//ͨ¹ýIP»ñµÃ»úÆ÷Ãû
var
  i:Integer;
  ts:String;
begin
  Result:='';
  i:=FindIP(IP);
  if i>=0 then
  begin
    ts:=UserList.Strings[i];
    Result:=Copy(ts,IPLen+1,Length(ts)-IPLen);
  end;
end;

procedure TMainForm.SetBroadCastIp;
var
  i,j,iHead:Integer;
  sHead,s:String;
  ai:array [1..3] of integer;
begin
{1~126.255.255.255  (AÀàÍø¹ã²¥µØÖ·£©
128~191.XXX.255.255 (BÀàÍø¹ã²¥µØÖ·£©
192~254.XXX.XXX.255 (CÀàÍø¹ã²¥µØÖ·£©}
  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  //AÀàÍø
  begin
    BroadCastIP:=sHead+'.255.255.255';
  end
  else
  begin
    if iHead<192 then //BÀàÍø
    begin
      s:=Copy(LocalIP,1,ai[2]-1);
      BroadCastIP:=s+'.255.255';
    end
    else  //CÀàÍø
    begin
      s:=Copy(LocalIP,1,ai[3]-1);
      BroadCastIP:=s+'.255';
    end;
  end;
end;

function TMainForm.FindIP(const IP: 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=IP then
    begin
      Result:=i;
      exit;
    end;
  end;
end;

procedure TMainForm.AddUser(const IP, UserName: string);
//½«IpºÍUserName¼ÓÈëUserListÖÐ
var
  s:String;
begin
  s:=Trim(Format('%-15s%-255s',[IP,UserName]));
  UserList.Add(s);
  //UserListBox.Items.Add(UserName);
end;

procedure TMainForm.DelUser(const IP: String);
//¸ù¾ÝIPÀ´É¾³ýÓû§
var
  i:Integer;
begin
  i:=FindIp(IP);
  if i>=0 then
  begin
    UserList.Delete(i);
    //UserListBox.Items.Delete(i);
  end;
end;

procedure TMainForm.IniMsgStream;
//³õʼ»¯MsgStream;
begin
  MsgStream.Position:=0;
  MsgStream.Size:=0;
end;

procedure TMainForm.SendMsg(const IP, Msg: String);
//ÏòIP·¢ËÍÐÅÏ¢
begin
  IniMsgStream;
  MsgStream.Write(Msg[1],Length(Msg));
  NMUDP.RemoteHost:=IP;
  NMUDP.SendStream(MsgStream);
end;

procedure TMainForm.SendLoginMsg(const IP:String);
//Æô¶¯UDP£¬ÔÚ¾ÖÓòÍøÖз¢¹ã²¥
var
  Msg:String;
begin
  Msg:=Format('%-15s%-6s%-255s',[LocalIP,'Login',ComputerName]);
  Msg:=Trim(Msg);
  SendMsg(IP,Msg);
end;

procedure TMainForm.SendLogoutMsg;
//Í˳öUDP£¬·¢¹ã²¥
var
  Msg:String;
begin
  UserList.Clear;
  Msg:=Format('%-15s%-6s',[LocalIp,'Logout']);
  SendMsg(BroadCastIp,Msg);
end;

procedure TMainForm.ReceivedLoginMsg(const FromIP,Msg:String);
//½ÓÊÕµ½Á˵ǼÐÅÏ¢
var
  RemoteComputerName:String;
begin
  if FindIP(FromIP)=-1 then
  begin
    RemoteComputerName:=Msg;
    AddUser(FromIP,RemoteComputerName);
    SendLoginMsg(FromIP);
  end;
end;

procedure TMainForm.ReceivedLogoutMsg(const FromIP:String);
//½ÓÊÕµ½ÁËÍ˳öÐÅÏ¢
begin
  DelUser(FromIP);
end;

procedure TMainForm.ReceivedMsg(const FromIP,Msg:String);
//½ÓÊÕµ½Á˸öÈ˵ÄÁÄÌìÐÅÏ¢
begin
  if FromIP=LocalIP then  //×Ô¼º²»Ó¦¸Ã¸ø×Ô¼º·¢ÐÅÏ¢°É :)
    exit; 
end;

procedure TMainForm.FormCreate(Sender: TObject);
var
  pComputerName:PChar;
  ComputerNameLen:DWORD;
  i:Integer;
  TempItem:TMenuItem;
begin
  Application.HintShortPause:=0;

  MsgStream:=TMemoryStream.Create;
  UserList:=TStringList.Create;
  ComputerNameLen:=255;
  GetMem(pComputerName,ComputerNameLen);
  try
    if not GetComputerName(pComputerName,ComputerNameLen) then
      pComputerName:='ÎÞÃûÊÏ';
    ComputerName:=String(PComputerName);
  finally
    FreeMem(pComputerName);
  end;
  LocalIp:=GetLocalIP;
  SetBroadCastIP;
end;

end.