谁有文件传送的例子？给200分！

[ss]

说有可以连续传送文件的例子？像qq那样！

[ss]

一定给200分！

[zhengxionghua]

用网络组件 socket救行 发送信息
用TFileStream读入数据，然后将此Stream发送
对方受到后建立此文件就可以了！

[netlib]

信箱？？

[netlib]

算了，源码放在这儿，大家一起学习吧。
client:

{本源码是自由程序，你可以把它用在任何地方，但不允许以任何形式把它单独用作商业用途。

本人是一个普通的打工仔，为了给朋友们献上更好的源码和控件，我需要你的支持，如果你认为本程序对你有帮助，希望你寄任意你愿意数额的RMB给我以资鼓励和支持，如果你认为不值，也希望你寄一张PostCard或者一封Email对我予以支持。

深圳市福田区联合广场41楼恒星威电子有限公司GPS部 艾真保 收
518026

mailto:[e-mail]

HomePage:
http://vip.6to23.com/aizb}
unit UnitClient;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ScktComp, StdCtrls, Buttons, ExtCtrls;
Const
MP_QUERY ='11111';
MP_REFUSE ='22222';
MP_ACCEPT ='33333';
MP_NEXTWILLBEDATA='44444';
MP_DATA ='55555';
MP_ABORT ='66666';
MP_OVER ='77777';
MP_CHAT ='88888';
MP_END='99999';
MP_FILEPROPERTY='00000';
iBYTEPERSEND=1024;

type
TForm1 = class(TForm)
OpenDialog1: TOpenDialog;
cs: TClientSocket;
Memo1: TMemo;
Panel1: TPanel;
btnSendFile: TBitBtn;
btnConnect: TBitBtn;
edtIPAddress: TEdit;
procedure btnConnectClick(Sender: TObject);
procedure btnSendFileClick(Sender: TObject);
procedure csRead(Sender: TObject; Socket: TCustomWinSocket);
procedure FormCreate(Sender: TObject);
private
fsSend: TFileStream;
bStart:Boolean;
TickCount:Longword;
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.btnConnectClick(Sender: TObject);
begin
cs.Address:=edtIPAddress.Text;
cs.Port:=2000;
cs.Open;
end;

procedure TForm1.btnSendFileClick(Sender: TObject);
begin
if OpenDialog1.Execute then
Begin
cs.Socket.SendText(MP_QUERY+OpenDialog1.FileName);
//接收端是否准备好！
end;
end;

procedure TForm1.csRead(Sender: TObject; Socket: TCustomWinSocket);
var
sRecv:string;
bufSend:pointer;
iLength:Integer;
begin
sRecv:=Socket.ReceiveText;
sRecv:=copy(sRecv,1,5);
if sRecv=MP_REFUSE then
memo1.Lines.Add('被拒绝!')
else if sRecv=MP_ACCEPT then
begin
fsSend:=TFileStream.Create(OpenDialog1.FileName,fmOpenRead);
bStart:=False;
memo1.Lines.Add('开始发送!');
TickCount:=GetTickCount;
//iBYTEPERSEND是个常量，每次发送包的大小。
Socket.SendText(MP_FILEPROPERTY+inttostr(Trunc(fsSend.Size/iBYTEPERSEND)+1));
//创建文件流并发送文件长度。
end else if sRecv=MP_NEXTWILLBEDATA then
begin
Socket.SendText(MP_NEXTWILLBEDATA);
//通知接收端。继续传送数据。
end else if sRecv=MP_DATA then
begin
//发送数据。
if not bStart then
begin
memo1.Lines.Add('发送数据。。。!');
bStart:=True;
end;
if fsSend.Position< fsSend.Size-1 then//还有数据没有发送。
begin
iLength:=fsSend.Size-1-fsSend.Position;
if iLength>iBYTEPERSEND then
iLength:=iBYTEPERSEND;
GetMem(bufSend,iLength+1);
try
fsSend.Read(bufSend^,iLength);
Socket.SendBuf(bufSend^,iLength);
finally
FreeMem(bufSend,iLength+1);
end;{of try}
end else//没有数据需要发送了。
begin
Socket.SendText(MP_END);//文件传送结束。
memo1.Lines.Add('结束!'+IntToStr(GetTickCount-TickCount));
fsSend.Free; // <--------------------
end;
end else if sRecv=MP_ABORT then
begin
memo1.Lines.Add('中止!');
//被取消了:(
fsSend.Free;
end;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
Memo1.Clear;
end;

end.


server:

{本源码是自由程序，你可以把它用在任何地方，但不允许以任何形式把它单独用作商业用途。

本人是一个普通的打工仔，为了给朋友们献上更好的源码和控件，我需要你的支持，如果你认为本程序对你有帮助，希望你寄任意你愿意数额的RMB给我以资鼓励和支持，如果你认为不值，也希望你寄一张PostCard或者一封Email对我予以支持。

深圳市福田区联合广场41楼恒星威电子有限公司GPS部 艾真保 收
518026

mailto:[e-mail]

HomePage:
http://vip.6to23.com/aizb}
unit UnitServer;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, ScktComp, ExtCtrls;
Const
MP_QUERY ='11111';
MP_REFUSE ='22222';
MP_ACCEPT ='33333';
MP_NEXTWILLBEDATA='44444';
MP_DATA ='55555';
MP_ABORT ='66666';
MP_OVER ='77777';
MP_CHAT ='88888';
MP_END='99999';
MP_FILEPROPERTY='00000';
type
TForm1 = class(TForm)
SaveDialog1: TSaveDialog;
ss: TServerSocket;
Memo1: TMemo;
procedure ssClientRead(Sender: TObject; Socket: TCustomWinSocket);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
fsRecv:TFileStream;
bStart:Boolean;
TickCount:Longword;
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation


{$R *.DFM}

procedure TForm1.ssClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
sTemp,sFileName:string;
bufRecv:Pointer;
iLength:Integer;
begin
iLength:=Socket.ReceiveLength;
GetMem(bufRecv,iLength);
try
Socket.ReceiveBuf(bufRecv^,iLength); //
sTemp:=StrPas(PChar(bufRecv));
//如果传入的数据有可能不是字符串，需要用其他方式处理，则这里不能及Socket.ReceiveText方法取数据出来检查，
//因为这个方法会清空接收缓冲区，也就是说在执行Socket.ReceiveText方法后，Socket.ReceiveLength将会返回0，
//ReceiveBuf方法也不会取到正确数据。ReceiveBuf方法也是一样的！
//所以在取数据前一定要先把长度取出来，保存在一个变量中。

//请注意判断第一个字符的方法有可能出问题，有可能传送文件的时候正好当前传送段的数据的第一个字节是一个0-9之间的字符。可能会出错。
sTemp:=Copy(sTemp,1,5);
if sTemp=MP_QUERY then
begin
sTemp:=Trim(StrPas(PChar(bufRecv)));
sFileName:=ExtractFileName(Copy(sTemp,6,Length(STemp)));
//在这里拒绝
SaveDialog1.Title:='请选择或输入接收到的数据保存到的文件名：';
SaveDialog1.FileName:=sFileName;
if SaveDialog1.Execute then
begin
fsRecv:=TFileStream.Create(SaveDialog1.FileName,fmCreate);
//如果愿意接收数据。
memo1.Lines.Add ('开始接收！');//??????
TickCount:=GetTickCount;
Socket.SendText(MP_ACCEPT);
//通知发送端发送数据。
bStart:=False;
end
else
Socket.SendText(MP_REFUSE+'去死');
end else if sTemp=MP_FILEPROPERTY then
begin
//要发送StrToInt(Copy(sTemp,2,Length(sTemp))) 次
//时间进度显示。。。
//iRecvLength:=StrToInt(Copy(sTemp,2,Length(sTemp)));//;1024
Socket.SendText(MP_NEXTWILLBEDATA);
//接收文件长度并要求继续传送数据。
end else if sTemp=MP_NEXTWILLBEDATA then
begin
Socket.SendText(MP_DATA);
//要求发送端发送数据。
//准备好接收数据。
end else if sTemp=MP_OVER then
begin
memo1.Lines.Add ('MP_OVER');//??????
fsRecv.Free;
end else if sTemp=MP_END then//文件传送结束。
begin
memo1.Lines.Add ('结束！'+IntToStr(GetTickCount-TickCount));//??????
fsRecv.Free;
end else if sTemp=MP_ABORT then
begin
memo1.Lines.Add ('MP_ABORT');//??????
fsRecv.Free;
end else if sTemp=MP_CHAT then
begin
//Chat Msg
end else
begin
if not bStart then
begin
memo1.Lines.Add('接收数据...');//??????
bStart:=True;
end;
fsRecv.WriteBuffer(bufRecv^,iLength);//
Socket.SendText(MP_NEXTWILLBEDATA);
end;
finally
FreeMem(bufRecv,iLength);
//FreeMem(bufRecv,2000);
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Memo1.Clear;
ss.Port:=2000;
ss.Open;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
ss.Close;
end;

end.

[smhpnuaa]

呵呵，这个不错！

[smhpnuaa]

procedure TfrmMain.CSocketRead(Sender: TObject;Socket: TCustomWinSocket);
var
buffer:array [0..10000] of byte; //设置接收缓冲区
len:integer;
strGet:string;
i:integer;
MsBmp:TMemoryStream;
begin
if Count=0 then begin //Count为服务端发送的字节数，
strGet:=socket.ReceiveText; //如果为0表示为尚未开始图象接收
strGet:=LowerCase(strGet);
i:=Pos('/',strGet);
if Copy(strget,1,i-1)='screenok' then begin
Count:=strtoint(Copy(strget,i+1,length(strGet)-i)); //设置需接收的字节数
csocket.Socket.SendText('gogo'); //通知服务端开始发送图象
stuBar.Panels[1].Text:='尺寸大小：'+ InttoStr(Count);
end;
end else begin //以下为图象数据接收部分
Len:=socket.ReceiveLength; //读出包长度
Socket.ReceiveBuf(buffer,len); //接收数据包并读入缓冲区内
MsTmp.Write(buffer,len); //追加入流MsTmp中
if MsTmp.Size>=Count then //如果流长度大于需接收的字节数，则接收完毕
begin
MsTmp.Position:=0;
MsBmp:=TMemoryStream.Create;
myUnCompressStream(MsTmp,MsBmp); //解压缩
try
imgShow.Picture.Bitmap.LoadFromStream(MsBmp);
imgShow.Left:=(plMain.ClientWidth-imgShow.Width) div 2;
imgShow.Top:=(plMain.ClientHeight-imgShow.Height) div 2;
finally //以下为清除工作
MsBmp.Free;
MsTmp.Clear;
Count:=0;
Socket.SendText('okok');
btnGetScreen.Enabled:=True;
btnSavePic.Enabled:=True;
end;
end;
end;
end;

下面是关键的还原压缩算法实现：
//还原被压缩流
procedure TfrmMain.myUnCompressStream(const CompressedStream:TMemoryStream; var DeCompressedStream:TMemoryStream);
Var
SourceStream: TDecompressionStream;
Buffer: PChar;
Count: Integer;
Begin
CompressedStream.ReadBuffer(Count, SizeOf(Count));//从被压缩的流中读出原始的尺寸
GetMem(Buffer, Count);//根据尺寸大小为将要读入的原始流分配内存
SourceStream := TDecompressionStream.Create(CompressedStream);
Try
//将被压缩的流解压缩，然后存入 Buffer内存块中
SourceStream.ReadBuffer(Buffer^, Count);
//将原始图像流保存至 DestStream流
DeCompressedStream.WriteBuffer(Buffer^,Count); DeCompressedStream.Position := 0;//复位流指针
finally
FreeMem(Buffer);
SourceStream.Free;
end;
end;

下面是服务器端（受控机）端的关键代码

procedure TfrmMain.SSocketClientRead(Sender: TObject;Socket: TCustomWinSocket);
var
strGet,strSize:string;
Bitmap:TBitmap;
MS:TMemoryStream;
begin
strGet:=socket.ReceiveText;
strGet:=Lowercase(strGet); //全部小写
if strGet='getscreen' then //客户端发出申请
begin
Bitmap:=TBitmap.Create;
Bitmap.Width:=Screen.Width;
Bitmap.Height:=Screen.Height;
MS:=TMemoryStream.Create;
strTempFile:=GetTempFile; //得到临时文件
try
Bitblt(Bitmap.Canvas.Handle,0,0,Bitmap.Width,Bitmap.Height,GetDC(0),0,0,Srccopy);
Bitmap.Canvas.TextOut(0,0,DateTimetoStr(now));
BitMap.SaveToStream(MS);
Ms.Position:=0;
myCompressStream(MS,clDefault); //压缩图像流
MS.Position:=0;
MS.SaveToFile(strTempFile);
MS.Position:=0;
strSize:=inttostr(MS.size);
finally
Bitmap.free;
Ms.Free;
end;
Socket.SendText('screenok/' + strSize); //发送图象大小
end else if strGet='gogo' then begin //客户端已准备好接收图象
Socket.SendStream(TFileStream.Create(strTempFile,fmOpenRead));//发送图象
end else if strGet='okok' then begin //客户端已接收图象
DeleteFile(strTempFile);
end else if strGet='reboot' then begin //客户要求注销系统
AdjustTokenPrivilegesNT;
ExitWindowsEx(EWX_LOGOFF, 0);
end;
end;

下面为关键的数据压缩算法实现：

//压缩流
procedure TfrmMain.myCompressStream(var CompressedStream: TMemoryStream;const CompressionLevel: TCompressionLevel);
var
SourceStream: TCompressionStream;
DestStream: TMemoryStream;
Count: Integer;
Begin
Count := CompressedStream.Size; //获得流的原始尺寸
DestStream := TMemoryStream.Create;
SourceStream:=TCompressionStream.Create(CompressionLevel, DestStream); //创建压缩流
Try
CompressedStream.SaveToStream(SourceStream);//SourceStream中保存着原始的流
SourceStream.Free; //将原始流进行压缩， DestStream中保存着压缩后的流
CompressedStream.Clear;
CompressedStream.WriteBuffer(Count, SizeOf(Count));//写入原始的尺寸
CompressedStream.CopyFrom(DestStream, 0);//写入经过压缩的流
finally
DestStream.Free;
end;
end;

[smhpnuaa]

这个是一个远程图像截取的代码，对你有用！

[aizb]

感谢netlib(河外孤星)把我的这段代码贴出来,其实这段代码并不完全是我自己从头写的.
感谢何志斌朋友来信提出这段代码中的一些问题:

关于注释:
//要发送StrToInt(Copy(sTemp,2,Length(sTemp))) 次
//时间进度显示。。。
//iRecvLength:=StrToInt(Copy(sTemp,2,Length(sTemp)));//;1024
有误,正确的应该是
//要发送StrToInt(Copy(sTemp,6,Length(sTemp))) 次
//时间进度显示。。。
//iRecvLength:=StrToInt(Copy(sTemp,6,Length(sTemp)));//;1024
因为收到的数据前5位是消息字符串,从第六位开始后才是文件长度.


何志斌朋友还提出下面的注释不能出根本上解决出错的问题
//请注意判断第一个字符的方法有可能出问题，有可能传送文件的时候正好当前传送段的数据的第一个字节是一个0-9之间的字符。可能会出错。

原来程序定的消息长度是1,所以才有上面的第一个注释,后来把长度改为5,但是注释没有改,但是这样也不能从根本上解决问题,其实从理论上来说无法从根本上解决出错的问题,只是长度为1位出错的可能性大得多,而长度为5出错可能性就小了很多,如果需要更大的增加安全性,可以再把消息长度加长.