我試著自己寫了一個多線程傳送文件的程式﹐能編譯通過﹐問題就是不知道為什么不能跑到Server端去﹗
下面是源碼﹐很簡單的﹐請大蝦幫我看看。我所用的控件名稱都沒有改的﹐所以你要調試也很方便。但是要將ClientSocket1的ClientType設為ctBlocking,ServerSocket1的ServerType設為stThreadBlocking。
還有﹐我也知道這個程序現在還不能在不同機器間傳送﹐這都沒有關系﹐我只要能在同一台上傳送文件就行了﹗
問題一旦搞掂﹐共200分相送!
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ScktComp;
type
TForm1 = class(TForm)
ClientSocket1: TClientSocket;
ServerSocket1: TServerSocket;
Button1: TButton;
OpenDialog1: TOpenDialog;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure ServerSocket1GetThread(Sender: TObject;
ClientSocket: TServerClientWinSocket;
var SocketThread: TServerClientThread);
private
{ Private declarations }
public
{ Public declarations }
end;
ClientStread=class(TThread)
protected
procedure GetFileFromStream;
procedure Execute;override;
end;
ServerStread=class(TServerClientThread)
public
procedure ClientExecute;override;
end;
var
Form1: TForm1;
FF: String;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
ServerSocket1.Active:=True;
ClientSocket1.Active:=False;
end;
{ TClientStread }
procedure ClientStread.Execute;
begin
inherited;
FreeOnTerminate:= True;
Synchronize(GetFileFromStream);
end;
procedure ClientStread.GetFileFromStream;
var
S: TWinSocketStream;
F: TFileStream;
FN: String;
// Buf: Pointer;
begin
with Form1.OpenDialog1 do
begin
Execute;
if FileName<>'' then
begin
FN:=FileName;
FF:=ExtractFileName(FN);
Form1.ClientSocket1.Host:='172.17.8.205';
Form1.ClientSocket1.Active:=True;
S:=TWinSocketStream.Create(Form1.ClientSocket1.Socket,60000);
F:=TFileStream.Create(FN,fmOpenRead or fmShareDenyNone);
try
S.CopyFrom(F,0);
{ GetMem(Buf,F.size);
F.Seek(0,soFromBeginning);
F.ReadBuffer(Buf^,F.Size); }
finally
S.Free;
F.Free;
// Form1.ClientSocket1.Active:=False;
end; //End Try
end; //End if FileName<>'' then
end; //End with Form1.OpenDialog1 do
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ClientStread.Create(False);
end;
{ ServerStread }
procedure ServerStread.ClientExecute;
var
RBuf: Array [0..4095] of char;
S: TWinSocketStream;
F: TFileStream;
BytesRead:Integer;
begin
inherited;
While (not Terminated) and (ClientSocket.Connected) do
begin
try
S:= TWinSocketStream.Create(ClientSocket,60000);
F:= TFileStream.Create('C:/'+FF,fmCreate);
try
FillChar(RBuf,10,0);
if S.WaitForData(5000) then
Repeat
BytesRead:=S.Read(RBuf,SizeOf(RBuf));
if BytesRead=0 then
ClientSocket.Close
else F.WriteBuffer(RBuf,BytesRead);
Until Not S.WaitForData(2000);
finally
S.Free;
ClientSocket.Close;
F.Free;
end; //End try finally
except
HandleException;
end; //End try except
end;
end;
procedure TForm1.ServerSocket1GetThread(Sender: TObject;
ClientSocket: TServerClientWinSocket;
var SocketThread: TServerClientThread);
begin
SocketThread:= TServerClientThread.Create(False,ClientSocket);
end;
end.
