好着急着要用,谢谢,
[email protected]
[email protected]
解决方案 »
- 文件夹建立并命名
- 如何实现从服务器下载文件到客户端啊
- 要做一个旅游公司的管理软件,请大家畅所欲言有什么要注意的地方。学(fansnaf (投币一元) )的。:)
- 菜鸟紧急求救:找不到常量的定义???
- socket通讯时候长连接为什么在无数据包发送的时候要发送连路检测包?
- Windows Media Player 6.4控件 使用方法 希望能抛砖引玉
- SQL存储过程高手们
- 使用客户工具为什么退出ToolUse事件时出错?
- 来!大家一起讨论“关于汉字发音的”程序.....哇!
- 求漂亮的工廠系統界面(或皮膚)
- 关于DBGridEh控件,数据表中数据已删除,但,该控件中还是存在原来数据,没有更新,怎么办啊?
- 怎么办哟?
还用找啊
D6就有两个在INTERNET页的DEMO
在CHAT和NETCHAT目录下
unit main;interfaceuses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,Buttons, NMUDP,StdCtrls, ExtCtrls, Menus, ComCtrls,WinSock;
type
TForm1 = class(TForm)
Label1: TLabel;
Edit1: TEdit;
Label3: TLabel;
Label4: TLabel;
Panel1: TPanel;
Memo1: TMemo;
Panel2: TPanel;
NMUDP1: TNMUDP;
ListBox1: TListBox;
Label2: TLabel;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
BitBtn4: TBitBtn;
BitBtn3: TBitBtn;
Label5: TLabel;
Label6: TLabel;
ComboBox1: TComboBox;
BitBtn5: TBitBtn;
procedure FormShow(Sender: TObject);
procedure BitBtn3Click(Sender: TObject);
procedure NMUDP1DataReceived(Sender: TComponent; NumberBytes: Integer;
FromIP: String; Port: Integer);
procedure Edit1KeyPress(Sender: TObject; var Key: Char);
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure BitBtn4Click(Sender: TObject);
procedure BitBtn5Click(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.BitBtn3Click(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 ComboBox1.Text <>'' then
begin
if combobox1.ItemIndex =0 then
edit1.text:=edit1.text +'今个儿真高兴呀!';
if combobox1.ItemIndex =1 then
edit1.text:=edit1.text +'他奶奶的今天背死了!';
end;
if combobox1.ItemIndex =2 then
edit1.text:=edit1.text +'嗷嗷痛哭中....!';
if combobox1.ItemIndex =3 then
edit1.text:=edit1.text +'送你一朵玫瑰花,反正也不花钱嘿嘿!';
if combobox1.ItemIndex =4 then
edit1.text:=edit1.text +'咕咚咕咚偶喝了二斤二锅头..猫呢!丫的你给我出来!';
if combobox1.ItemIndex =5 then
edit1.text:=edit1.text +'给你一顿星星!';
if combobox1.ItemIndex =6 then
edit1.text:=edit1.text +'我只一棍子就能把你打倒在地!';
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[i];//远程主机的名称或地址.
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[i];
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.BitBtn1Click(Sender: TObject);
var
InputString:String;
begin //file://增加网友,输入的可以是IP地址或计算机名称。
InputString:=InputBox('增加人员', 'IP地址或计算机名', '');
if Inputstring<>'' then ListBox1.Items.Add(Inputstring);
ListBox1.ItemIndex:=0;
end;
procedure TForm1.BitBtn2Click(Sender: TObject);
begin //file://删除当前选中的网友,但"大家"不能被删除.
if (ListBox1.ItemIndex<>0) and (ListBox1.ItemIndex<>1) then ListBox1.Items.Delete(ListBox1.ItemIndex);
end;procedure TForm1.BitBtn4Click(Sender: TObject);
begin
Memo1.Text :='';
end;procedure TForm1.BitBtn5Click(Sender: TObject);
begin
edit1.Text :='';
combobox1.ItemIndex :=-1;
end;end.
这是编译好的。
begin
If Key=#13 then //回车键的ASCII码为#13
Begin
NMMsg1.Host := Edit19.Text;
NMMsg1.FromName := Edit18.Text;
NMMsg1.PostIt(Edit20.Text);
Edit20.Text:='';
End;
end;procedure TForm1.NMMsg1Connect(Sender: TObject);
begin
StatusLabel.Caption:='Connected';
end;procedure TForm1.NMMsg1ConnectionFailed(Sender: TObject);
begin
StatusLabel.Caption:='Connection Failed';
end;procedure TForm1.NMMsg1Disconnect(Sender: TObject);
begin
StatusLabel.Caption:='Disconnect';
end;procedure TForm1.NMMsg1HostResolved(Sender: TComponent);
begin
StatusLabel.Caption:='Host Resolved';
end;procedure TForm1.NMMsg1InvalidHost(var Handled: Boolean);
var //目标IP连接失败
TmpStr: String;
begin
If InputQuery('Invalid Host!', 'Specify a new host:', TmpStr) then
Begin
NMMsg1.Host := TmpStr;
Handled := TRUE;
End;
end;procedure TForm1.NMMsg1MessageSent(Sender: TObject);
begin
StatusLabel.Caption:='Message Sent';
end;procedure TForm1.NMMsg1Status(Sender: TComponent; Status: String);
begin
If StatusLabel <> nil then
StatusLabel.Caption:=status;
end;procedure TForm1.NMMSGServ1ClientContact(Sender: TObject);
begin //当有客户机连接到本机
NMMsgServ1.ReportLevel:=Status_Basic;//控制OnStatus事件和Status属性汇报的细节量为基本信息量
NMMsgServ1.TimeOut:=90000; //超时设置为90秒
StatusLabel.Caption:='Client connected';
end;procedure TForm1.NMMSGServ1MSG(Sender: TComponent; const sFrom,
sMsg: String);
begin //服务器接收到消息,触发OnMSG事件
Memo12.Lines.Add(sFrom+': '+sMsg);
end;procedure TForm1.NMMSGServ1Status(Sender: TComponent; Status: String);
begin
If StatusLabel <> nil then
StatusLabel.Caption:=status;
end;// page12
procedure TForm1.TabSheet12Show(Sender: TObject);
begin
NickName:='我的昵称';
b_Client:=true;
end;procedure TForm1.Button26Click(Sender: TObject);
begin
ClientSocket1.close;
ServerSocket1.open;
StatusBar1.SimpleText:='开始监听';
end;procedure TForm1.Button27Click(Sender: TObject);
var
s:string;
begin
Button26.Enabled:=false;
if Clientsocket1.Active then
ClientSocket1.close;
if InputQuery('连接到计算机','要连接的计算机名称或IP地址:',s) then
if Length(s)>0 then
with ClientSocket1 do
begin
Host:=s;
open;
end;
end;procedure TForm1.Button28Click(Sender: TObject);
begin
if b_client then
ClientSocket1.close
else
serversocket1.Close;
StatusBar1.SimpleText:='断开连接';
end;procedure TForm1.Button29Click(Sender: TObject);
var
s:string;
begin
if InputQuery('更改昵称','你的新昵称',s) then
if Length(s)>0 then
NickName:=s;
end;procedure TForm1.Edit21KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key=VK_Return then
begin
Memo13.Lines.Add(NickName+':'+Edit21.Text);
if b_Client then
ClientSocket1.Socket.SendText(Memo13.Lines[Memo13.lines.Count-1])
else
ServerSocket1.Socket.Connections[0].SendText(Memo13.Lines[Memo13.lines.Count-1]); edit21.Clear;
end;
end;procedure TForm1.ServerSocket1Accept(Sender: TObject;
Socket: TCustomWinSocket);
begin
b_Client:=false;
StatusBar1.SimpleText:='连接到'+Socket.RemoteAddress;
end;procedure TForm1.ServerSocket1ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
ServerSocket1.close;
StatusBar1.SimpleText:='断开连接';
end;procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
begin
Memo13.lines.Add(Socket.ReceiveText);
end;procedure TForm1.ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
begin
b_Client:=true;
StatusBar1.SimpleText:='连接成功';
end;procedure TForm1.ClientSocket1Connecting(Sender: TObject;
Socket: TCustomWinSocket);
begin
StatusBar1.SimpleText:='等待来自'+Socket.RemoteAddress+'的连接允许响应...';
end;procedure TForm1.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
begin
Memo13.lines.Add(Socket.ReceiveText);
end;procedure TForm1.Button30Click(Sender: TObject);
begin
if ClientSocket2.Active then ClientSocket2.Active:=False;
if Length(edit22.text)>0 then
with ClientSocket2 do
begin
server:=edit22.text;
Host := Server;
Active := True;
end;
end;procedure TForm1.Edit23KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key=VK_Return then
begin
memo14.Lines.add('送出:'+edit23.text);
if IsServer then
ServerSocket2.Socket.Connections[0].SendText('收到:'+edit23.text)
else
ClientSocket2.Socket.SendText('送出:'+edit23.text);
end;
end;procedure TForm1.ServerSocket2Accept(Sender: TObject;
Socket: TCustomWinSocket);
begin
IsServer:=True;
Statusbar2.Panels[0].Text:='Connected to: '+Socket.RemoteAddress;
end;procedure TForm1.ServerSocket2ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
memo14.Lines.Clear;
end;procedure TForm1.ServerSocket2ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Statusbar2.Panels[0].Text:='Listening...';
end;procedure TForm1.ServerSocket2ClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
Memo14.Lines.Add('Error connecting to : '+Server);
ErrorCode:=0;
end;procedure TForm1.ServerSocket2ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
begin
Memo14.Font.Color:=clgreen;
end;procedure TForm1.ClientSocket2Connect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Statusbar2.Panels[0].Text:='Connected to: '+Socket.RemoteHost;
edit23.Enabled:=true;
end;procedure TForm1.ClientSocket2Error(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
Memo14.Lines.Add('Error connecting to : '+Server);
ErrorCode:=0;
end;procedure TForm1.ClientSocket2Read(Sender: TObject;
Socket: TCustomWinSocket);
begin
Memo14.Font.Color:=clred;
Memo14.Lines.Add(Socket.ReceiveText);
end;