下面是我以前从大富翁抄来的，不过忘记是谁了，代码很有效，是传文件的。
利用serversocket的sendstream关键是多次触发OnRead事件。
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;
Button2: TButton;
ss: TServerSocket;
Memo1: TMemo;
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) ;
Memo1.Lines.add(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 := 0;
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.
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ScktComp;
type
TForm2 = class(TForm)
OpenDialog1: TOpenDialog;
Memo1: TMemo;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Label1: TLabel;
Edit1: TEdit;
cs: TClientSocket;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button4Click(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(FileName));
Label1.Caption := FileName;
cs.Socket.SendText(edit1.Text);
end;
end;
end;
procedure TForm2.Button2Click(Sender: TObject);
begin
CS.Active := True;
end;
procedure TForm2.Button4Click(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.
