使用fastnet中控件TNMstrm与TNMstrmserv
例程如下:
unit Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Mask, ToolEdit, ExtCtrls, Buttons, NMSTRM, Psock,
ComCtrls, Menus, NMUDP, WinSock, ShellAPI, ToolWin, RXShell, AppEvnts,
XPMenu, Gauges;
type
TfrmMain = class(TForm)
PPMemu: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
PanelRight: TPanel;
Panel1: TPanel;
SendTo: TComboEdit;
Label2: TLabel;
Label1: TLabel;
FileName: TFilenameEdit;
SaveDialog: TSaveDialog;
Strm: TNMStrm;
StrmServ: TNMStrmServ;
NMUDP: TNMUDP;
Panel2: TPanel;
BtnSend: TSpeedButton;
SBAbout: TSpeedButton;
ListBox: TListBox;
TrayIcon: TRxTrayIcon;
ApplicationEvents1: TApplicationEvents;
XPMenu1: TXPMenu;
N3: TMenuItem;
Gauge: TGauge;
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure FormCreate(Sender: TObject);
procedure SBAboutClick(Sender: TObject);
procedure StrmConnect(Sender: TObject);
procedure StrmDisconnect(Sender: TObject);
procedure StrmConnectionFailed(Sender: TObject);
procedure StrmInvalidHost(var Handled: Boolean);
procedure StrmStatus(Sender: TComponent; Status: String);
procedure StrmHostResolved(Sender: TComponent);
procedure StrmServClientContact(Sender: TObject);
procedure StrmServMSG(Sender: TComponent; const sFrom: String;
strm: TStream);
procedure StrmServDisconnect(Sender: TObject);
procedure BtnSendClick(Sender: TObject);
procedure NMUDPDataSend(Sender: TObject);
procedure NMUDPDataReceived(Sender: TComponent; NumberBytes: Integer;
FromIP: String; Port: Integer);
procedure StrmServInvalidHost(var Handled: Boolean);
procedure StrmPacketRecvd(Sender: TObject);
procedure StrmPacketSent(Sender: TObject);
procedure SendToButtonClick(Sender: TObject);
procedure TrayIconDblClick(Sender: TObject);
procedure ApplicationEvents1Minimize(Sender: TObject);
procedure ApplicationEvents1Restore(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure FormShow(Sender: TObject);
private
procedure ErrorBox(Str:String);
{ Private declarations }
public
procedure ReturnUDPTransQry(var Msg:String;Const FromIP:String);
procedure ReReturnUDPTransQry(Const Msg,FromIP:String);
procedure TransMyInfo(Var Msg:String;Const FromIP:String);
procedure ReceiveInfo(Const IP,CName:String);
{ Public declarations }
end;
var
frmMain: TfrmMain;
SingleFileName:String;
implementation
uses NetUnit, IPList, About;
{$R *.dfm}
procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
If Application.MessageBox('您确认退出程序吗?','提示',MB_YESNO+MB_ICONINFORMATION)= IDYes
then CanClose:=True
else CanClose:=False;
end;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
LocalIP:=GetLocalIP;
LocalCName:=GetLocalCName;
SetBroadCastIP;
Caption:=Application.Title;
Caption:=Caption+' '+LocalIP;
TrayIcon.Icon:=Application.Icon;
MsgStream:=TMemoryStream.Create;
end;
procedure TfrmMain.SBAboutClick(Sender: TObject);
begin
frmAbout.Showmodal;
end;
procedure TfrmMain.ErrorBox(Str: String);
begin
Application.MessageBox(PChar(Str),'错误',MB_OK+MB_ICONerror);
end;
//=============================================================一般过程显示
procedure TfrmMain.StrmConnect(Sender: TObject);
begin
ListBox.Items.Add(FormatDateTime('HH:MM:SS',Time())+'>Strm Connect');
end;
procedure TfrmMain.StrmDisconnect(Sender: TObject);
begin
ListBox.Items.Add(FormatDateTime('HH:MM:SS',Time())+'>Strm Disconnected');
end;
procedure TfrmMain.StrmConnectionFailed(Sender: TObject);
begin
ListBox.Items.Add(FormatDateTime('HH:MM:SS',Time())+'>Strm Connection Failed');
ErrorBox('$连接失败!');
end;
procedure TfrmMain.StrmInvalidHost(var Handled: Boolean);
begin
ListBox.Items.Add(FormatDateTime('HH:MM:SS',Time())+'>Strm Invalid Host');
ErrorBox('$无效的主机地址: '+SendTo.Text+' !');
end;
procedure TfrmMain.StrmStatus(Sender: TComponent; Status: String);
begin
ListBox.Items.Add(FormatDateTime('HH:MM:SS',Time())+'>Strm Status : '+Status);
end;
procedure TfrmMain.StrmHostResolved(Sender: TComponent);
begin
ListBox.Items.Add(FormatDateTime('HH:MM:SS',Time())+'>Strm Host Resolved');
end;
procedure TfrmMain.StrmServDisconnect(Sender: TObject);
begin
ListBox.Items.Add(FormatDateTime('HH:MM:SS',Time())+'>StrmServer Disconnected');
end;
procedure TfrmMain.StrmServClientContact(Sender: TObject);
begin
ListBox.Items.Add(FormatDateTime('HH:MM:SS',Time())+'>StrmServer Client Contact');
end;
procedure TfrmMain.NMUDPDataSend(Sender: TObject);
begin
ListBox.Items.Add(FormatDateTime('HH:MM:SS',Time())+'>NMUDP Data Send');
end;
procedure TfrmMain.StrmServInvalidHost(var Handled: Boolean);
begin
ListBox.Items.Add(FormatDateTime('HH:MM:SS',Time())+'>StrmServer Invalid Host');
ErrorBox('$无效的主机地址');
end;
//==================================================================
// 开始执行
//==================================================================
procedure TfrmMain.BtnSendClick(Sender: TObject);
var
Msg:String;
begin
if (FileName.FileName='') or (SendTo.Text='') then ErrorBox('文件名或IP地址无效!')
else
begin
Msg:=FileName.FileName;
IniMsgStream;
try
MsgStream.Write(Msg[1],Length(Msg));
NMUDP.RemoteHost:=SendTo.Text;
NMUDP.SendStream(MsgStream);
BtnSend.Enabled:=False;
Except
ErrorBox('对方可能没有打开程序,运行错误!'#13+'或与制作人联系');
IniMsgStream;
end;
end;
end;
procedure TfrmMain.NMUDPDataReceived(Sender: TComponent;
NumberBytes: Integer; FromIP: String; Port: Integer);
Var
Msg:String;
begin
IniMsgStream;
NMUDP.ReadStream(MsgStream);
SetLength(Msg,NumberBytes);
MsgStream.Read(Msg[1],NumberBytes);
if Copy(Msg,1,3)='@_0' then TransMyInfo(Msg,FromIP) else
if Copy(Msg,1,3)='@_1' then ReceiveInfo(Copy(Msg,4,15),Copy(Msg,19,Length(Msg)-18)) else
if Copy(Msg,1,2)='#_' then ReReturnUDPTransQry(Msg,FromIP) else
ReturnUDPTransQry(Msg,FromIP);
end;
procedure TfrmMain.StrmServMSG(Sender: TComponent; const sFrom: String;
strm: TStream);
var
MyFStream:TFileStream;
begin
SaveDiaLog.FileName:=SingleFileName;
if SaveDialog.Execute then
begin
MyFStream := TFileStream.Create(SaveDialog.InitialDir+SingleFileName,fmCreate);
end
else ErrorBox('存入文件名无效!!!');
try
MyFStream.CopyFrom(strm, strm.size);
Application.MessageBox('接收文件成功!','成功',MB_OK+MB_ICONINFORMATION);
FileName.Clear;
SendTo.Clear;
Gauge.Progress:=0;
Panel1.Enabled:=True;
finally
MYFStream.Free;
end;
end;
procedure TfrmMain.ReReturnUDPTransQry(const Msg,FromIP: String);
var
MyFStream:TFileStream;
begin
if Copy(Msg,1,3)='#_1' then
begin
Application.MessageBox(PCHAR('用户 '+FromIP+' 同意接收文件!'),'响应',MB_OK+MB_ICONINFORMATION);
Strm.Host:=SendTo.Text;
MyFStream:= TFileStream.Create(FileName.FileName , fmOpenRead);
try
Strm.PostIt(MyFStream);
Application.MessageBox(PCHAR('向用户 '+FromIP+' 传送文件成功!'),'结果',MB_OK+MB_ICONINFORMATION);
Gauge.Progress:=0;
BtnSend.Enabled:=True;
finally
MyFStream.Free;
end;
end
else
begin
Application.MessageBox(PCHAR('用户 '+FromIP+' 不同意接收文件!'),'响应',MB_OK+MB_ICONWarning);
BtnSend.Enabled:=True;
end;
end;
procedure TfrmMain.ReturnUDPTransQry(var Msg:String;Const FromIP:String);
begin
if Application.MessageBox(PCHAR('用户 '+FromIP+' 欲向您传送一文件,相关内容如下:'#13#13+
Msg+#13#13'请问是否同意接收?'),'接收到传送文件信息',MB_YESNO+MB_ICONQUESTION) = IDYes
then
begin
SingleFileName:=ExtractFileName(Msg);
Msg:='#_1';
IniMsgStream;
MsgStream.Write(Msg[1],Length(Msg));
NMUDP.RemoteHost:=FromIP;
NMUDP.SendStream(MsgStream);
end
else begin
SingleFileName:='';
Msg:='#_0';
IniMsgStream;
MsgStream.Write(Msg[1],Length(Msg));
NMUDP.RemoteHost:=FromIP;
NMUDP.SendStream(MsgStream);
end;
end;
procedure TfrmMain.StrmPacketRecvd(Sender: TObject);
begin
Gauge.MaxValue:=Strm.BytesTotal;
Gauge.Progress:=Strm.BytesSent;
end;
procedure TfrmMain.StrmPacketSent(Sender: TObject);
begin
Panel1.Enabled:=False;
Gauge.MaxValue:=Strm.BytesTotal;
Gauge.Progress:=Strm.BytesSent;
end;
procedure TfrmMain.SendToButtonClick(Sender: TObject);
begin
frmIPList.ShowModal;
end;
procedure TfrmMain.TransMyInfo(Var Msg:String;Const FromIP:String);
var
NNStream:TMemoryStream;
begin
NNStream:=TMemoryStream.Create;
msg:='@_1';
msg:=msg+Trim(Format('%-15s%-255s',[LocalIP,LocalCName]));
NNStream.Write(Msg[1],Length(Msg));
NMUDP.RemoteHost:=FromIP;
NMUDP.SendStream(NNStream);
end;
procedure TfrmMain.ReceiveInfo(Const IP,CName:String);
var O:TListItem;
begin
O:=frmIPList.List.Items.Add;
O.Caption:=Trim(CName);
O.SubItems.Add(Trim(IP));
end;
procedure TfrmMain.TrayIconDblClick(Sender: TObject);
begin
Application.Restore;
Application.BringToFront;
end;
procedure TfrmMain.ApplicationEvents1Minimize(Sender: TObject);
begin
ShowWindow(Application.Handle,SW_HIDE);
end;
procedure TfrmMain.ApplicationEvents1Restore(Sender: TObject);
begin
ShowWindow(Application.Handle,SW_SHOW);
end;
procedure TfrmMain.N2Click(Sender: TObject);
begin
Close;
end;
procedure TfrmMain.FormShow(Sender: TObject);
begin
frmIPList.OnShow(Nil);
end;
end.