利用socket的流来收发文件(50分)

  • 主题发起人 主题发起人 whytt
  • 开始时间 开始时间
W

whytt

Unregistered / Unconfirmed
GUEST, unregistred user!
小弟刚接触delphi不久,最近看了大量的关于文件传输方面的例子,和文章,但实际操作起来却没成功,想的头都大了,希望有人可以贴出简单的文件传输方面的代码,小弟分不多,
希望可以有人来帮帮忙,万分感谢谢谢了
 
传文件可以直接用TStream或API,下面只做参考,要应用得根据情况修改。

API::
//Socket 发送文件, 利用循环来读取文件并发送
//这里发送文件只运用在阻塞模式,非阻塞模式要改进.
//Socket 发送文件, 利用循环来读取文件并发送
function SendFile(const S: TSocket; const FileName: PChar;
const H: HWND = 0; const lpWorkProc: Pointer = nil): BOOL;
var
StatusText: array[0..4095] of Char;
HF: HFILE;
Len, Size, intOffset: Integer;
SendLen: Integer;
AllSendLen: Integer;
begin
Result := False;
AllSendLen := 0;
try
//打开文件
HF := Windows._lopen(FileName, OF_EXIST or OF_READ);
if HF = HFILE_ERROR then
begin
FormatChar(StatusText, '文件:[%s]'#13#10'不存在或打开文件错误。',
[Integer(FileName)]);
if H <> 0 then MemoAdd(H, StatusText)
else ShowMessage(0, StatusText);
Exit;
end;
//文件大小
Size := Windows.GetFileSize(HF, nil);
//如果文件大小为0就退出
if Size = 0 then begin
FormatChar(StatusText, '文件:[%s]'#13#10'文件大小0。',
[Integer(FileName)]);
if H <> 0 then MemoAdd(H, StatusText)
else ShowMessage(0, StatusText);
Exit;
end;
AllSendLen := 0;
//偏移位置
intOffset := 0;
repeat
//设置读取偏移位
SetFilePointer(HF, intOffset, nil, FILE_CURRENT);
//填充BufData.FData
FillChar(StatusText, SizeOf(StatusText), #0);
//读取文件到Buf
Len := Windows._lread(HF, @StatusText, SizeOf(StatusText));
if Len <= 0 then
begin
FillChar(StatusText, SizeOF(StatusText), #0);
SendLen := Windows.GetLastError;
FormatChar(StatusText, 'read file Error Num: %d', [SendLen]);
if H <> 0 then MemoAdd(H, StatusText)
else ShowMessage(0, StatusText);
Windows._lclose(HF);
Exit;
end;

//累加偏移量
intOffset := intOffset + Len;
//复位文件
SetFilePointer(HF, 0, nil, FILE_BEGIN);

//发送数据
SendLen := send(S, StatusText, Len, 0);
if SendLen = -1 then
begin
FillChar(StatusText, SizeOF(StatusText), #0);
lstrcat(StatusText, PChar(SockErrorStr(WSAGetLastError)));
if H <> 0 then MemoAdd(H, StatusText)
else ShowMessage(0, StatusText);
Windows._lclose(HF);
Exit;
end;
if SendLen > 0 then
AllSendLen := AllSendLen + SendLen;
if (Len = SendLen) and (lpWorkProc <> nil)then
asm
PUSH intOffset
CALL lpWorkProc
end;

until intOffset >= Size;
Windows._lclose(HF);
Result := intOffset >= Size;
finally
if H <> 0 then begin
//回显文件发送完成
FormatChar(StatusText, '文件:[%s],大小[%d Byte] 发送大小:[%d Byte] 错误发送[%d Byte],发送到:[%s]已完成。',
[Integer(FileName), Size, AllSendLen, Size - AllSendLen, Integer(GetRemoteHost(S))]);
MemoAdd(H, StatusText)
end;
end;
end;

//写入文件
function WriteFile(HF: HFILE; var Buf; const Count: Integer; const FileName: PChar): Integer;
begin
Result := 0;
if HF <> HFILE_ERROR then
begin
//定位尾部
Windows.SetFilePointer(HF, 0, nil, FILE_END);
//写入文件
Windows._lwrite(HF, @Buf, Count);
Windows.SetFilePointer(HF, 0, nil, FILE_BEGIN);
Result := Windows.GetFileSize(HF, nil);
//关闭
//._lclose(HF);
end;
end;

//接收文件
function ReceiveFile(const Socket: TSocket; const FileName: PChar): Integer;
var
Buf: array[0..4095] of Char;
ReadLen: Integer;
HF: HFILE;
begin
HF := Windows.CreateFile(FileName, GENERIC_READ or GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE, nil, IDND_FRIGHT[ExistsFile(FileName)], FILE_ATTRIBUTE_NORMAL, 0);
Result := -1;
if HF = HFILE_ERROR then Exit;
try
FillChar(Buf, SizeOf(Buf), #0);
ReadLen := ReceiveBuf(Socket, Buf, SizeOf(Buf));
while ReadLen > 0 do
begin
Result := WriteFile(HF, Buf, ReadLen, PChar(FileName));
FillChar(Buf, SizeOf(Buf), #0);
ReadLen := ReceiveBuf(Socket, Buf, SizeOf(Buf));
end;
finally
Windows._lclose(HF);
end;
end;

用文件流就更简单了。
 
顺便问一下,用内存流可以做吗,内存流有没有大小限制呢
 
这个我知道,内存流发的东西大了的话,容易丢数据
 
文件流的方法,该怎么做呢~
期待~~
 
贴子结了,那里还看得到呀?现在补上了。
用文件流的。

{***************************************************************}
{ }
{ PraiseSoft SoftWare System }
{ Copyright(c) 2004-2005 PraiseSoft Software Corporation }
{ SoftWareName: VCL WinSocket Upload/Download file }
{ Version: V1.0 }
{ DevIDE: Delphi7.0 Windows 2000 Professional }
{ Build: 2006-01 }
{ Author: jfyes }
{ Function: }
{ Description: }
{ Noteice: 1.本信息资料仅用于个人和非商业用途,复制请保留此信息,
未经作者书面许可,不得作任商业用途。}

{***************************************************************}

unit Unit1;

interface

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

type
TForm1 = class(TForm)
ClientSocket1: TClientSocket;
ServerSocket1: TServerSocket;
Button1: TButton;
Button2: TButton;
GetDir: TButton;
Memo1: TMemo;
Edit1: TEdit;
FileListBox1: TFileListBox;
Edit2: TEdit;
Edit3: TEdit;
Label1: TLabel;
OpenDialog1: TOpenDialog;
procedure FormCreate(Sender: TObject);
procedure GetDirClick(Sender: TObject);
procedure ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
procedure Memo1ContextPopup(Sender: TObject; MousePos: TPoint;
var Handled: Boolean);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

uses Unit2, Math;

{$R *.dfm}
type
TDataType = (dtString, dtDownFile, dtUploadFile);

const
IDS_THEEND = '/THEEND';

var
DataType: TDataType;
FileStream: TFileStream;
Save: TFileStream = nil;
TotalLen: Integer;
IsPostFile: Boolean = False;
PostFileName: string;

procedure TForm1.FormCreate(Sender: TObject);
begin
Edit2.Clear;
ServerSocket1.Open;
ClientSocket1.Open;
end;

procedure TForm1.GetDirClick(Sender: TObject);
begin
DataType := dtString;
ClientSocket1.Socket.SendText('DIR:'+ Edit1.Text);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
DataType := dtDownFile;
FileStream := nil;
ClientSocket1.Socket.SendText('File:'+ Edit2.Text);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
DataType := dtUploadFile;
if OpenDialog1.Execute then begin
FileStream := TFileStream.Create(OpenDialog1.FileName, fmOpenRead or fmShareDenyNone);
ClientSocket1.Socket.SendText(Format('PostFileSize%12dD:/Upload/%s', [FileStream.Size, ExtractFileName(OpenDialog1.FileName)]));
end;
end;

function GetDriver: string;
var
X: Char;
Dir: string;
begin
Result := '';
for X := 'A' to 'Z' do
begin
Dir := X + ':/';
case GetDriveType(PChar(Dir)) of
DRIVE_REMOVABLE: Result := Result + Format('%s REMOVABLE'#13#10, [Dir]);
DRIVE_FIXED: Result := Result + Format('%s FIXED'#13#10, [Dir]);
DRIVE_REMOTE: Result := Result + Format('%s REMOTE'#13#10, [Dir]);
DRIVE_CDROM: Result := Result + Format('%s CDROM'#13#10, [Dir]);
DRIVE_RAMDISK: Result := Result + Format('%s RAMDISK'#13#10, [Dir]);
end;
end;
end;

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
Buf: array[0..4095]of Char;
S: string;
Len, I: Integer;
Dir: string;
X: Char;
begin
//上传标识
if IsPostFile then begin
//创建文件
if Save = nil then Save := TFileStream.Create(PostFileName, fmCreate or fmOpenWrite);
//填充buf
FillChar(Buf, SizeOf(Buf), #0);
//读取buf
Len := Socket.ReceiveBuf(Buf, SizeOf(Buf));
//写入流
Save.WriteBuffer(Buf, Len);
//上传完毕
if Save.Size = TotalLen then
begin
//修改标识
IsPostFile := False;
//写入文件
Save.Free;
Save := nil;
//确认上传完毕
Socket.SendText(Format('PostOK%s, %2.2fKB', [PostFileName, Roundto(TotalLen / 1024, -2)]));
end;
end else begin
//接收相关参数 
S := Socket.ReceiveText;

//分析参数 接收上传文件
if Copy(S, 1, 8) = 'PostFile' then begin
//标识上传 
IsPostFile := True;
//将流置nil
Save := nil;
// 'PostFileSize%12dD:/Upload/%s'
//取得文件大小
TotalLen := StrToInt(Trim(Copy(S, 13, 12)));
//取得上传文件FullName
PostFileName := Copy(S, 25, MAX_PATH);
//通知ClientSocket发送文件
Socket.SendText('Posting');
end
//获取文件目录
else if Copy(S, 1, 3) = 'DIR' then
begin
//取盘符
if Copy(S, 5, 1) = '.' then
S := GetDriver
else begin
Dir := Copy(S, 5, Length(S));
if not DirectoryExists(Dir) then
S := '目录不存在:' + Dir
else begin
FileListBox1.Directory := Dir;
S := '';
for I := 0 to FileListBox1.Items.Count - 1 do begin
S := S + Format('%s/%s'#13#10, [Dir, FileListBox1.Items]);
end;
end;
end;
Socket.SendText(S + IDS_THEEND);
end
//发送下载文件
else if Copy(S, 1, 4) = 'File' then
begin
Dir := Copy(S, 6, Length(S));
if FileStream = nil then
begin
if not FileExists(Dir) then Exit;
FileStream := TFileStream.Create(Dir, fmOpenRead or fmShareDenyNone);
I := FileStream.Size;
//发送文件长度
Socket.SendBuf(I, SizeOf(Integer));
end
else if Copy(S, 5, 2) = 'OK' then begin
//发送文件 但要将流置nil
Socket.SendStream(FileStream);
//因为FileStream已经在发送后就Free 将流置nil
if FileStream <> nil then
FileStream := nil;
end; //else if Copy(S, 5, 2) = 'OK' then begin
end; //if Copy(S, 1, 4) = 'File' then

end;
end;

function IsThenEnd(const Buf: PChar): BOOL;
var P: PChar;
begin
Result := False;
P := StrRScan(Buf, '/');
if P <> nil then
Result := p = IDS_THEEND;
end;

var
List: string = '';
procedure TForm1.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
var
Len: Integer;
s: string;
Buf, P: array[0..4095]of Char;
FileName: string;
//c:/winnt/system32
begin
case DataType of
dtUploadFile: begin
s := Socket.ReceiveText;
if Copy(s, 1, 6) = 'PostOK' then
Memo1.Lines.Add(s)
else if s = 'Posting' then
if FileStream <> nil then
Socket.SendStream(FileStream);
end;
dtString: begin
s := Socket.ReceiveText;
List := List + s;
if IsThenEnd(PChar(S)) then
begin
List := Copy(List, 1, Length(List) - Length(IDS_THEEND));
Memo1.Lines.Add(Format('总长度:%d'#13#10'%s', [Length(List), List]));
List := '';
end;
end; //dtString: begin
dtDownFile: begin
FillChar(Buf, SizeOf(Buf), #0);
Len := Socket.ReceiveBuf(Buf, SizeOf(Buf));
if Len = SizeOf(Integer) then begin
System.Move(Buf, TotalLen, SizeOf(Integer));
FileName := Edit3.Text + ExtractFileName(Edit2.Text);
if Save = nil then
Save := TFileStream.Create(FileName, fmCreate or fmOpenWrite);
Socket.SendText('FileOK');
end
else
Save.WriteBuffer(Buf, Len);
if Save.Size = TotalLen then begin
Save.Free;
Save := nil;
Memo1.Lines.Add(Format('保存完毕!大小:%2.2fKB %s',
[Roundto(TotalLen / 1024, -2), Edit3.Text + ExtractFileName(Edit2.Text)]));
end;
end; //dtFile: begin
end; // case datatype of
end;

procedure TForm1.Memo1ContextPopup(Sender: TObject; MousePos: TPoint;
var Handled: Boolean);
begin
Edit2.Text := Memo1.SelText;
end;

end.


//===============
// dfm
object Form1: TForm1
Left = 280
Top = 173
BorderIcons = [biSystemMenu, biMinimize]
BorderStyle = bsSingle
Caption = 'Form1'
ClientHeight = 437
ClientWidth = 502
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 275
Top = 56
Width = 48
Height = 13
Caption = #19979#36733#30446#24405
end
object Button1: TButton
Left = 16
Top = 48
Width = 75
Height = 25
Caption = #19979#36733#25991#20214
TabOrder = 0
OnClick = Button1Click
end
object Button2: TButton
Left = 408
Top = 48
Width = 75
Height = 25
Caption = #19978#20256#25991#20214
TabOrder = 1
OnClick = Button2Click
end
object GetDir: TButton
Left = 16
Top = 16
Width = 75
Height = 25
Caption = #33719#21462#30446#24405
TabOrder = 2
OnClick = GetDirClick
end
object Memo1: TMemo
Left = 16
Top = 80
Width = 467
Height = 337
ImeName = #19975#33021#20116#31508'EXE'#22806#25346#29256
Lines.Strings = (
'Memo1')
ScrollBars = ssBoth
TabOrder = 3
OnContextPopup = Memo1ContextPopup
end
object Edit1: TEdit
Left = 96
Top = 16
Width = 385
Height = 21
ImeName = #19975#33021#20116#31508'EXE'#22806#25346#29256
TabOrder = 4
Text = 'D:/DELPHI7/Delphi2005-11/'#32593#32476#31243#24207'/PNetTest'
end
object FileListBox1: TFileListBox
Left = 240
Top = 104
Width = 193
Height = 233
FileType = [ftReadOnly, ftHidden, ftSystem, ftVolumeID, ftDirectory, ftArchive, ftNormal]
ImeName = #19975#33021#20116#31508'EXE'#22806#25346#29256
ItemHeight = 13
TabOrder = 5
Visible = False
end
object Edit2: TEdit
Left = 96
Top = 50
Width = 177
Height = 21
ImeName = #19975#33021#20116#31508'EXE'#22806#25346#29256
TabOrder = 6
Text = 'Edit2'
end
object Edit3: TEdit
Left = 328
Top = 48
Width = 73
Height = 21
ImeName = #19975#33021#20116#31508'EXE'#22806#25346#29256
TabOrder = 7
Text = 'D:/Download/'
end
object ClientSocket1: TClientSocket
Active = True
Address = '127.0.0.1'
ClientType = ctNonBlocking
Port = 2222
OnRead = ClientSocket1Read
Left = 112
Top = 160
end
object ServerSocket1: TServerSocket
Active = False
Port = 2222
ServerType = stNonBlocking
OnClientRead = ServerSocket1ClientRead
Left = 184
Top = 168
end
object OpenDialog1: TOpenDialog
Filter = 'all file (*.*)|*.*'
Left = 528
Top = 8
end
end
 
恩,谢谢拉,嘿嘿
以后记住该怎么做了
 
后退
顶部