局域网中的文件传输 ( 积分: 100 )

  • 主题发起人 主题发起人 爱如泣血
  • 开始时间 开始时间

爱如泣血

Unregistered / Unconfirmed
GUEST, unregistred user!
在局域网中如何传输文件。类型比如音乐,电影之类。
在上传之前是否可以先获得被上传主机中硬盘的信息。诸如剩余空间,文件数等。。。
那位高人给各例子,谢了。
 
在局域网中如何传输文件。类型比如音乐,电影之类。
在上传之前是否可以先获得被上传主机中硬盘的信息。诸如剩余空间,文件数等。。。
那位高人给各例子,谢了。
 
可以用copyfile(源地址,目的地址,false);
但拷贝到的对方目录要共享,不然拷不过去的;
打个比方吧:
copyfile('D:/mydoc/电影.rm','//192.168.0.XXX/sharedoc/',false);
后边的false意思是对方如果存在该文件的话,直接覆盖;
 
那么对于被上传主机的硬盘信息的读取是否要用到C/S模式?
可以直接访问到吗?
 
使用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.
 
to snow2008
TNMstrm与TNMstrmserv这两个控件怎么用呀,你给的代码太长啦。
而且没有注释。。。
 
你邮箱多少,我将源程序发给你。[8D]
 
在局域网中如何传输文件。类型比如音乐,电影之类。
www.51merit.com
有winsock专区
可以说是最顶级的专区
 
to snow_143
ysx_008@163.com
谢谢了。还有就是如果上传的是个文件夹该怎么办呢?紧急呀。。
 
我也要原代码,谢谢
fengyhf@163.com
 
多人接受答案了。
 

Similar threads

D
回复
0
查看
743
DelphiTeacher的专栏
D
D
回复
0
查看
717
DelphiTeacher的专栏
D
D
回复
0
查看
671
DelphiTeacher的专栏
D
后退
顶部