构建客户端/服务器应用程序,客户端只与一台服务器通信(客户端之间没有通信)。
当我需要从服务器向客户端发送文件时,首先我发送一个字符串命令来指示客户端向服务器询问该文件。
考虑到服务器只会在给定时间与一个客户端通信,客户端之间没有通信,我连接的客户端很少(少于50个),问题是:
服务器
//==============================================================================
// Server Execute procedure
//==============================================================================
procedure TfrmMain.TCPServerExecute(AContext: TIdContext);
var
Cmd: string;
Date: TDateTime;
Timestamp: string;
Stream: TMemoryStream;
begin
Cmd := AContext.Connection.IOHandler.ReadLn;
Date := Now;
Timestamp := FormatDateTime('yyyymmdd_hhmmss', Date);
if Cmd = 'send_file' then
begin
try
Stream := TMemoryStream.Create;
try
AContext.Connection.IOHandler.ReadStream(Stream, -1, False);
Stream.Position := 0;
Stream.SaveToFile(ExtractFilePath(Application.ExeName) +
'\recv_test' + Timestamp + '.dat');
except on E: Exception do
Log('Error loading file: ' + E.ClassName + ' - ' + E.Message);
end;
finally
Stream.Free;
end;
end else if Cmd = 'recv_file' then
begin
try
Stream := TMemoryStream.Create;
try
Stream.LoadFromFile(ExtractFilePath(Application.ExeName) + 'test.dat');
Stream.Position := 0;
AContext.Connection.IOHandler.WriteLn('send_file');
AContext.Connection.IOHandler.Write(Stream, 0, True);
except on E: Exception do
Log('Error sending file: ' + E.ClassName + ' - ' + E.Message);
end;
finally
Stream.Free;
end;
end;
end;
//==============================================================================
// Server send file button
//==============================================================================
procedure TfrmMain.btnSendFileClick(Sender: TObject);
var
List: TList;
ip: string;
I: Integer;
Context: TIdContext;
Stream: TMemoryStream;
begin
// lvwPCList is a ListView on my form...
// Do I need to use TThread.Queue to safety access this component?
ip := GStack.ResolveHost(lvwPCList.Selected.Caption);
try
List := TCPServer.Contexts.LockList;
for I := 0 to List.Count - 1 do
begin
Context := TIdContext(List[I]);
if Context.Connection.Socket.Binding.PeerIP = ip then
begin
Context.Connection.IOHandler.WriteLn('send_file');
try
Stream := TMemoryStream.Create;
try
Stream.LoadFromFile(ExtractFilePath(Application.ExeName) + 'test.dat');
Stream.Position := 0;
Context.Connection.IOHandler.Write(Stream, 0, True);
except on E: Exception do
Log('Error sending file: ' + E.ClassName + ' - ' + E.Message);
end;
finally
Stream.Free;
end;
Break;
end;
end;
finally
TCPServer.Contexts.UnlockList;
end;
end;
//==============================================================================
// Server get file button
//==============================================================================
procedure TfrmMain.btnGetFileClick(Sender: TObject);
var
List: TList;
IP: string;
I: Integer;
Context: TIdContext;
begin
IP := GStack.ResolveHost(lvwPCList.Selected.Caption);
try
List := TCPServer.Contexts.LockList;
for I := 0 to List.Count - 1 do
begin
Context := TIdContext(List[I]);
if Context.Connection.Socket.Binding.PeerIP = IP then
begin
Context.Connection.IOHandler.WriteLn('recv_file');
// After send the string command 'recv_file', the server
// will receive the actual file sending by client on the execute event...
Break;
end;
end;
finally
TCPServer.Contexts.UnlockList;
end;
end;
//==============================================================================
客户端
//==============================================================================
procedure ThreadActionStart;
var
ThreadAction: TThreadAction;
begin
ThreadAction := TThreadAction.Create(True);
ThreadAction.FreeOnTerminate := True;
ThreadAction.Priority := tpNormal;
ThreadAction.Start;
end;
//==============================================================================
procedure TThreadAction.Execute;
var
Cmd: string;
Date: TDateTime;
Timestamp: string;
Stream: TMemoryStream;
begin
while frmMain.IdTCPClient.Connected do
begin
try
cmd := frmMain.IdTCPClient.IOHandler.ReadLn;
TThread.Queue( nil,
procedure
begin
frmMain.lstMessages.Items.Add(cmd);
end
);
Date := Now;
Timestamp := FormatDateTime('yyyymmdd_hhmmss', Date);
if Cmd = 'send_file' then
begin
try
Stream := TMemoryStream.Create;
try
frmMain.IdTCPClient.IOHandler.ReadStream(Stream, -1);
Stream.Position := 0;
Stream.SaveToFile(ExtractFilePath(Application.ExeName) +
'\recv_test' + Timestamp + '.dat');
except on E: Exception do
Log('Error loading file: ' + E.ClassName + ' - ' + E.Message);
end;
finally
Stream.Free;
end;
end else if Cmd = 'recv_file' then
begin
try
Stream := TMemoryStream.Create;
try
Stream.LoadFromFile(ExtractFilePath(Application.ExeName) + 'test.dat');
Stream.Position := 0;
frmMain.IdTCPClient.IOHandler.WriteLn('send_file');
frmMain.IdTCPClient.IOHandler.Write(Stream, 0, True);
except on E: Exception do
Log('Error sending file: ' + E.ClassName + ' - ' + E.Message);
end;
finally
Stream.Free;
end;
end;
except
Log('Error reading from server');
end;
end;
end;
//==============================================================================
procedure TfrmMain.btnGetFileClick(Sender: TObject);
begin
frmMain.IdTCPClient.IOHandler.WriteLn('recv_file');
end;
//==============================================================================
procedure TfrmMain.btnSendFileClick(Sender: TObject);
var
Stream: TMemoryStream;
begin
try
frmMain.IdTCPClient.IOHandler.WriteLn('send_file');
Stream := TMemoryStream.Create;
try
Stream.LoadFromFile(ExtractFilePath(Application.ExeName) + 'test.dat');
Stream.Position := 0;
frmMain.IdTCPClient.IOHandler.Write(Stream, 0, True);
except on E: Exception do
Log('Error sending file: ' + E.ClassName + ' - ' + E.Message);
end;
finally
Stream.Free;
end;
end;
//==============================================================================
procedure TfrmMain.FormCreate(Sender: TObject);
begin
try
IdTCPClient.Host := '192.168.0.20';
IdTCPClient.Port := 4545;
IdTCPClient.Connect;
except
Log('Connection error');
end;
end;
//==============================================================================
procedure TfrmMain.IdTCPClientConnected(Sender: TObject);
begin
try
ThreadActionStart;
except
Log('Error - Thread not started');
end;
end;
//==============================================================================
提前致谢!