使用TIdTCPServer和TIdTCPClient实现双向通信的安全方法

时间:2014-12-17 13:09:29

标签: delphi tcp indy

构建客户端/服务器应用程序,客户端只与一台服务器通信(客户端之间没有通信)。

当我需要从服务器向客户端发送文件时,首先我发送一个字符串命令来指示客户端向服务器询问该文件。

考虑到服务器只会在给定时间与一个客户端通信,客户端之间没有通信,我连接的客户端很少(少于50个),问题是:

  • 我可以在OnExecute事件之外从服务器向客户端发送字符串消息吗?
  • 我的方法安全吗?

服务器

//==============================================================================
// 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;
//==============================================================================

提前致谢!

0 个答案:

没有答案