发信人: finlove (荒野之狼), 信区: BorlandDev
标  题: TClientSocket/TServerSocket传文件的例子 
发信站: 哈工大紫丁香 (Tue Jan 22 12:43:57 2002) , 转信

TClientSocket/TServerSocket传文件的例子 
 

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) 
SS: TServerSocket; 
Button1: TButton; 
Button2: TButton; 
procedure Button1Click(Sender: TObject); 
procedure SSClientConnect(Sender: TObject; Socket: TCustomWinSocket); 
procedure SSClientRead(Sender: TObject; Socket: TCustomWinSocket); 
procedure Button2Click(Sender: TObject); 
private 
{ Private declarations } 
public 
{ Public declarations } 
end; 

var 
Form1: TForm1; 

implementation 

uses Unit2; 

{$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.FileNam
e))); 
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; 

procedure TForm1.Button2Click(Sender: TObject); 
begin 
Form2.Show; 
end; 

end. 




------------------------------------------------------------------------------
-- 
来自：唐晓锋 时间：99-11-30 01:17:19 ID:162654 
unit Unit2; 

interface 

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

type 
TForm2 = class(TForm) 
CS: TClientSocket; 
OpenDialog1: TOpenDialog; 
Memo1: TMemo; 
Button1: TButton; 
Edit1: TEdit; 
Button2: TButton; 
SendCommand: TButton; 
Label1: TLabel; 
Button3: TButton; 
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 
Form2: TForm2; 

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 TForm2.Button1Click(Sender: TObject); 
begin 
with OpenDialog1 do 
begin 
Execute; 
if FileName <> '' then 
begin 
Edit1.Text := 'UPLOAD '+ ExtractFileName(FileName) +' '+Inttostr(GetFileSize(F
ileName)); 
Label1.Caption := FileName; 
cs.Socket.SendText(edit1.Text); 
end; 
end; 
end; 

procedure TForm2.Button2Click(Sender: TObject); 
begin 
CS.Active := True; 

end; 

procedure TForm2.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 TForm2.Button3Click(Sender: TObject); 
begin 
cs.Close; 
end; 

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

Memo1.Lines.add(socket.receiveText); 

end; 

end. 





--

※ 来源:．哈工大紫丁香 http://bbs.hit.edu.cn [FROM: 211.97.214.52]