180大吐血求winsock下传输文件的源代码!!!(180分)

  • 主题发起人 主题发起人 admire
  • 开始时间 开始时间
A

admire

Unregistered / Unconfirmed
GUEST, unregistred user!
目前正在做一个传输文件的程序,用winsock实现,
那位大虾拉兄弟一把,给一个传输文件的源代码.
 
看一下rfc?
 
有源程序的话给我MAIL一份!
mailto:baby_god@china.com
 
i want,email:xiaoshitou@163.net
 
例子:(借花献佛而已)
把服务器端的屏幕拷成jpg文件并传输到客户端。

客户端程序:
unit cmain;

interface

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

type
TForm1 = class(TForm)
Panel1: TPanel;
ScrollBox1: TScrollBox;
Image1: TImage;
Button1: TButton;
Edit1: TEdit;
Button2: TButton;
ClientSocket1: TClientSocket;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
c:longint;
m:tmemorystream;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
try
clientsocket1.Close;
clientsocket1.Host:=edit1.text;
clientsocket1.Open; //连接服务端
except
showmessage(edit1.text+#13#10+‘未开机或未安装服务程序‘);
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
clientsocket1.Socket.SendText(‘gets‘); //发送申请,通知服务端需要屏幕图象
end;

procedure TForm1.ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
begin
caption:=‘连接到‘+edit1.text;
end;

procedure TForm1.ClientSocket1Error(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
caption:=‘连接‘+edit1.text+‘失败‘;
showmessage(edit1.text+#13#10+‘未开机或未安装服务程序‘);
errorcode:=0;

end;

procedure TForm1.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
var
buffer:array [0..10000] of byte; //设置接收缓冲区
len:integer;
ll:string;
b:tbitmap;
j:tjpegimage;
begin
if c=0 then //C为服务端发送的字节数,如果为0表示为尚未开始图象接收
begin
ll:=socket.ReceiveText;
c:=strtoint(ll); //设置需接收的字节数
clientsocket1.Socket.SendText(‘okok‘); //通知服务端开始发送图象
end else
begin //以下为图象数据接收部分
len:=socket.ReceiveLength; //读出包长度
socket.ReceiveBuf(buffer,len); //接收数据包并读入缓冲区内
m.Write(buffer,len); //追加入流M中
if m.Size>=c then //如果流长度大于需接收的字节数,则接收完毕
begin
m.Position:=0;
b:=tbitmap.Create;
j:=tjpegimage.Create;
try
j.LoadFromStream(m); //将流M中的数据读至JPG图像对象J中
b.Assign(j); //将JPG转为BMP
Image1.Picture.Bitmap.Assign(b); //分配给image1元件
finally //以下为清除工作
b.free;
j.free;
clientsocket1.Active:=false;
clientsocket1.Active:=true;
m.Clear;
c:=0;
end;
end;
end;


end;

procedure TForm1.FormCreate(Sender: TObject);
begin
m:=tmemorystream.Create;

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
m.free;
ClientSocket1.Close;
end;

end.


服务端程序:
unit smain;

interface

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

type
TForm1 = class(TForm)
ServerSocket1: TServerSocket;
procedure ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
m1:tmemorystream;

implementation

{$R *.DFM}

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
s,s1:string;
desk:tcanvas;
bitmap:tbitmap;
jpg:tjpegimage;
begin
s:=socket.ReceiveText;
if s=‘gets‘ then //客户端发出申请
begin
bitmap:=tbitmap.Create;
jpg:=tjpegimage.Create;
desk:=tcanvas.Create; //以下代码为取得当前屏幕图象
desk.Handle:=getdc(hwnd_desktop);
m1:=tmemorystream.Create; //初始化流m1,在用sendstream(m1)发送流后,
//它将保留到socket对话结束,
//不能用手工free掉,否则会触发异常
with bitmap do
begin
width:=screen.Width;
height:=screen.Height;
canvas.CopyRect(canvas.cliprect,desk,desk.cliprect);
end;
jpg.Assign(bitmap); //将图象转成JPG格式
jpg.SaveToStream(m1); //将JPG图象写入流中
jpg.free;
m1.Position:=0;
s1:=inttostr(m1.size);
Socket.sendtext(s1); //发送图象大小
end;
if s=‘okok‘ then //客户端已准备好接收图象
begin
m1.Position:=0;
Socket.SendStream(m1); //发送JPG图象
end;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
ServerSocket1.open;
end;

end.

 
Client:
interface

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

type
TForm1 = class(TForm)
Cli1: TClientSocket;
Button1: TButton;
Button2: TButton;
Edit1: TEdit;
Label1: TLabel;
SD1: TSaveDialog;
Edit2: TEdit;
Edit3: TEdit;
Label2: TLabel;
Button3: TButton;
Button4: TButton;
Button5: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Cli1Error(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure Cli1Read(Sender: TObject; Socket: TCustomWinSocket);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
f:file;
cmd:string;
implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
cli1.Address:=edit2.Text;
cli1.Port:=8372;
cli1.Active:=true;
button1.Enabled:=false;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
if sd1.Execute then
begin

assignfile(f,sd1.FileName);
reset(f,1);
cli1.Socket.SendText(edit1.text);
end;
end;


procedure TForm1.Cli1Error(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
showmessage('error');
end;

procedure TForm1.Cli1Read(Sender: TObject; Socket: TCustomWinSocket);
var b:byte;
begin
case socket.ReceiveLength of
1:begin
socket.ReceiveBuf(b,1);
blockwrite(f,b,1);
socket.SendText('OKG');
end;
3: begin
cmd:=socket.ReceiveText;
if cmd='END' then
begin
closefile(f);
showmessage('下载完成!')
end
else if cmd='OKR' then
socket.SendText('OKS')
else if cmd='OKN' then
cli1.Socket.SendText('GET');
end;
end;
end;



procedure TForm1.Button4Click(Sender: TObject);
begin
cli1.Socket.SendText('LYF');
end;

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

type
TForm1 = class(TForm)
Ser1: TServerSocket;
procedure Ser1ClientRead(Sender: TObject; Socket: TCustomWinSocket);
procedure FormCreate(Sender: TObject);
// procedure Ser1Accept(Sender: TObject; Socket: TCustomWinSocket);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
//filename:string;
STARTread:boolean;
f:file;
cmd:string;
Filename:string;
//getFilenamemask:boolean;
implementation

{$R *.DFM}


procedure TForm1.Ser1ClientRead(Sender: TObject; Socket: TCustomWinSocket);
var b:byte;
r:integer;
begin

case socket.ReceiveLength of
3: begin
cmd:=socket.ReceiveText;
if cmd='GET' then
socket.SendText('OKR')
else if cmd='LYF' then
close
else if cmd='OKS' then
begin
assignfile(f,filename);
reset(f,1);
blockread(f,b,1,r);
socket.SendBuf(b,1)
end
else if cmd='OKG' then
begin
blockread(f,b,1,r);
if r=0 then
begin
closefile(f);
socket.SendText('END');
end
else
socket.SendBuf(b,1);
end;
end;
4..255:begin
filename:=socket.ReceiveText;
socket.SendText('OKN');
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
ser1.Port:=8372;
ser1.Active:=true;
end;

end.


 
chenlh:同意!!
 
流发送的方式我没有实现,我用的是把文件分成数据包,再发送数据包,已经成功。
 
to gototop:
你是怎样把文件分成数据包的,可以教我一下不?我现在被难住了,救救我吧!
:)
300分行不行?我最近好紧张,拜托拜托!

 
有源程序也email 我一份
xie_p_f@21cn.com
 
我刚完做一个发送的小程序,与楼上的大致相同,不过我是直接发送字符串的!
 
我刚完做一个发送的小程序,与楼上的大致相同,不过我是直接发送字符串的!
 
多人接受答案了。
 
后退
顶部