main.pas

这是一款用DELPI设计的聊天工具,可以学学!

//Msg的格式：
//前15位是本机IP地址，虽然FromIP包含了发信息方的IP，但是如果有代理服务器的话，
//这个IP有时是代理服务器的IP；
//16-21是信息标识：
//  'Login' --上线信息
//  'Logout'--离线信息
//  'Broad' --广播信息
//  'Chat'  --聊天信息
//从22位起就是实际信息
unit main;

interface

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

const
  HeaderLen=6;
  IPLen    =15;
  ColorArray: array[0..15] of TColor =
  (clBlack, clMaroon, clGreen, clOlive, clNavy, clPurple, clTeal, clGray,clSilver, clRed, clLime, clYellow, clBlue, clFuchsia, clAqua, clWhite);

type
  TMainForm = class(TForm)
    UserListBox: TListBox;
    StatusBar: TStatusBar;
    TrayIcon: TRxTrayIcon;
    ApplicationEvents1: TApplicationEvents;
    NMUDP: TNMUDP;
    MainMenu1: TMainMenu;
    NetICQ1: TMenuItem;
    LoginItem: TMenuItem;
    LogoutItem: TMenuItem;
    PopupMenu: TPopupMenu;
    PLoginItem: TMenuItem;
    PLogoutItem: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    ChatRoomItem: TMenuItem;
    N10: TMenuItem;
    N9: TMenuItem;
    PChatRoomItem: TMenuItem;
    N12: TMenuItem;
    AutoPopupItem: TMenuItem;
    N14: TMenuItem;
    N13: TMenuItem;
    PAutoPopupItem: TMenuItem;
    N16: TMenuItem;
    N1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure TrayIconDblClick(Sender: TObject);
    procedure ApplicationEvents1Minimize(Sender: TObject);
    procedure ApplicationEvents1Restore(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure NMUDPDataReceived(Sender: TComponent; NumberBytes: Integer;
      FromIP: String; Port: Integer);
    procedure LoginItemClick(Sender: TObject);
    procedure LogoutItemClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure UserListBoxDblClick(Sender: TObject);
    procedure N8Click(Sender: TObject);
    procedure ChatRoomItemClick(Sender: TObject);
    procedure AutoPopupItemClick(Sender: TObject);
    procedure N14Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  LocalIP:      String;
  BroadCastIP:  String;
  ComputerName: String;
  MsgStream:    TMemoryStream;
  UserList:     TStringList;
  Login:        Boolean;  //是否已经登录
  InChatRoom:   Boolean;  //是否在聊天室里
  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);
  function  FindWindowByIP(const IP:String):TReceivedMsgForm;
  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 ReceivedBroadCastMsg(const FromIP,Msg:String);
  procedure ReceivedChatMsg(const FromIP,Msg:String);
  procedure SendInRoomMsg(const IP,NickName:String;const Echo:Boolean);
  procedure SendOutRoomMsg;
  procedure SendChatRoomMsg(const IP,Msg:String);
  procedure ReceivedInRoomMsg(const FromIP,UserName:String);
  procedure ReceivedOutRoomMsg(const FromIP:String);
  procedure ReceivedChatRoomMsg(const FromIP,Msg:String);
  end;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}
uses
  ChatRoomUnit,NickNameUnit;

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
  pComputerName:PChar;
  ComputerNameLen:DWORD;
  i:Integer;
  TempItem:TMenuItem;
begin
Application.HintShortPause:=0;
{PopupMenu.Items.Clear;
for i:=0 to MainMenu1.Items[0].Count-1 do
  begin
  TempItem:=MainMenu1.Items[0].Items[i];
  PopupMenu.Items.Add(TempItem);
  end;}

MsgStream:=TMemoryStream.Create;
UserList:=TStringList.Create;
StatusBar.Panels[0].Width:=Width;
ComputerNameLen:=255;
GetMem(pComputerName,ComputerNameLen);
try
  if not GetComputerName(pComputerName,ComputerNameLen) then
    pComputerName:='无名氏';
  ComputerName:=String(PComputerName);
  StatusBar.Panels[0].Text:=ComputerName+'[离线]';
finally
  FreeMem(pComputerName);
end;
LocalIp:=GetLocalIP;
SetBroadCastIP;
Login:=False;
InChatRoom:=False;
//Login;
end;

procedure TMainForm.TrayIconDblClick(Sender: TObject);
begin
TrayIcon.Hint:='NetICQ V1.0';
Application.Restore;
Application.BringToFront;
end;

procedure TMainForm.ApplicationEvents1Minimize(Sender: TObject);
begin
ShowWindow(Application.Handle,SW_HIDE);
end;

procedure TMainForm.ApplicationEvents1Restore(Sender: TObject);
begin
ShowWindow(Application.Handle,SW_SHOW);
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;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
MsgStream.Free;
UserList.Free;
end;

procedure TMainForm.SendLoginMsg(const IP:String);
//启动UDP，在局域网中发广播
var
  Msg:String;
begin
Login:=True;
Msg:=Format('%-15s%-6s%-255s',[LocalIP,'Login',ComputerName]);
Msg:=Trim(Msg);
SendMsg(IP,Msg);
StatusBar.Panels[0].Text:=ComputerName+'[在线]';
end;

procedure TMainForm.SendLogoutMsg;
//退出UDP，发广播
var
  Msg:String;
begin
Login:=False;
UserListBox.Clear;
UserList.Clear;
Msg:=Format('%-15s%-6s',[LocalIp,'Logout']);
SendMsg(BroadCastIp,Msg);
StatusBar.Panels[0].Text:=ComputerName+'[离线]';
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.NMUDPDataReceived(Sender: TComponent;
  NumberBytes: Integer; FromIP: String; Port: Integer);
var
  Msg,TrueFromIP,Header:String;
begin
if not Login then exit;
IniMsgStream;
NMUDP.ReadStream(MsgStream);
SetLength(Msg,NumberBytes);
MsgStream.Read(Msg[1],NumberBytes);
TrueFromIP:=Trim(Copy(Msg,1,IPLen));
Header:=Trim(Copy(Msg,IPLen+1,HeaderLen));
Msg:=Copy(Msg,IPLen+HeaderLen+1,Length(Msg)-IPLen-HeaderLen);
if (Header='Login')then
  ReceivedLoginMsg(TrueFromIP,Msg);
if (Header='Logout') then
  ReceivedLogoutMsg(TrueFromIP);
if (Header='Broad') then
  ReceivedBroadCastMsg(TrueFromIP,Msg);