TFilestream in Schleife funktioniert nur einmalig

[himitsu]

Ohh, den TThread hab ich übersehn, aber keine Sorge, jemand baut da totalen Mist und das läuft nicht im Thread.

Zumindestens nicht im ersten Durchgang, denn irgendwer ruft im Create das Execute auf und Execute ruft man niemals selber auf, schon garnicht im Create.
Und die eigentliche Thread-Ausführung wird vermutlich durch das Self.Terminate schon vorher abgeschossen.

[Neutral General]

Zitat:

Zitat von Delbor (Beitrag 1344028)

Was mich befremdet: Der Thread erzeugt in seinem Constructor eine IdHttp-Komponente, und die ist ein Nachkomme von TIdTCP. Und die dürfte sich wohl im Hauptthread befinden.

Abgesehen davon, dass wie es aussieht eh ALLES im Hauptthread ausgeführt wird weil Execute statt Start/Resume augerufen wird versteh ich nicht worauf du hinaus willst.
Was ist das Problem daran von TIdTCP abgeleitet zu sein?

Zitat:

Zitat von Delbor (Beitrag 1344028)

Des weiteren arbeitet der Thread mit einem Filestream, greift also auf die Festplatte zu...

Es gibt keinen Grund warum man aus einem Thread heraus nicht auf die Festplatte zugreifen können/dürfen sollte.

[Bambini]

Welchen XML Parser verwendest du?
Wenn es der MSXML ist, dann läuft das über COM und dann müssen Threads ein CoInitialize(nil) rufen bevor COM verwendet wird.
Das muss im laufenden Thread passieren, also nicht im Constructor sondern im Execute().

Aber da passt etwas mit deiner Thread Erzeugung nicht. Das Execute wird niemals von einem selbst gerufen.

[Fritzew]

Also ich würde sagen zerlege mal deine Execute Routine in einzelne Methoden.
Du greifst immer wieder auf Vcl Formulare zu. Weg damit. So ist dem Problem nicht wirklich beizukommen.

Hier mal ein Vorschlag (Auf die schnelle geändert aber du Siehst denke ich die Idee dahinter)

Delphi-Quellcode:

unit httpThread;

interface

uses
  Classes,
  SysUtils,
  Dialogs,
  Forms,
  Controls,
  ShellAPI,
  Windows,
  IdComponent,
  IdTCPConnection,
  IdTCPClient,
  IdHTTP,
  IdURI,
  IdCookieManager,
  IdIOHandler,
  IdIOHandlerSocket,
  IdIOHandlerStack,
  IdSSL,
  IdSSLOpenSSL,
  IdCoder,
  xmldom,
  XMLIntf,
  msxmldom,
  XMLDoc,
  ActiveX;

type

  tLogMessageProc = procedure(const aMessage: string) of object;

  http = class(TThread)
  private
    { Private-Deklarationen }
    fhttp: TIdHttp;
    fUser, fPass, fHardwarekennung, fURL, fcfg, fsrc, fsalt: string;

    fLogError: tLogMessageProc;
    flogMessage: tLogMessageProc;

    /// <summary>
    /// Returns true if there is a Problem
    /// </summary>
    function checkProblem(const aXMLNodes: iXMLNodeList): boolean;
    procedure doApplicationUpdate(fparams: tstringlist; const nlist: iXMLNodeList; const PHPXML: IXMLDOCUMENT);
    procedure doDownloadFile(const aFilename, aTimestamp: string);
    procedure doXMLDecode(const nlist: iXMLNodeList);
    procedure logError(const aMessage: string);
    procedure logmessage(const aMessage: string);
    procedure FillParams(const Values: Tstrings);
    procedure showMessageinMainThread(const aMessage: string);
    function getxmlFromServer(aXML: IXMLDOCUMENT; aServer: TIdHttp; const aUrl: string; aParams: Tstrings): boolean;

  protected
    procedure Execute; override;

  public
    constructor Create(const User, Pass, Hardwarekennung, URL, cfg, src, salt: string; aLogerror: tLogMessageProc;
      aLogMessage: tLogMessageProc);
  end;

implementation

function getVersion: string;
begin
  result := 'unknown';
end;

function http.checkProblem(const aXMLNodes: iXMLNodeList): boolean;
begin
  result := true;

  if (aXMLNodes.FindNode('problem') <> nil) then
    begin
      if (((aXMLNodes.FindNode('blocked') <> nil)) and (aXMLNodes.FindNode('blocked').Text > '0000-00-00 00:00:00')) or
        (((aXMLNodes.FindNode('removed') <> nil)) and (aXMLNodes.FindNode('removed').Text > '0000-00-00 00:00:00')) then
        begin
          try
            DeleteFile(PChar(fcfg));
          except
          end;
          Application.Terminate;
        end;
      Queue(
        procedure
        begin
          showmessage('Username or password not valid. Please check your input.');
        end); // 'Username or password not valid. Please check your input.'
      exit;
    end;
  result := False;
end;

procedure http.doApplicationUpdate(fparams: tstringlist; const nlist: iXMLNodeList; const PHPXML: IXMLDOCUMENT);
var
  sFile: TStream;
  sFilename: string;
begin
  // Versionscheck und ggf. Download der aktuellen Version
  if (nlist.FindNode('version') <> nil) then
    if (PHPXML.DocumentElement.ChildNodes.FindNode('version').Text <> getVersion) then

      // Das geht auch in die Hose aus einem Thread heraus

      // if (MessageDlg(language.Label4.Caption + PHPXML.DocumentElement.ChildNodes.FindNode('version').Text + '!' + #13#10 +
      // language.label5.Caption, mtConfirmation, mbYesNo, 0) = mrYes) then
      begin
        // download.Show;
        sFilename := extractfilepath(paramstr(0)) + 'update.exe';
        try
          DeleteFile(PChar(sFilename))
        except
          on e: exception do
            logError(e.message);
        end;
        sFile := TFileStream.Create(sFilename, fmCreate);
        try
          fparams.Text := 'RPC=update';
          fhttp.Post(TIdURI.URLEncode(fURL), fparams, sFile);
        finally
          sFile.Free;
        end;
        ShellExecute(handle, 'open', PChar(sFilename), PChar(''), '', SW_SHOWNORMAL);
        /// SP- /VERYSILENT
        Application.Terminate;
      end;
end;

procedure http.doDownloadFile(const aFilename, aTimestamp: string);
var
  lparams: tstringlist;
  sFile: TStream;
  sFilename: string;
begin
  sFilename := extractfilepath(paramstr(0)) + aFilename;
  sFile := TFileStream.Create(sFilename, fmCreate);
  lparams := tstringlist.Create;
  try
    lparams.Text := 'RPC=download';
    lparams.Add('file=' + aFilename);
    logmessage('Try to get File ' + aFilename);
    fhttp.Post(TIdURI.URLEncode(fURL), lparams, sFile); // sFile fileStream
  finally
    lparams.Free;
    fhttp.Response.Clear;
    sFile.Free;
    { TODO : Auskommentiert da die Unit nicht da ist }
    // SetFileDate(sFilename, UnixToDateTime(aTimestamp);
  end;
end;

procedure http.doXMLDecode(const nlist: iXMLNodeList);
var
  cfgdata: tstringlist;
begin
  // XML Verschlüsseln und Speichern
  try
    DeleteFile(PChar(fcfg))
  except
    on e: exception do
      logError(e.message);
  end;
  try
    // Wirklich asynchron?
    Queue(
      procedure
      begin
        { TODO : Besser hier eine eigene Mime Class benutzen }
        // Form1.xml.LoadFromXML(Form1.IdDecoderMIME1.DecodeString(nlist.FindNode('cfg').Text, SysUtils.TUTF8Encoding.UTF8));
        cfgdata := tstringlist.Create;
        try
          { TODO : Auskommentiert da die Unit nicht da ist }
          // cfgdata.Text := functions.Encrypt(Form1.xml.xml.Text, fsalt + fUser + fPass + fHardwarekennung);
          cfgdata.SaveToFile(fcfg);
        finally
          cfgdata.Free;
        end;
      end);
  except
    on e: exception do
      logError(e.message);
  end;
end;

procedure http.logError(const aMessage: string);
begin

  if assigned(fLogError) then
    Queue(
      procedure
      begin
        fLogError(aMessage); { problem connecting server } { TODO Offline Modus starten }
      end);

end;

procedure http.logmessage(const aMessage: string);
begin
  if assigned(flogMessage) then
    Queue(
      procedure
      begin
        flogMessage(aMessage);
      end);

end;

procedure http.FillParams(const Values: Tstrings);
begin
  Values.Clear;
  Values.Add('RPC=login');
  Values.Add('username=' + fUser);
  Values.Add('password=' + fPass);
  Values.Add('hardware=' + fHardwarekennung);
end;

procedure http.showMessageinMainThread(const aMessage: string);
begin
  Queue(
    procedure
    begin
      showmessage(aMessage);
    end);
end;

function http.getxmlFromServer(aXML: IXMLDOCUMENT; aServer: TIdHttp; const aUrl: string; aParams: Tstrings): boolean;
var
  s: string;
begin
  result := False;
  s := aServer.Post(TIdURI.URLEncode(fURL), aParams);
  try
    aXML.LoadFromXML(s);
    aXML.Active := true;
    result := (not aXML.IsEmptyDoc) and (aXML.DocumentElement.HasChildNodes);
  except
    on e: exception do
      logError(e.message);
  end;
end;

procedure http.Execute;
var
  currentList: tstringlist;
  flist: iXMLNodeList;
  fparams: tstringlist;
  i: integer;
  nlist: iXMLNodeList;
  pfad: string;
  PHPXML: IXMLDOCUMENT;
  s: string;
  s1: string;

begin
  CoInitialize(nil);
  PHPXML := NewXMLDocument;
  fhttp := TIdHttp.Create(nil);
  fparams := tstringlist.Create;
  try
    fhttp.HandleRedirects := true;
    fhttp.AllowCookies := true;
    fhttp.ReadTimeout := 15000; // Sonst Timeouts auf > Windows 8 BSystemen
    fhttp.IOHandler := TIdSSLIOHandlerSocketOpenSSL.Create(fhttp);

    FillParams(fparams);
    if getxmlFromServer(PHPXML, fhttp, fURL, fparams) then
      begin
        nlist := PHPXML.DocumentElement.ChildNodes;
        if checkProblem(nlist) then
          exit;
        doXMLDecode(nlist);

        // APPLICATION UPDATE

        doApplicationUpdate(fparams, nlist, PHPXML);

        // CONTENT UPDATE
        currentList := tstringlist.Create;
        try
          currentList.Sorted := true;
          // functions.FindAllFilesUnix(currentList, fsrc, '*', true, False, true, true); // Dateiliste erstellen

          pfad := extractfilepath(paramstr(0));
          s1 := PHPXML.DocumentElement.ChildNodes.FindNode('filelist').xml;

          for i := currentList.Count - 1 downto 0 do
            begin
              s := copy(currentList[i], length(fsrc) + 1);
              s := copy(s, 0, pos(#255, s) - 1);
              if (pos('\', s) < 1) and ((extractfileext(s) = '') or (lowercase(extractfileext(s)) = '.xml')) then
                continue; // APPDATEN: Übergehen - Dateien ohne Endung, Dateien mit Endung XML

              s := copy(currentList[i], length(pfad) + 1);
              s := copy(s, 0, pos(#255, s) - 1);
              if (pos('>' + s + '</file>', s1) < 1) then
                DeleteFile(PChar(s)); // löschen
            end;

          flist := PHPXML.DocumentElement.ChildNodes.FindNode('filelist').ChildNodes;

          logmessage('flist.count: ' + inttostr(flist.Count));

          for i := flist.Count - 1 downto 0 do
            begin
              if (pos(flist[i].NodeValue + #255 + flist[i].Attributes['timestamp'], currentList.Text) > 0) then
                continue; // Datumsvergleich
              logmessage('entry ' + inttostr(i) + ': ' + flist[i].NodeValue + #255 + flist[i].Attributes['timestamp']);
              // Download

              doDownloadFile(flist[i].NodeValue, flist[i].Attributes['timestamp']);
            end;
        finally
          currentList.Free;
        end;

        // Applikation laden

      end
    else
      showMessageinMainThread(' problem connecting server');

  finally
    try
      fparams.Text := 'RPC=logout';
      fhttp.Post(TIdURI.URLEncode(fURL), fparams);
    except
      on e: exception do
        logError(e.message);
    end;
    fhttp.Free;
    fparams.Free;
  end;

  // Self.Terminate;
end;

constructor http.Create(const User, Pass, Hardwarekennung, URL, cfg, src, salt: string; aLogerror: tLogMessageProc;
aLogMessage: tLogMessageProc);
begin
  inherited Create(False);
  FreeOnTerminate := true;
  fUser := User;
  fPass := Pass;
  fHardwarekennung := Hardwarekennung;
  fURL := URL;
  fcfg := cfg;
  fsrc := src;
  fsalt := salt;
  fLogError := aLogerror;
  flogMessage := aLogMessage;
  // Self.Execute;      /// Niemals selber aufrufen
end;

end.

[Delbor]

Hi zusammen

Zitat:

Zitat von neutral general (Beitrag 1344047)

Zitat:

Zitat von delbor (Beitrag 1344028)

was mich befremdet: Der thread erzeugt in seinem constructor eine idhttp-komponente, und die ist ein nachkomme von tidtcp. Und die dürfte sich wohl im hauptthread befinden.

abgesehen davon, dass wie es aussieht eh alles im hauptthread ausgeführt wird weil execute statt start/resume augerufen wird versteh ich nicht worauf du hinaus willst.
Was ist das problem daran von tidtcp abgeleitet zu sein?

Gar keines. Ich ging davon aus, dass im Programm eine TCP/IP-Komponente verwendet werden würde und die Antwort des Servers im Thread verarbeitet werden soll. Ansonsten bin ich im Umgang mit Threads noch nicht ganz sattelfest, weshalb ich geschrieben habe, dass mich das befremdet. Andernfalls hätte ich geschrieben, dass das schlicht falsch ist.

Zitat:

Zitat von delbor (Beitrag 1344028)

des weiteren arbeitet der thread mit einem filestream, greift also auf die festplatte zu...

Zitat:

es gibt keinen grund warum man aus einem thread heraus nicht auf die festplatte zugreifen können/dürfen sollte.

Nein, da hast du natürlich recht. Aber der Zugriff darf nicht so erfolgen. Soweit mir bekannt, ist eine Criticalsection das mindeste, was es bräuchte.

Die Sache mit der VCL habe ich auch übersehen.

Gruss
Delbor

[bra]

Zitat:

Zitat von Delbor (Beitrag 1344062)

Nein, da hast du natürlich recht. Aber der Zugriff darf nicht so erfolgen. Soweit mir bekannt, ist eine Criticalsection das mindeste, was es bräuchte.

Solange der Thread als einziger auf diese Datei zugreift und der Thread auch nicht mehrfach läuft (was wir nicht wissen), wäre das kein Problem.

[p80286]

Zitat:

Zitat von bra (Beitrag 1344063)

Zitat:

Zitat von Delbor (Beitrag 1344062)

Nein, da hast du natürlich recht. Aber der Zugriff darf nicht so erfolgen. Soweit mir bekannt, ist eine Criticalsection das mindeste, was es bräuchte.

Solange der Thread als einziger auf diese Datei zugreift und der Thread auch nicht mehrfach läuft (was wir nicht wissen), wäre das kein Problem.

solange jeder Thread einen eigenenen Stream/File hat ist das doch herzlich egal?
Ist zwar nicht soo gelungen mehrere Threads auf eine Datei los zu lassen, aber theoretisch ist das machbar!

Gruß
K-H

[gabneo]

Hallo,

vielen Dank für die Vorschläge was den Thread angeht. Die Arbeite ich durch. (Der Thread läuft nur einmal).
Leider bleibt das Arbeitsspeicherproblem davon unberührt. Habe es ohne Thread getestet und auch da hat Indy das gleiche Problem.
Insgesamt geht es halt um den Download von ~700 Dateien.

Trotzdem vielen Dank und schönes WE noch.