高分求购聊天室源程序(最好是用delphi编写的!)(200分)





Internet盛行的今天,网上聊天已成为一种时尚。同时,各单位已建成了自己的局域网;能否在局域网上实现聊天呢?可以,网上到处都有这种工具。当然,我们可以拥有自己版权的聊天工具。

  User Datagram Protocol (UDP)协议,是一种无连接协议。在Delphi中利用这种协议,可以轻松的编写出聊天程序,以下的程序,在Delphi 5+Pwin98中通过。

  打开Delphi,新建Application

放置以下几个控件:Panel1、Panel2,其属性如下:







  然后,放置以下控件:Edit1

ListBox1

Memo1

Button1

Button2

BitBtn1

Nmudp1其主要控件的属性如下:







  各主要控件的功能如下:







现在的界面如下:











源程序如下:





unit main;





interface





uses





Windows

Messages

SysUtils

Classes

Graphics

Controls

Forms

Dialogs







StdCtrls

Buttons

ExtCtrls

NMUDP

Menus

ComCtrls

WinSock; file://增加WinSock





type





TForm1 = class(TForm)





NMUDP1: TNMUDP;





Panel1: TPanel;





Panel2: TPanel;





Label1: TLabel;





Edit1: TEdit;





BitBtn1: TBitBtn;





Memo1: TMemo;





Panel3: TPanel;





Panel4: TPanel;





ListBox1: TListBox;





Button1: TButton;





Button2: TButton;





procedure FormShow(Sender: TObject);





procedure BitBtn1Click(Sender: TObject);





procedure NMUDP1DataReceived(Sender: TComponent; NumberBytes: Integer;


FromIP: String; Port: Integer);





procedure Edit1KeyPress(Sender: TObject; var Key: Char);





procedure Button1Click(Sender: TObject);





procedure Button2Click(Sender: TObject);





private





{ Private declarations }





public





{ Public declarations }





end;





var





Form1: TForm1;





ComputerName: array[0..127] of Char;





implementation





{$R *.DFM}





procedure TForm1.FormShow(Sender: TObject);





var





sz: dword;





begin





sz := SizeOf(Computername);





GetComputerName(ComputerName

sz);//得到本机的标识





ListBox1.Items.Clear;





ListBox1.Items.Add('大家');//在网友清单中,增加"大家"和





ListBox1.Items.Add(ComputerName);//本机名称





ListBox1.ItemIndex:=0;





end;





procedure TForm1.BitBtn1Click(Sender: TObject);





var





MyStream: TMemoryStream;





TmpStr: String;





i:integer;





Begin





if Edit1.Text<>'' then file://如果所说的内容不为空

则发送。





begin





NMUDP1.ReportLevel := Status_Basic;





NMUDP1.RemotePort :=8888;//端口为:8888,可以自己定义,但必须与LocalPort相一致。





if ListBox1.Items[ListBox1.ItemIndex]=ComputerName then





Edit1.Text:=ComputerName+'自言自语道:'+Edit1.Text file://如果和自己对话.





Else





Edit1.Text:=ComputerName+'对'+ListBox1.Items[listbox1.itemindex]+'说:'+Edit1.Text;





TmpStr :=Edit1.text;





MyStream := TMemoryStream.Create;





try





MyStream.Write(TmpStr[1]

Length(Edit1.Text));





if ListBox1.ItemIndex=0 then





begin





for i:=1 to ListBox1.Items.Count-1 do file://如果选择"大家",则对所有的网友发送信息





begin





NMUDP1.RemoteHost :=ListBox1.Items;//远程主机的名称或地址.





NMUDP1.SendStream(MyStream);//发送信息.





End;





end





else 如果私聊





begin





NMUDP1.RemoteHost :=ListBox1.Items[ListBox1.itemindex]; file://仅对所选中的网友.





NMUDP1.SendStream(MyStream);





End;





finally





MyStream.Free;





end;





Edit1.Text:='';





Edit1.SetFocus;





end else





Edit1.SetFocus;





end;


procedure TForm1.NMUDP1DataReceived(Sender: TComponent;





NumberBytes: Integer; FromIP: String; Port: Integer);





var





MyStream: TMemoryStream;





TmpStr: String;





begin





MyStream := TMemoryStream.Create;





try





NMUDP1.ReadStream(MyStream);





SetLength(TmpStr

NumberBytes);





MyStream.Read(TmpStr[1]

NumberBytes);





Memo1.Lines.Add(TmpStr); file://显示对话的内容.





finally





MyStream.Free;





end;





end;





procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);





var





MyStream: TMemoryStream;





TmpStr: String;





i:integer;





Begin





if (key=#13) and (Edit1.Text<>'') then file://如果所说的内容不为空,且最后一个按键为"Enter"

则发送。





begin





NMUDP1.ReportLevel := Status_Basic;





NMUDP1.RemotePort :=8888;





if ListBox1.Items[ListBox1.ItemIndex]=ComputerName then





Edit1.Text:=ComputerName+'自言自语道:'+Edit1.Text





else





Edit1.Text:=ComputerName+'对'+ListBox1.Items[listbox1.itemindex]+'说:'+Edit1.Text;





TmpStr :=Edit1.text;





MyStream := TMemoryStream.Create;





try





MyStream.Write(TmpStr[1]

Length(Edit1.Text));





if ListBox1.ItemIndex=0 then





begin





for i:=1 to ListBox1.Items.Count-1 do





begin





NMUDP1.RemoteHost :=ListBox1.Items;





NMUDP1.SendStream(MyStream);





end;





end





else





begin





NMUDP1.RemoteHost :=ListBox1.Items[ListBox1.itemindex];





NMUDP1.SendStream(MyStream);





end;





finally





MyStream.Free;





end;





Edit1.Text:='';





edit1.SetFocus;





end else





Edit1.SetFocus;





end;





procedure TForm1.Button1Click(Sender: TObject);





var





InputString:String;





begin file://增加网友,输入的可以是IP地址或计算机名称。





InputString:=InputBox('增加人员'

'IP地址或计算机名'

'');





if Inputstring<>'' then ListBox1.Items.Add(Inputstring);





ListBox1.ItemIndex:=0;





end;





procedure TForm1.Button2Click(Sender: TObject);





begin file://删除当前选中的网友,但"大家"不能被删除.





if ListBox1.ItemIndex<>0 then ListBox1.Items.Delete(ListBox1.ItemIndex);







end;





end.








这样,一个简单的聊天工具就做好了,只要双方同时运行本程序,且将对方的计算机名称或IP地址加入到网友中即可实现实时聊天了

一个属于自己版权的聊天程序,就这样编写成功了。


程序运行时,自动加入两个网友:"大家"和本地计算机名称,运行时,界面如下:











当然,你可以增加更多的内容,使程序更加的完善,以求更多的功能。




 
to:luket
怎么上不了那个网站,请发给我一份吧!!
zcm1975117@21cn.com
 
http://www.banasoft.com/AVPhone.htm
 
avphone 干吗?
有没有那个ACTIVEX的零售版本?
 
谢谢哪位可以给我发过来oicq的源代码,那个站好象是上不去


再次感谢!!!
 
我怎么也下摘不了您所提供的原码,能发给我吗。谢谢!
jingwei@goldeastpaper.com.cn
 
给小弟发过来一份吧.xieyj@esquel.com
 
asp的可不可以啊?
 
也给我一份,好不好?ZXW96136@21CN.COM
 
小弟先谢过了!!!
Rainxy2000@163.net
 
想看一下delphi的源码
ironfist777@sina.com.cn
 
无题
你说的聊天程序下载后无法打开 能给我发一份吗 多谢
hathathat@yeah.net
 
这是一个未来高手的请教!!!
给我也来一份吧,万分感谢!!!
liu-yu-2000@sohu.com
 
俺要求用web的方式聊天!
 
[8D]一个使用 AVPhone 的点对点的语音及视频聊天程序源代码:

http://www.banasoft.com/DownLoad/AVPhone.zip
 
楼上:AVPHONE CRACK有伐?SOURCE更好!呵呵...
另外到底有没有人真正找到用DELPHI 实现H.XX的源码啊?或者其它的带源码的?
 
我想要delphi的icq源代码,哪为大虾愿意转让,到我的问题下领分
 
beta,你好,麻烦您给我发一份聊天程序的SOURCE好吗?
 
哪里有啊,没有一个可上地去的!!!!!!!!!!!
 
请传给我一份:
mao_1@163.net
 
顶部