电脑爱好者,提供IT资讯信息及各类编程知识文章介绍,欢迎大家来本站学习电脑知识。 最近更新 | 联系我们 RSS订阅本站最新文章
电脑爱好者
站内搜索: 
当前位置:首页>> delphi技术>>XML格式的聊天程序:

XML格式的聊天程序

来源:www.cncfan.com | 2006-1-20 | (有9225人读过)

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, NMUDP, IdUDPServer, IdBaseComponent, IdComponent,
IdUDPBase, IdUDPClient, IdAntiFreezeBase, IdAntiFreeze, IDSOCKETHANDLE,
Grids, Menus,shellapi;
const MY_MESSAGE = WM_USER + 100;

type
TForm1 = class(TForm)
Sendword: TEdit;
sendbt: TButton;
NMUDP1: TNMUDP;
Label1: TLabel;
name: TEdit;
Label2: TLabel;
remotehost: TEdit;
speaklist: TStringGrid;
sendto: TEdit;
MainMenu1: TMainMenu;
F1: TMenuItem;
Save1: TMenuItem;
Exit1: TMenuItem;
Help1: TMenuItem;
About1: TMenuItem;
receiveword: TLabel;
PopupMenu1: TPopupMenu;
Saveasfile1: TMenuItem;
Sendtothem1: TMenuItem;
EXIT2: TMenuItem;
procedure sendbtClick(Sender: TObject);
procedure NMUDP1DataReceived(Sender: TComponent; NumberBytes: Integer;
FromIP: String; Port: Integer);
procedure FormCreate(Sender: TObject);
procedure speaklistDblClick(Sender: TObject);
procedure speaklistRowMoved(Sender: TObject; FromIndex,
ToIndex: Integer);
procedure Saveasfile1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure About1Click(Sender: TObject);
private
procedure OnIconNotify(var Message: TMessage);
message MY_MESSAGE;

{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
Busy: Boolean;
implementation

{$R *.dfm}
procedure TForm1.OnIconNotify(var Message: TMessage);

begin
if not Busy then
begin
Busy :=true;
if Message.LParam=WM_LBUTTONDOWN then
begin
form1.Show;
if Application.MessageBox('Are you sure close?','Exit',MB_YESNO)=IDYES then Close;
popupmenu1.Popup(10,10);
end;
Busy := false;

end;

end;

procedure TForm1.sendbtClick(Sender: TObject);
var
MyStream: TMemoryStream;
TmpStr: String;
Begin
NMUDP1.ReportLevel := Status_Basic;
NMUDP1.RemoteHost := remotehost.Text;
//Α#n+祇癳+#t+ヘ夹+#s+笆迭弧+#w+弧杠
TmpStr :='#n'+name.Text+'#t'+sendto.Text+'#s 弧#w'+ sendword.Text;
MyStream := TMemoryStream.Create;
try
MyStream.Write(TmpStr[1], Length(tmpstr));
NMUDP1.SendStream(MyStream);
finally
MyStream.Free;
end;
sendword.SetFocus;
end;

procedure TForm1.NMUDP1DataReceived(Sender: TComponent;
NumberBytes: Integer; FromIP: String; Port: Integer);
var
MyStream: TMemoryStream;
TmpStr: String;
name:string;
BeSend:string;
postword:string;
s:integer;
t:integer;
w:integer;
begin
MyStream := TMemoryStream.Create;
try
NMUDP1.ReadStream(MyStream);
SetLength(TmpStr,NumberBytes);
MyStream.Read(TmpStr[1],NumberBytes);
//- Α秆絏:#n+祇癳+#t+ヘ夹+#s+笆迭弧+#w+弧杠
s:=pos('#s',tmpstr);
t:=pos('#t',tmpstr);
w:=pos('#w',tmpstr);
name:=copy(tmpstr,3,t-3);
besend:=copy(tmpstr,t+2,s-t-2);
postword:=copy(tmpstr,w+2,length(tmpstr)-w+1);
//-----------
speaklist.RowCount:=speaklist.RowCount+1;
speaklist.Cells[0,speaklist.rowcount-2]:=fromip;
speaklist.Cells[1,speaklist.RowCount-2]:=name;
//speaklist.Cells[2,speaklist.RowCount-2]:=besend;
speaklist.cells[2,speaklist.RowCount-2]:='癸-'+besend+'-弧:'+postword;
receiveword.Caption:=name+'癸 -'+besend+'- 弧 :'+postword;
beep();
//sendmessage(speaklist.Handle,WM_VSCROLL,SB_BOTTOM,0);

finally
MyStream.Free;

end;

end;

procedure TForm1.FormCreate(Sender: TObject);
var
nid: TNotifyIconData;

begin
//hide taskbar 夹肈
//SetWindowLong(application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);
busy:=false;
nid.cbSize := sizeof(nid); // nid??????
nid.Wnd := Handle; // ?????
nid.uID:=4567;
nid.hIcon := Application.Icon.Handle; // ????????,?????
nid.szTip := 'LANICQ--- Design by 璖狥キ;MiTAC LTD. JUN.2002'; // ?????
nid.uCallbackMessage := MY_MESSAGE; // ??????
nid.uFlags := NIF_ICON or NIF_TIP or NIF_MESSAGE; // ????????

if not Shell_NotifyIcon(NIM_ADD,@nid) then begin
ShowMessage('Failed!');
Application.Terminate;
end;
{??????????TOOL??,??????????}
SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);

end;

procedure TForm1.speaklistDblClick(Sender: TObject);
var
i:integer;
//t:string;
begin
i:=speaklist.Selection.Top;
remotehost.Text:=speaklist.Cells[0,i];
sendto.Text:=speaklist.Cells[1,i];


end;

procedure TForm1.speaklistRowMoved(Sender: TObject; FromIndex,
ToIndex: Integer);
begin
speaklist.Canvas.Brush.Color:=234567;
end;

procedure TForm1.Saveasfile1Click(Sender: TObject);
var
t:string;
i:integer;

begin


for i:=0 to speaklist.RowCount-1 do
begin

//t:=t+speaklist.Cols[i].Text;

end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
nid: TNotifyIconData;
begin
nid.cbSize := sizeof(nid); // nid??????
nid.cbSize := sizeof(nid); // nid??????
nid.uID :=4567; //????,???????????
nid.Wnd := Handle; //?????
Shell_NotifyIcon(NIM_DELETE,@nid); //?????
Shell_NotifyIcon(NIM_DELETE,@nid); //?????
enD;

procedure TForm1.About1Click(Sender: TObject);
begin
SHOWMESSAGE('LANICQ--- Design by 璖狥キ;MiTAC LTD. JUN.2002');
end;

end.

delphi技术热门文章排行
网站赞助商
购买此位置

 

关于我们 | 网站地图 | 文档一览 | 友情链接| 联系我们

Copyright © 2003-2024 电脑爱好者 版权所有 备案号:鲁ICP备09059398号