哪位大侠有点对点文件传输的源码?200分求购,急!!!(200分)

  • 主题发起人 主题发起人 sunnyliu
  • 开始时间 开始时间
S

sunnyliu

Unregistered / Unconfirmed
GUEST, unregistred user!
哪位大侠有点对点文件传输的源码,可象QQ那样的传文件,收文件,我试了好多的
网上的源码,都不行,哪位有已调好的,我试过后若没问题,一定给分
 
唐晓峰大虾的代码,我调试无误,请参看:
服务器:
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ScktComp, StdCtrls;

type
TCon = record
FileName : String;
TotalSize : Integer;
Status : Integer;
end;

PCON = ^TCON;

TForm1 = class(TForm)
Button1: TButton;
SS: TServerSocket;
// SS: TServerSocket;
// Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure SSClientConnect(Sender: TObject; Socket: TCustomWinSocket);
procedure SSClientRead(Sender: TObject; Socket: TCustomWinSocket);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation


{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
SS.Port := 9000;
SS.Active := True;
end;

procedure TForm1.SSClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
var c : pcon;
begin

c :=new(pcon);
c.FileName := '';
c.TotalSize := 0 ;
c.Status := 0;
Socket.Data := c;
Socket.SendText('已经连接,请输入UPLOAD FILENAME SIZE'#13#10);

end;

procedure TForm1.SSClientRead(Sender: TObject; Socket: TCustomWinSocket);
var C : PCON;
cmd:String;
Buffer : pointer;
nRetr : integer;
fs : TFileStream;
const bufferSize = 1024 ;

begin
C:= Socket.Data ;
case c.Status of
0 :
begin
cmd := trim(Socket.ReceiveText) ;

if Pos('UPLOAD ',uppercase(cmd)) > 0 then
begin
c.FileName := trim(Copy(cmd,Pos(' ',cmd)+1,Length(cmd)));
c.TotalSize := StrToInt(Copy(c.FileName,Pos(' ',c.FileName)+1,Length(c.FileName)));
c.FileName := trim(Copy(c.FileName,1,Pos(' ',c.FileName)));
c.Status := 1;
Socket.Data := C;
Socket.SendText('you can send File !'#13#10);
end;
end;
1 : begin
GetMem(Buffer,BufferSize);
nRetr := Socket.ReceiveBuf(Buffer^,BufferSize);

if not FIleExists('c:/'+c.FileName) then
begin
fs :=TFileStream.Create('c:/'+c.FileName,fmCreate or fmShareDenyNone);
fs.Seek(0,soFromBeginning);
end
else
begin
fs :=TFileStream.Create('c:/'+c.FileName,fmOpenWrite or fmShareDenyNone);
fs.Seek(0,soFromEnd);
end;

fs.WriteBuffer(Buffer^,nRetr);

fs.Destroy;
FreeMem(Buffer);
end;
end;
end;

end.

工作站代码:
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ScktComp;

type
TForm1 = class(TForm)
CS: TClientSocket;
OpenDialog1: TOpenDialog;
Memo1: TMemo;
Edit1: TEdit;
Button1: TButton;
Button2: TButton;
Button3: TButton;
SendCommand: TButton;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure SendCommandClick(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure CSRead(Sender: TObject; Socket: TCustomWinSocket);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}
function GetFileSize(const FileName: string):integer;
var f : TFileStream;
begin
f := TFileStream.Create(FileName,fmOpenRead or fmShareDenyNone);
Result :=f.Size;
F.Free;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
with OpenDialog1 do
begin
Execute;
if FileName <> '' then
begin
Edit1.Text := 'UPLOAD '+ ExtractFileName(FileName) +' '+Inttostr(GetFileSize(FileName));
Label1.Caption := FileName;
cs.Socket.SendText(edit1.Text);
end;
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
CS.Host:='127.0.0.1';
CS.Port:=9000;
CS.Active := True;

end;

procedure TForm1.SendCommandClick(Sender: TObject);
var fs : TFileStream;
Buf : pointer;

begin
//CS.Socket.SendText(Edit1.Text+#13#10);
//Memo1.Lines.Add();
fs := TFileStream.Create(Label1.Caption ,fmOpenRead or fmShareDenyNone);

GetMem(Buf,fs.Size);
fs.Seek(0,soFromBeginning);

fs.ReadBuffer(Buf^,fs.Size);

memo1.Lines.Add('has send : '+inttostr(Cs.Socket.SendBuf(Buf^,fs.Size)));

end;

procedure TForm1.Button3Click(Sender: TObject);
begin
cs.Close;
end;

procedure TForm1.CSRead(Sender: TObject; Socket: TCustomWinSocket);
begin

Memo1.Lines.add(socket.receiveText);

end;

end.
绝对没有问题,如果仍然不行,给我你的邮箱,我发给你
 
这段代码我也试过,它怎样收文件呀,把文件存到哪里去了
 
而且也连不上远端的电脑
 
我有代码呀
 
procedure TForm1.ClientSocket2Read(Sender: TObject;
Socket: TCustomWinSocket);
var len:integer;
temp:string;
begin
if stStatue=stgetFile then
begin
Len:=Socket.ReceiveLength;
Temp:=Socket.ReceiveText;
filem.Write(PChar(Temp)^,len); //filem是一个文件流
inc(allLen,len);
if allLen=getfilesize then //allLen是文件长度,你先传送过来
ShowMessage('文件接受完毕!');
end;

发送部分
const
MAX_LEN=2048;

var
iSen:integer; //iSen发送出去的长度
iSize:integer; //文件长度 最好是全局变量
buf:array[1..MAXLEN]of char;
senlen:integer; //每次应该发送的长度
ret:integer; //实际发送的文件长度
filen:TFileStream; //最好是全局变量

iSen:=0;
while iSen<iSize do
begin
FillChar(buf,MAX_LEN,0);
if iSize-iSen>MAX_LEN then senlen:=MAX_LEN
else senLen:=iSize-iSen;
filen.Position:=iSen;
filen.Read(buf,senLen);
ret:=ClientSocket1.Socket.SendBuf(buf,senLen);
inc(iSen,ret);
end;
 
看这句代码:
fs :=TFileStream.Create('c:/'+c.FileName,fmCreate or fmShareDenyNone);
保存在c:/。


连不上远端电脑,看这句:
procedure TForm1.Button2Click(Sender: TObject);
begin
CS.Host:='127.0.0.1';
CS.Port:=9000;
CS.Active := True;
end;
主机为127.0.0.1,端口9000,当然只能联本机了
你在这里更改参数

 
to 张无忌
可否给我一份源代码,我测一下,没问题立即给分,我的Email: liuning72@163.com
 
既然你找无忌教主要,我就不发了,多少给点辛苦分吧[:)]
 
我上面的代码我测试过,没有问题,你稍做修改就可以用了
 
张无忌,你这段代码我试了一下,大的文件就不行了,好象不停的写
 
老兄,网络带宽怎么比得上硬盘传输率啊?
没有传完当然一直写喽
 
老大,我是在本地啊,传输的时候和硬盘传输率有关系吗?
 
我有,但是在局网上通过的,在公网上没实现(在大富翁上已提问),在传输前自动压缩,传输后自动解压。
 
后退
顶部