用UDP实现的局域网聊天程序源代码(1分)

program udpChat;

uses
Forms,
UnitUDPchat in 'UnitUDPchat.pas' {frmChat};

{$R *.RES}

begin
Application.Initialize;
Application.Title := '局域网通信程序－UDP';
Application.CreateForm(TfrmChat, frmChat);
Application.Run;

//************************************************************************

unit UnitUDPchat;
{=====================================================================================}
{协议说明： }
{New:新客户登录：程序启动时发送给网段中的所有用户：'New'+用户名（可以用机器名）； }
{Hiu:客户返回的确认信息：当收到其它用户发送来的登录信息进行确认； }
{Msg:发送消息：一个用户发送给另一个用户的消息：'Msg'+'='+消息的长度+'+'+消息的内容； }
{Bye:用户退出：程序关闭时发送给列表中的所有用户：'Bye'+用户名（可以用机器名）； }
{=====================================================================================}

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, CoolTrayIcon, ComCtrls, NMUDP, Menus, ScktComp, MmSystem,
Registry, Psock;

const msghead='NewHiuMsgBye';

type
TfrmChat = class(TForm)
Panel1: TPanel;
Panel2: TPanel;
Panel3: TPanel;
Panel4: TPanel;
Panel5: TPanel;
Panel6: TPanel;

PopupMenu1: TPopupMenu;
itemShowHide: TMenuItem;
Separator1: TMenuItem;
itemAbout: TMenuItem;
Separator2: TMenuItem;
itemClose: TMenuItem;

lbClientList: TListBox;
cbClientList: TComboBox;
edtMessage: TEdit;
memClient: TRichEdit;
btnSend: TButton;

StatusBar1: TStatusBar;
Splitter1: TSplitter;
Label1: TLabel;
TimerShowTime: TTimer;
UDP: TNMUDP;
TrayIcon: TCoolTrayIcon;
Powersock: TPowersock;

procedure FormCreate(Sender: TObject);
procedure TrayIconClick(Sender: TObject);
procedure itemCloseClick(Sender: TObject);
procedure edtMessageChange(Sender: TObject);
procedure btnSendClick(Sender: TObject);
procedure TimerShowTimeTimer(Sender: TObject);
procedure FormHide(Sender: TObject);
procedure UDPStatus(Sender: TComponent; status: String);
procedure UDPDataSend(Sender: TObject);
procedure UDPDataReceived(Sender: TComponent; NumberBytes: Integer;
FromIP: String; Port: Integer);
procedure FormDestroy(Sender: TObject);
procedure edtMessageKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
private
{ Private declarations }
procedure BroadCastMsg(Msg:string); //向本机所在网段的所有用户发送消息
procedure InsertStartUp; //将程序加入启动组；
function GetLocalName:string; //获取计算机名；
public
{ Public declarations }
end;

var
frmChat: TfrmChat;
FormShow:Boolean; //是否显示窗口
ClientAddressList, ClientNameList:Tstrings;
//用户列表、用户IP地址列表、用户名列表
ClientAddress, ClientName:string; //用户地址及用户名
ComputerName:string; //机器名
msg:string; //发送和接收的消息
msgStream: TMemoryStream;
StartPos, SelLen:integer;
implementation

{$R *.DFM}

procedure TfrmChat.BroadCastMsg(Msg:string); //向本机所在网段的所有用户发送消息
var LocalMachineIP, Netid, DestIP:string;
i, IPlen:integer;
begin
//获取本机IP和所在网段
LocalMachineIP:=Powersock.LocalIP;
IPlen:=Length(LocalMachineIP);
setLength(Netid, IPlen);
for i:=1 to IPlen do Netid:=LocalMachineIP[IPlen-i+1];
i:=Pos('.', Netid);
Netid:= Copy(LocalMachineIP, 1, IPlen-i+1);
//向网段的所有用户发送指定的消息
msgStream := TMemoryStream.Create;
try
msgStream.Write(Msg[1], Length(Msg));
for i:=0 to 255 do
begin
DestIP:=Netid+IntToStr(i);
if DestIP<>LocalMachineIP then
begin
UDP.RemoteHost:=DestIP;
UDP.SendStream(msgStream);
end;
end;
finally
msgStream.Free;
end;
end;

procedure TfrmChat.InsertStartUp; //将程序加入启动组；
var Reg: TRegistry;
begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
if Reg.OpenKey('/Software/Microsoft/Windows/CurrentVersion/Run', True)
then Reg.WriteString('UdpChat',ParamStr(0));
finally
Reg.CloseKey;
Reg.Free;
inherited;
end;
end;

function TfrmChat.GetLocalName:string; //获取计算机名；
var
sz:dword;
cnchar;
begin
//取得计算机名
GetMem(cn, 100);
sz:=100;
GetComputerName(cn, sz);
Result:=Trim(string(cn));
FreeMem(cn);
end;


procedure TfrmChat.FormCreate(Sender: TObject);
begin
//将程序加入系统的启动组
InsertStartUp;
//设置系统托盘图标
TrayIcon.Icon:=Application.Icon;
//获取计算机名；
ComputerName:=GetLocalName;
//消息显示框参数初始化
StartPos:=0;
SelLen:=0;

//窗口状态初始化
FormShow:=False; //窗口隐藏
StatusBar1.Panels[1].Text:=DateTimeToStr(Now()); //显示日期、时间

//UDP工作方式
UDP.ReportLevel := Status_Basic;

//列表变量初始化
ClientAddressList:=TStringList.Create;
ClientNameList:=TStringList.Create;

//向列表中的所有用户发送登录消息
msg:='New'+ComputerName;
BroadCastMsg(msg);
end;

procedure TfrmChat.TrayIconClick(Sender: TObject);//隐藏或显示窗口
begin
FormShow:=not FormShow;
if FormShow then frmChat.Show else frmChat.Hide;
end;

procedure TfrmChat.itemCloseClick(Sender: TObject); //系统关闭
begin
Application.Terminate;
end;

procedure TfrmChat.edtMessageChange(Sender: TObject); //改变发送按钮的使能状态
begin
btnSend.Enabled :=(edtMessage.Text<>'') and (cbClientList.Text<>'');
end;

procedure TfrmChat.btnSendClick(Sender: TObject);//发送消息给指定用户
begin
ClientName:=cbClientList.Text;
msg:='Msg'+'=' + IntToStr(Length(edtMessage.Text)) + '+' + edtMessage.Text;
ClientAddress:=ClientAddressList.Strings[ClientNameList.IndexOf(ClientName)];
UDP.RemoteHost:=ClientAddress;
//发送
msgStream := TMemoryStream.Create;
try
msgStream.Write(msg[1], Length(msg));
UDP.SendStream(msgStream);
finally
msgStream.Free;
end;
//显示
msg:='To '+ ClientName+': '+ edtMessage.Text;
memClient.Lines.Add(msg);
memClient.SelStart:=StartPos;
memClient.SelLength:=Length(msg);
memClient.SelAttributes.Color:=clred;
//在文本框中显示发送的消息并设置字符的颜色
StartPos:=StartPos+Length(msg)+2;
edtMessage.Text:='';
edtMessage.SetFocus;
end;

procedure TfrmChat.TimerShowTimeTimer(Sender: TObject); //在状态栏中显示当前时间
begin
StatusBar1.Panels[1].text:=DateTimeToStr(Now());
end;

procedure TfrmChat.FormHide(Sender: TObject); //隐藏窗体
begin
FormShow:=False;
end;

procedure TfrmChat.UDPStatus(Sender: TComponent; status: String);
begin
If StatusBar1 <> nil then
StatusBar1.SimpleText := status;
end;

procedure TfrmChat.UDPDataSend(Sender: TObject);
begin
StatusBar1.SimpleText := '消息已经发送';
end;

procedure TfrmChat.UDPDataReceived(Sender: TComponent; //接收消息的处理
NumberBytes: Integer; FromIP: String; Port: Integer);
var
C: array[1..2048] of Char;
begin
if NumberBytes <= 2048
then begin
UDP.ReadBuffer(C, NumberBytes);
msg:=Trim(string(C));
case pos(copy(msg, 1, 3), msghead) of
1:begin //New:新客户登录
ClientAddress:=FromIP;
ClientName:=Copy(msg, 4, Length(msg)-3);
StatusBar1.Panels[0].Text:='好友 '+ ClientName + ' 上线啦！';
PlaySound('Global.wav', 0, SND_ASYNC);
if ClientAddressList.IndexOf(ClientAddress)= -1
then begin
ClientAddressList.Add(ClientAddress);
ClientNameList.Add(ClientName);
end;
cbClientList.Items.Add(ClientName);
lbClientList.Items.Add(ClientName +'('+ ClientAddress+')');
msg:='Hiu'+ComputerName; //返回响应消息
msgStream := TMemoryStream.Create;
try
msgStream.Write(msg[1], Length(msg));
UDP.RemoteHost:=ClientAddress;
UDP.SendStream(msgStream);
finally
msgStream.Free;
end;
end; //case 1
4:begin //Hiu:客户响应
ClientAddress:=FromIP;
ClientName:=Copy(msg, 4, Length(msg)-3);
StatusBar1.Panels[0].Text:='接收到 '+ ClientName + ' 发送来的消息';
if ClientAddressList.IndexOf(ClientAddress)= -1
then begin
ClientAddressList.Add(ClientAddress);
ClientNameList.Add(ClientName);
end;
cbClientList.Items.Add(ClientName);
lbClientList.Items.Add(ClientName +'('+ClientAddress+')');
end;
7:begin //Msg:正常消息
if FormShow=False
then begin
FormShow:=True;
frmChat.Show;
end;
PlaySound('msg.wav', 0, SND_ASYNC);
ClientAddress:=FromIP;
ClientName:=ClientNameList.Strings[ClientAddressList.IndexOf(ClientAddress)];
msg:='From '+ClientName+': '
+Copy(msg, pos('+', msg)+1, length(msg)-pos('+', msg));
memClient.Lines.Add(msg);
memClient.SelStart:=StartPos;
memClient.SelLength:=Length(msg);
memClient.SelAttributes.Color:=clBlue; //设置插入字符的颜色
StartPos:=StartPos+Length(msg)+2;
edtMessage.SetFocus;
end; //case 7
10:begin //Bye:客户退出
ClientAddress:=FromIP;
ClientName:=ClientNameList.Strings[ClientAddressList.IndexOf(ClientAddress)];
cbClientList.Items.Delete(cbClientList.Items.IndexOf(ClientName));
lbClientList.Items.Delete(lbClientList.Items.IndexOf(ClientName+'('+ ClientAddress+')'));
end; //cse 10
else begin //其它
StatusBar1.Panels[0].Text:='您接收错误消息';
end; //else
end; //case
end //if
end; //UDP2DataReceived

procedure TfrmChat.FormDestroy(Sender: TObject);
begin
//向其他用户道别
msg:='Bye'+ComputerName;
BroadCastMsg(msg);

ClientAddressList.Free;
ClientNameList.Free;
end;

procedure TfrmChat.edtMessageKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key=VK_Return
then if cbClientList.Text<>''
then btnSend.Click
else ShowMessage('请选择好友名称！');
end;

end.

上面的程序是本人在前一段写的，写程序的过程中发现一个问题：
按照协议解释，UDP是无连接的，即发送后就不管了，在调试程序时发现如下问题：
当接受方机器未运行通信程序时，接受方的操作系统会自动返回一个消息，触发本地程序的NMUDP1DataReceived事件，
在接收事件中，当用ReadStream方法读取信息时，程序报错“write Stream Error”，
当用ReadBuffer方法读取信息时，程序可以正常运行，但是读取到信息是一些乱码（由对方的系统返回的），
当程序给自己的机器发送信息时，收到的信息后面也会多出一些乱码，
请问为什么会出现这种情况？怎样捕获对方操作系统返回的信息？

看完后请帮忙提前。3x

好象遇到过
当时记得是把收发端口设成不一样的就解决了

gz

可以这样解决
虽然不是解决了根本问题，治标不治本
用两个udp控件，一个用来收，一个用来发的，
发送upd的发送端口比如说用1234，接受端口就用另外一个（反正是没用的），比如4321
接受udp的接收端口用1234，发送端口用其他的，
这样你发送udp发送的东西是另外一个udp控件接收的，如果对方地址不对或者没有启动
程序的话，是不会出错的。

哈哈，我也是做了个这种模型，没问题啊！我就是用ReadStream做的，我
直接用stringstream
程序片断：
ss:= Tstringstream.Create(packetcontent);
try
udpme.RemoteHost:= objectIP;
udpme.RemotePort:= CONTACTPORT;
udpme.SendStream(ss);
finally
ss.Free;
end;
你在上线广播的时候，假如某台机子也在开住，但它没装你的东东，是会返回一个空数据包
的，里面只包含其本机的一些信息，如IP这些，你收到的话就只是一个空串了

gz

意外触发的ONRECEIVE事件，NumberBytes应该为0，你点都不用怕

不过NMUDP还有许多致命的弱点，不要用它

用INDY的UDP控件，很不错

要是某个用户掉线了或死机，重启，你怎么检测他在不在线？

finish

finish