有关实现 局域网文字聊天、语音聊天、文件传输的源代码

用到BusinessSkin.
//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, AppEvnts,Winsock, NMUDP, Menus,ReceivedUnit,ShellApi,
  BusinessSkinForm, bsSkinCtrls, bsSkinBoxCtrls, bsSkinMenus, bsTrayIcon,
  bsSkinData;

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)
    NMUDP: TNMUDP;
    bsBusinessSkinForm1: TbsBusinessSkinForm;
    UserListBox: TbsSkinListBox;
    StatusBar: TbsSkinStatusBar;
    bsTrayIcon1: TbsTrayIcon;
    Popup: TbsSkinPopupMenu;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    p1: TLabel;
    bsStoredSkin1: TbsStoredSkin;
    bsSkinData1: TbsSkinData;
    N1: TMenuItem;
    N2: TMenuItem;
    N8: TMenuItem;
    N10: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    N13: TMenuItem;
    procedure FormCreate(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 N8Click(Sender: TObject);
    procedure AutoPopupItemClick(Sender: TObject);
    procedure N14Click(Sender: TObject);
    procedure mniExitClick(Sender: TObject);
    procedure UserListBoxListBoxDblClick(Sender: TObject);
    procedure N13Click(Sender: TObject);
    procedure N11Click(Sender: TObject);
    procedure N12Click(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}
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;
ComputerNameLen:=255;
GetMem(pComputerName,ComputerNameLen);
try
  if not GetComputerName(pComputerName,ComputerNameLen) then
    pComputerName:='无名氏';
  ComputerName:=String(PComputerName);
  //p1.Caption:=ComputerName+'[离线]';
  p1.Color:=clRed;
finally
  FreeMem(pComputerName);
end;
LocalIp:=GetLocalIP;
SetBroadCastIP;
Login:=False;
InChatRoom:=False;
StatusBar.Height:=6;
SendLoginMsg(BroadCastIP);
//Login;
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);
//p1.Caption:=ComputerName+'[在线]';
p1.Color:=clGreen;
end;

procedure TMainForm.SendLogoutMsg;
//退出UDP，发广播
var
  Msg:String;
begin
Login:=False;
UserListBox.Clear;
UserList.Clear;
Msg:=Format('%-15s%-6s',[LocalIp,'Logout']);
SendMsg(BroadCastIp,Msg);
//p1.Caption:=ComputerName+'[离线]';
p1.Color:=clRed;
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);
if (Header='Chat') then
  ReceivedChatMsg(TrueFromIP,Msg);
end;

procedure TMainForm.LoginItemClick(Sender: TObject);
begin
SendLoginMsg(BroadCastIP);
end;

procedure TMainForm.ReceivedBroadCastMsg(const FromIP,Msg:String);
//接收到了广播信息，用于聊天室
//头信息
//1、'InRoom':进入房间
//2、'OtRoom':出房间
//3、'ChatMg':聊天信息
var
  Header:String;
begin
if not InChatRoom then exit;
Header:=Copy(Msg,1,HeaderLen);
if Header='InRoom' then
  begin
  ReceivedInRoomMsg(FromIP,Copy(Msg,HeaderLen+1,Length(Msg)-HeaderLen));
  exit;
  end;
if Header='OtRoom' then
  begin
  ReceivedOutRoomMsg(FromIP);
  exit;
  end;
if Header='ChatMg' then ReceivedChatRoomMsg(FromIP,Copy(Msg,HeaderLen+1,Length(Msg)-HeaderLen));
end;

procedure TMainForm.ReceivedChatMsg(const FromIP,Msg:String);
//接收到了个人的聊天信息
var
  ReceivedMsgForm:TReceivedMsgForm;
begin
  //if FromIP=LocalIP then  //自己不应该给自己发信息吧 :)
  //  exit;
  //ReceivedMsgForm:=FindWindowByIP(FromIP);
  //if ReceivedMsgForm=Nil then
  application.CreateForm(TReceivedMsgForm,ReceivedMsgForm);
  //ReceivedMsgForm:=TReceivedMsgForm.Create(Self);
  ReceivedMsgForm.FromIP:=FromIP;
  with ReceivedMsgForm do
    begin
    RemoteComputerName:=GetComputerNameByIP(FromIP);
    MsgList.Add(Msg);
    //if MsgList.Count>1 then btnNext.Enabled:=True;
    sp2.Visible:=true;
    sp1.Visible:=false;
    Show;
    end;
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.LogoutItemClick(Sender: TObject);
begin
SendLogoutMsg;
end;

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
SendLogoutMsg;
end;

function TMainForm.FindWindowByIP(const IP: String): TReceivedMsgForm;
//按照IP来查找ReceivedMsgForm窗口，如果未找到则返回Nil;
var
  i:Integer;
begin
Result:=Nil;
for i:=0 to Screen.FormCount-1 do
  begin
  if Screen.Forms[i].Caption='消息窗口' then
    begin
    if TReceivedMsgForm(Screen.Forms[i]).FromIP=IP then
      begin
      Result:=TReceivedMsgForm(Screen.Forms[i]);
      exit;
      end;
    end;
  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.N8Click(Sender: TObject);
begin
Close;
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.SendChatRoomMsg(const IP,Msg: String);
//广播聊天消息
var
  s:String;
begin
s:=Format('%-15s%-6s%-6s',[LocalIP,'Broad','ChatMg'])+Msg;
SendMsg(IP,s);
end;

procedure TMainForm.SendInRoomMsg(const IP,NickName: String;const Echo:Boolean);
//广播进入聊天室的信息
var
  Msg:String;
begin
if Echo then
  Msg:=Format('%-15s%-6s%-6s',[LocalIP,'Broad','InRoom'])+'1'+NickName
else
  Msg:=Format('%-15s%-6s%-6s',[LocalIP,'Broad','InRoom'])+'0'+NickName;
SendMsg(IP,Msg);
end;

procedure TMainForm.SendOutRoomMsg;
//广播离开聊天室的信息
var
  Msg:String;
begin
Msg:=Format('%-15s%-6s%-6s',[LocalIP,'Broad','OtRoom']);
SendMsg(BroadCastIP,Msg);
end;

procedure TMainForm.ReceivedChatRoomMsg(const FromIP, Msg: String);
begin

end;

procedure TMainForm.ReceivedInRoomMsg(const FromIP, UserName: String);
begin
end;

procedure TMainForm.ReceivedOutRoomMsg(const FromIP: String);
begin

end;

procedure TMainForm.AutoPopupItemClick(Sender: TObject);
begin
//TMenuItem(Sender).checked:=not TMenuItem(Sender).Checked;
//不知为什么这一句不能对两个菜单项都起作用？？？
//AutoPopupItem.Checked:=not AutoPopupItem.Checked;

end;

procedure TMainForm.N14Click(Sender: TObject);
var
  Icon:Integer;
  Title,Msg:String;
begin
Icon:=LoadIcon(hinstance,'mainicon');
Title:='NetICQ V1.0';
Msg:='开博科技'#13#10'http://www.coerp.com';
ShellAbout(Handle,PChar(Title),PChar(Msg),Icon);
end;

procedure TMainForm.mniExitClick(Sender: TObject);
begin
  close;
end;

procedure TMainForm.UserListBoxListBoxDblClick(Sender: TObject);
var
  i:Integer;
  UserInfo,sFromIP,sRemoteComputerName:String;
  ReceivedMsgForm:TReceivedMsgForm;
begin
  i:=UserListBox.ItemIndex;
  UserInfo:=UserList.Strings[i];
  sFromIP:=Trim(Copy(UserInfo,1,IPLen));
  //if sFromIP=LocalIP then exit;
  sRemoteComputerName:=Copy(UserInfo,IPLen+1,Length(UserInfo)-IPLen);
  //ReceivedMsgForm:=FindWindowByIP(sFromIP);
  //  if ReceivedMsgForm=Nil then
  //  ReceivedMsgForm:=TReceivedMsgForm.Create(Self);
  application.CreateForm(TReceivedMsgForm,ReceivedMsgForm);
  with ReceivedMsgForm do
    begin
    FromIP:=sFromIP;
    RemoteComputerName:=sRemoteComputerName;
    sp1.Visible:=true;
    sp2.Visible:=false;
    Show;
    end;
  end;

procedure TMainForm.N13Click(Sender: TObject);
begin
  N11.Checked:=false;
  N12.Checked:=false;
  N13.Checked:=true;
  MainForm.Align:=alNone;
end;

procedure TMainForm.N11Click(Sender: TObject);
begin
  N11.Checked:=true;
  N12.Checked:=false;
  N13.Checked:=false;
  MainForm.Align:=alRight;
end;

procedure TMainForm.N12Click(Sender: TObject);
begin
  N11.Checked:=false;
  N12.Checked:=true;
  N13.Checked:=false;
  MainForm.Align:=alLeft;
end;

end.
-------------------------------------------------

unit ReceivedUnit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, StdCtrls, ExtCtrls, bsSkinCtrls, BusinessSkinForm,dateutils,
  bsSkinBoxCtrls, bsSkinTabs;

type
  TReceivedMsgForm = class(TForm)
    bsBusinessSkinForm1: TbsBusinessSkinForm;
    sp1: TbsSkinPanel;
    sp2: TbsSkinPanel;
    bsSkinPanel1: TbsSkinPanel;
    btnMsg: TbsSkinButton;
    btnClear: TbsSkinButton;
    btnClose: TbsSkinButton;
    btnSend: TbsSkinButton;
    SendMsgMemo: TbsSkinMemo2;
    bsSkinPanel2: TbsSkinPanel;
    btnCancel: TbsSkinButton;
    btnAnswer: TbsSkinButton;
    ReceivedMsgMemo: TbsSkinMemo2;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure SendMsgMemoKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure btnAnswerClick(Sender: TObject);
    procedure btnClearClick(Sender: TObject);
    procedure btnMsgClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btnCancelClick(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
    procedure btnSendClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    MsgList:TStringList;
    FromIP,RemoteComputerName:String;
    MsgPointer:Integer;
  end;

var
  ReceivedMsgForm: TReceivedMsgForm;

implementation

uses main;

{$R *.DFM}

procedure TReceivedMsgForm.FormCreate(Sender: TObject);
begin
MsgList:=TStringList.Create;
MsgPointer:=0;
end;

procedure TReceivedMsgForm.FormDestroy(Sender: TObject);
begin
MsgList.Free;
end;

procedure TReceivedMsgForm.SendMsgMemoKeyDown(Sender: TObject;
  var Key: Word; Shift: TShiftState);
begin
if (Key=13) and (ssCtrl in Shift) then
  btnSend.Click;
end;

procedure TReceivedMsgForm.btnAnswerClick(Sender: TObject);
begin
    sp1.Visible:=true;
    sp2.Visible:=false;
end;

procedure TReceivedMsgForm.btnClearClick(Sender: TObject);
begin
SendMsgMemo.Clear;
end;

procedure TReceivedMsgForm.btnMsgClick(Sender: TObject);
begin
    sp2.Visible:=true;
    sp1.Visible:=false;
end;

procedure TReceivedMsgForm.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
Action:=caFree;
end;

procedure TReceivedMsgForm.btnCancelClick(Sender: TObject);
begin
Close;
end;

procedure TReceivedMsgForm.btnCloseClick(Sender: TObject);
begin
if MsgPointer>=MsgList.Count-1 then
  Close
else
    sp1.Visible:=true;
    sp2.Visible:=false;
end;

procedure TReceivedMsgForm.btnSendClick(Sender: TObject);
var
  Msg:String;
begin
  with MainForm do
  begin
    Msg:=Format('%-15s%-6s',[LocalIP,'Chat']);
    Msg:=Msg+SendMsgMemo.Text;
    SendMsg(FromIP,Msg);
  end;
  close;
end;

procedure TReceivedMsgForm.FormShow(Sender: TObject);
begin
  sp1.Align:=alClient;
  SendMsgMemo.Align:=alClient;
  sp2.Align:=alClient;
  ReceivedMsgMemo.Align:=alClient;
  ReceivedMsgForm.Caption:='IP：'+FromIP + '   ' + '名称：'+RemoteComputerName;
  if MsgList.Count=0 then
    btnMsg.Enabled:=False
  else
    btnMsg.Enabled:=True;
  try
    ReceivedMsgMemo.Lines.Add('在本机时间' + datetimetostr(now));
    ReceivedMsgMemo.Lines.Add('收到来自计算机'+RemoteComputerName +'（IP:' + FromIP+ '）的消息：');
    ReceivedMsgMemo.Lines.Add('----------------------------------');
    ReceivedMsgMemo.Lines.Add(MsgList.Strings[MsgPointer]);
    ReceivedMsgMemo.Lines.Add('----------------------------------');
  except
  end;
end;
end.