贴子结了,那里还看得到呀?现在补上了。
用文件流的。
{***************************************************************}
{ }
{ 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