Form freezes when trying to send file via tcp / ip, Delphi 2010
I am facing the following problem. My friend and I have created a wireless network using a UHF data modem. When I try to send a file (like a photo) and the connection is ok, no problem. But when I try to send a file and for some reason there is no connection for a while, the form freezes until it is restored. Can anyone help me? Here is the code I am using from both server and client side (Delphi 2010).
Client side (uploads the file [this form hangs if the connection is lost for some time 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 (receive 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 "PICOK" feedback)
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;
source to share
The client code uploads the file in the context of the main UI thread. This is why the UI hangs - there are no messages being processed in the sending process. Either move this code to the workflow (preferred) or add the component TIdAntiFreeze
to your form.
The server code is fine prior to the actual file transfer, but your block try/finally
is wrong and you are accessing directly TImage
without syncing with the main UI thread. You are already syncing on call form26.Show
, you just need to sync on call form26.image1.Picture.Assign(Jpg)
. 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 that:
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;
source to share