Form freezes when trying to send file over tcp/ip, Delphi 2010

289 views Asked by At

i am facing the following problem. Me and a friend of mine, have set up a wireless network using uhf data modem. When i am trying to send a file (e.g. photo) and the connection is ok there is no problem. But when i am trying to send a file and for some reason there is no connection for a while, the form freezes until there is a reestablishment. Can anyone help me please? Here is the code i use from both server and client side (Delphi 2010).

Client Side (Transmits file [this form freezes if connection is lost for a while or permanently]):

procedure TForm17.BtnSendFile(Sender: TObject);
var
 FS: TFileStream;
 filename: string;
begin 
 filetotx := 'temp.jpg';  
 FS := TFileStream.Create(filetotx, fmOpenRead, fmShareDenyWrite);
 FS.Position := 0;
  try
   Form1.IdTCPClient1.Socket.LargeStream := true;
   Form1.IdTCPClient1.Socket.WriteLn('PIC');
   Form1.IdTCPClient1.Socket.Write(FS, 0, true);
  finally
   FS.Free;
  end;
end;

Server Side (receives file)

procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
s, filename:string;
FS: TFileStream;
Jpg: TJpegImage;
begin
S := AContext.Connection.Socket.ReadLn;
if S = 'PIC' then
 begin
  filename := 'PIC_' + datetostr(date) + ' ' + timetostr(time) + '.jpg';
  filename := StringReplace(filename, '/', '-', [rfReplaceAll]);
  filename := StringReplace(filename, ':', '_', [rfReplaceAll]);
  filename := extractfilepath(Application.exename) + 'PIC\' + filename;
  FS := TFileStream.Create(filename, fmCreate);
  FS.Position := 0;
  AContext.Connection.Socket.LargeStream := true;
  AContext.Connection.Socket.ReadStream(FS);
  Jpg := TJpegImage.Create;
  FS.Position := 0;
  Jpg.LoadFromStream(FS);
  form26.image1.Picture.Assign(Jpg);
  try
   Jpg.Free;
   FS.Free;       
  finally
    //send feedback file received
   AContext.Connection.Socket.WriteLn('PICOK');
   TIdNotify.NotifyMethod(form26.Show);
  end;
end;

Client Side (receives feedback 'PICOK')

type
  TReadingThread = class(TThread)
  protected
    FConn: TIdTCPConnection;
    procedure Execute; override;
    procedure DoTerminate; override;
  public
    constructor Create(AConn: TIdTCPConnection); reintroduce;
  end;

constructor TReadingThread.Create(AConn: TIdTCPConnection);
begin
 TLog.AddMsg('Client Thread Created');
 FConn := AConn;
 inherited Create(False);
end;


procedure TReadingThread.Execute;
begin
 while not Terminated do
  begin
  if S='MSGOK' then
  .
  .
  else if S = 'PICOK' then
  begin
   Do Something
  end
  end;
 end;

procedure TReadingThread.DoTerminate;
begin
 TLog.AddMsg('Disconnected'); 
 inherited;
end;
1

There are 1 answers

2
Remy Lebeau On

Your client code is sending the file in the context of the main UI thread. That is why the UI freezes - there are no messages being processed while the send is busy. Either move that code into a worker thread (preferred), or else drop a TIdAntiFreeze component onto your Form.

Your server code is fine as far as the actual file transfer is concerned, however your try/finally block is wrong, and you are directly accessing a TImage without synchronizing with the main UI thread. You are already synchronizing when calling form26.Show, you just need to synchronize when calling form26.image1.Picture.Assign(Jpg) as well. Try this instead:

procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
  S, Filename: string;
  FS: TFileStream;
  Jpg: TJpegImage;
begin
  S := AContext.Connection.Socket.ReadLn;
  if S = 'PIC' then
  begin
    Filename := ExtractFilePath(Application.ExeName) + 'PIC\' + FormatDateTime('"PIC_"mm"-"dd"-"yyyy" "hh"_"nn"_"ss".jpg"', Now);
    FS := TFileStream.Create(Filename, fmCreate);
    try
      AContext.Connection.Socket.LargeStream := true;
      AContext.Connection.Socket.ReadStream(FS);
      FS.Position := 0;
      Jpg := TJpegImage.Create;
      try
        Jpg.LoadFromStream(FS);
        TThread.Synchronize(nil,
          procedure
          begin
            Form26.Image1.Picture.Assign(Jpg);
            Form26.Show;
          end;
        );
      finally
        Jpg.Free;
      end;
    finally
      FS.Free;       
    end;
    //send feedback file received
    AContext.Connection.Socket.WriteLn('PICOK');
  end;
end;

Or this:

type
  TMyNotify = class(TIdNotify)
  protected
    procedure DoNotify; override;
  public
    Jpg: TJpegImage;
    constructor Create;
    destructor Destroy; override;
  end;

constructor TMyNotify.Create(Stream: TStream);
begin
  inherited;
  Jpg := TJpegImage.Create;
  Jpg.LoadFromStream(Stream);
end;

destructor TMyNotify.Destroy;
begin
  Jpg.Free;
  inherited;
end;

procedure TMyNotify.DoNotify;
begin
  Form26.Image1.Picture.Assign(Jpg);
  Form26.Show;
end;

procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
  S, Filename: string;
  FS: TFileStream;
begin
  S := AContext.Connection.Socket.ReadLn;
  if S = 'PIC' then
  begin
    Filename := ExtractFilePath(Application.ExeName) + 'PIC\' + FormatDateTime('"PIC_"mm"-"dd"-"yyyy" "hh"_"nn"_"ss".jpg"', Now);
    FS := TFileStream.Create(Filename, fmCreate);
    try
      AContext.Connection.Socket.LargeStream := true;
      AContext.Connection.Socket.ReadStream(FS);
      FS.Position := 0;
      TMyNotify.Create(FS).Notify;
    finally
      FS.Free;       
    end;
    //send feedback file received
    AContext.Connection.Socket.WriteLn('PICOK');
  end;
end;