Synapse blockiert

Alle Fragen zur Netzwerkkommunikation
Antworten
leosok
Beiträge: 24
Registriert: Mi 10. Nov 2010, 01:12

Synapse blockiert

Beitrag von leosok »

Hallo,

wenn ich folgenden Code von meinem Main-Form aus ausführe, blockiert das ganze Programm für einen Moment, selbst, nachdem ich das "sleep" rausgenommen habe. Normalerweise ist doch ein anderes Formular autoatisch ein anderer Thread, oder irre ich mich da? Könnte es helfen, diese Procedure in einem eigenen Thread auszuführen? Danke,

leosok


Code: Alles auswählen

function Tform_console.DownloadHTTP(URL:string; amemo: Tmemo): boolean;
// Download file; retry if necessary.
// Deals with SourceForge download links
// Could use Synapse HttpGetBinary, but that doesn't deal
// with result codes (i.e. it happily downloads a 404 error document)
const
  MaxRetries=3;
var
  HTTPGetResult: boolean;
  HTTPSender: THTTPSend;
  RetryAttempt: integer;
 
begin
  result:=false;
  RetryAttempt:=1;
  //Optional: mangling of Sourceforge file download URLs; see below.
  //URL:=SourceForgeURL(URL); //Deal with sourceforge URLs
  HTTPSender:=THTTPSend.Create;
  try
    try
      // Try to get the file
      HTTPGetResult:=HTTPSender.HTTPMethod('GET', URL);
      while (HTTPGetResult=false) and (RetryAttempt<MaxRetries) do
      begin
 
 
          // sleep(500*RetryAttempt);
          // Application.ProcessMessages;
 
        HTTPGetResult:=HTTPSender.HTTPMethod('GET', URL);
        RetryAttempt:=RetryAttempt+1;
      end;
      // If we have an answer from the server, check if the file
      // was sent to us.
      case HTTPSender.Resultcode of
        100..299:
          begin
            amemo.lines.LoadFromStream(HTTPSender.Document);
            result:=true;
          end;
 
         //informational, success
        300..399: result:=false; //redirection. Not implemented, but could be.
        400..499: result:=false; //client error; 404 not found etc
        500..599: result:=false; //internal server error
        else result:=false; //unknown code
      end;
    except
      // We don't care for the reason for this error; the download failed.
      result:=false;
    end;
  finally
    HTTPSender.Free;
  end;
end;

Benutzeravatar
theo
Beiträge: 10467
Registriert: Mo 11. Sep 2006, 19:01

Re: Synapse blockiert

Beitrag von theo »

Ja, Synapse blockiert

Ararat Synapse hat geschrieben:This project deals with network communication by means of blocking (synchronous) sockets


leosok hat geschrieben:Normalerweise ist doch ein anderes Formular autoatisch ein anderer Thread

Nein, war es noch nie.

leosok hat geschrieben: Könnte es helfen, diese Procedure in einem eigenen Thread auszuführen?

Absolut.

MmVisual
Beiträge: 1445
Registriert: Fr 10. Okt 2008, 23:54
OS, Lazarus, FPC: Winuxarm (L 3.0 FPC 3.2)
CPU-Target: 32/64Bit

Re: Synapse blockiert

Beitrag von MmVisual »

Ich habe Synapse ein wenig modifiziert. Jetzt hat die Komponente ein "OnReceive" Event. Ist zwar immer noch kein eigener Thread, aber
- Man erhält ein Event mit dem man ein Fortschrittsbalken bedienen kann
- Ein Application.Processmessage ist drin mit dem die App mehrmals pro Sekunde "Bedienbar" ist. Man merkt aber schon dass die EXE leicht hinkt.
Das war sozusagen meine "Notlösung" für selten stattfindende Downloads.

Anbei der von mir geänderte Synapse Code:
Synapse.zip
(35.15 KiB) 70-mal heruntergeladen


Im Zip sind nur die geänderten Dateien, die restlichen Dateien sind im ZIP von der Synapse-Homepage "synapse40.zip".
http://synapse.ararat.cz/doku.php/download


Hier der Code in meinem Formular:

Code: Alles auswählen

// Der Aufruf:
  bStop := False;
  stMem := TMemoryStream.Create;
  b := HttpGetBinary('http://DeinDownload.zipzap', stMem, @OnReceive);
 
// Das Event
procedure TForm1.OnReceive(Sender: TObject);
Var m: Integer;
begin
  If Sender Is THTTPSend Then
  Begin
    iSize := THTTPSend(Sender).DownloadSize;
    If THTTPSend(Sender).DownloadSize = 0 Then
      m := THTTPSend(Sender).Document.Size
    Else m := THTTPSend(Sender).DownloadSize - THTTPSend(Sender).Document.Size;
    If m <= 0 Then
      lbDL.Caption := '0 Byte'
    Else If m < 1024 Then
      lbDL.Caption := IntToStr(m) + ' Byte'
    Else If m < (1024 * 1024) Then
      lbDL.Caption := FormatFloat('0.0', m / 1024) + ' KB'
    Else lbDL.Caption := FormatFloat('0.0', m / 1048576) + ' MB';
    Application.ProcessMessages;
    If bStop Then // Abbruch Download
      THTTPSend(Sender).Sock.CloseSocket;
  end;
end;
EleLa - Elektronik Lagerverwaltung - www.elela.de

creed steiger
Beiträge: 957
Registriert: Mo 11. Sep 2006, 22:56

Re: Synapse blockiert

Beitrag von creed steiger »


Benutzeravatar
theo
Beiträge: 10467
Registriert: Mo 11. Sep 2006, 19:01

Re: Synapse blockiert

Beitrag von theo »

Funzt das Hertbeat Feature wirklich immer?
Ich meine, auch wenn nur gewartet wird (lahmer DNS Lookup etc.) oder bei Netzwerkproblemen?

creed steiger
Beiträge: 957
Registriert: Mo 11. Sep 2006, 22:56

Re: Synapse blockiert

Beitrag von creed steiger »

theo hat geschrieben:Funzt das Hertbeat Feature wirklich immer?
Ich meine, auch wenn nur gewartet wird (lahmer DNS Lookup etc.) oder bei Netzwerkproblemen?


Bei meinen SNMP-Abfragen hatte ich noch keine Probleme (z.B. Gerät nicht eingeschaltet).
Allerdings sind das nur ca.10 Geräte und fällt evtl. nicht so auf.
Ich schau morgen mal welchen Intervall ich gewählt habe.

Heartbeat is a feature that allows your code to be called back from many places:

during data transfers

when you are waiting for data

Heartbeats are periodical. If you set hearbeat frequency to twice per second and Synapse spends 2 seconds waiting for data, then heartbeat occurs four times, e.g. each half-second.

leosok
Beiträge: 24
Registriert: Mi 10. Nov 2010, 01:12

Re: Synapse blockiert

Beitrag von leosok »

Vielen Dank!

Ich habe es mitlerweile mit Threads gelöst. Funktioniert ausgezeichnet. So sieht meine Thread-Unit aus:

Code: Alles auswählen

unit http_download_thread;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils;
 
type
{ TMyThread }
 
  TMyThread = class(TThread)
  private
    fUrl: string;
    fHtml_reslut: Tstringlist;
    fcallback: pointer;
    procedure push_downloaded;
    function DownloadHTTP(URL:string) : boolean;
  protected
    procedure Execute; override;
  public
    constructor Create(CreateSuspended: boolean; cUrl:string);
  end;
 
 procedure DownloadHttp(Url:string);
 
 
implementation
 
uses unit1,web_io_main, httpsend;
var MyThread: TMyThread;
 
{ TMyThread }
 
 
 
function TMyThread.DownloadHTTP(URL:string):boolean;
// Download file; retry if necessary.
// Deals with SourceForge download links
// Could use Synapse HttpGetBinary, but that doesn't deal
// with result codes (i.e. it happily downloads a 404 error document)
const
  MaxRetries=3;
var
  HTTPGetResult: boolean;
  HTTPSender: THTTPSend;
  RetryAttempt: integer;
  my_stream : TMemoryStream;
begin
  result:=false;
  RetryAttempt:=1;
  //Optional: mangling of Sourceforge file download URLs; see below.
  //URL:=SourceForgeURL(URL); //Deal with sourceforge URLs
  HTTPSender:=THTTPSend.Create;
  try
    try
      // Try to get the file
      HTTPGetResult:=HTTPSender.HTTPMethod('GET', URL);
      while (HTTPGetResult=false) and (RetryAttempt<MaxRetries) do
      begin
        sleep(500*RetryAttempt);
        HTTPGetResult:=HTTPSender.HTTPMethod('GET', URL);
        RetryAttempt:=RetryAttempt+1;
      end;
      // If we have an answer from the server, check if the file
      // was sent to us.
      case HTTPSender.Resultcode of
        100..299:
          begin
            fHtml_reslut.LoadFromStream(HTTPSender.Document);
            result:=true;
          end;
 
         //informational, success
        300..399: result:=false; //redirection. Not implemented, but could be.
        400..499: result:=false; //client error; 404 not found etc
        500..599: result:=false; //internal server error
        else result:=false; //unknown code
      end;
    except
      // We don't care for the reason for this error; the download failed.
      result:=false;
    end;
  finally
    HTTPSender.Free;
  end;
end;
 
 
procedure TMyThread.push_downloaded;
// Hier kommt alles rein, was passiert, wenn der Download fertig ist!
begin
 
form_console.MemoHTML.lines:= fHtml_reslut;
form_console.MemoHTML.Text:= StringReplace(form_console.MemoHTML.Text,'%',#13+' - ',[rfReplaceAll]);
 
{$ifdef Win32}
  Form1.TrayIcon_win.BalloonHint:=form_console.MemoHTML.Text;
{$else}
  Form1.TrayIcon_mac.BalloonHint:=form_console.MemoHTML.Text;
{$endif}
 
end;
 
procedure TMyThread.Execute;
begin
 
  fHtml_reslut := TStringList.Create;
  if DownloadHTTP(fUrl) = true then  Synchronize(@push_downloaded);
 
end;
 
constructor TMyThread.Create(CreateSuspended: boolean; cUrl:string);
begin
  FreeOnTerminate := True;
  fUrl:=cUrl;
  inherited Create(CreateSuspended);
end;
 
 
procedure DownloadHttp(Url:string);
begin
   MyThread := TMyThread.Create(True,Url); // This way it doesn't start automatically
   MyThread.Resume;
end;
 
 
end.

mschnell
Beiträge: 3444
Registriert: Mo 11. Sep 2006, 10:24
OS, Lazarus, FPC: svn (Window32, Linux x64, Linux ARM (QNAP) (cross+nativ)
CPU-Target: X32 / X64 / ARMv5
Wohnort: Krefeld

Re: Synapse blockiert

Beitrag von mschnell »

creed steiger hat geschrieben:Dafür gibts bei Synapse Heartbeat:http://synapse.ararat.cz/doku.php/public:howto:heartbeat


Das scheint regelmäßiges Pollen zu machen. Eigentlich will man ja ein Event sofort, wenn ein Zeichen verfügbar ist und keinen zusätzlichen Overhead, solange keine Zeichen kommen. Das geht nur mit einem Thread.

-Michael

Antworten