TFilestream in Schleife funktioniert nur einmalig

[gabneo]

Hallo,

hat jemand eine Idee warum folgender Code in der Schleife nach einem Durchlauf hängen bleibt?

Delphi-Quellcode:

for i := flist.Count-1 downto 0 do
begin
  sFilename := extractfilepath(paramstr(0)) + flist[i].NodeValue;
  sFile := TFileStream.Create(sFilename, fmCreate);
  try
    fparams.Text := 'RPC=download';
    fparams.Add('file=' + flist[i].NodeValue);
    Queue ( procedure begin Form2.log('Post'); end);
    fhttp.Post(TIdURI.URLEncode(fURL), fparams, sFile);
  finally
    fhttp.Disconnect;
    sFile.Free;
    Queue ( procedure begin Form2.log('SetFileDate'); end);
    SetFileDate(sFilename, UnixToDateTime(flist[i].Attributes['timestamp']));
    // --> hier hört er nach einem Durchlauf auf <-- das Filedate wird noch einwanfrei gesetzt....
  end;
end;

Ich vermute es gibt ein Problem mit dem Filestream und dem Beschreiben dessen durch indy (idHttp). Es gibt keine Exception. Das Programm hängt sich einfach nur auf.

Mit einem Handle hatte ich leider auch keinen Erfolg:

Delphi-Quellcode:

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
  Queue ( procedure begin Form2.log('entry ' + inttostr(i) + ': ' + flist[i].NodeValue + #255 + flist[i].Attributes['timestamp']); end);
  //Download
  sFilename := extractfilepath(paramstr(0)) + flist[i].NodeValue;
  //sFile := TFileStream.Create(sFilename, fmCreate);
  Handle1 := CreateFile(PChar(sFilename), GENERIC_WRITE, FILE_SHARE_WRITE, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
  fileStream := THandleStream.Create(Handle1);
  try
    fparams.Text := 'RPC=download';
    fparams.Add('file=' + flist[i].NodeValue);
    Queue ( procedure begin Form2.log('Post'); end);
    fhttp.Post(TIdURI.URLEncode(fURL), fparams, fileStream); //sFile
    Queue ( procedure begin Form2.log('Nächster'); end);
  finally
    fhttp.Disconnect;
    //sFile.Free;
    fileStream.Free;
    CloseHandle(Handle1);
    //Queue ( procedure begin Form2.log('SetFileDate'); end);
    SetFileDate(sFilename, UnixToDateTime(flist[i].Attributes['timestamp']));
end;

Was mache ich falsch?
LG

[p80286]

Was passiert denn, bzw. passiert nicht wenn Du mit [F7]/[F8] da durch steppst?

Gruß
K-H

[Delbor]

Hi gabneo

Delphi-Quellcode:

for i := flist.Count-1 downto 0 do//<= Hier beginnst du deine Schleife
begin
  sFilename := extractfilepath(paramstr(0)) + flist[i].NodeValue;
  sFile := TFileStream.Create(sFilename, fmCreate);  //<= Hier erstellst du im Programmverzeichnis, auf das du keinen Zugriff hast, 
                                                     // die Datei ***
  try
    fparams.Text := 'RPC=download';
    fparams.Add('file=' + flist[i].NodeValue);
    Queue ( procedure begin Form2.log('Post'); end);
    fhttp.Post(TIdURI.URLEncode(fURL), fparams, sFile);
  finally                                 // <= Hier leitest du einen Codeabschnitt ein, der in jedem Fall ausgeführt werden soll.
    fhttp.Disconnect;             // Hier schliesst du die Verbindung.
    sFile.Free;                   // und gibst den Filstream frei.
    Queue ( procedure begin Form2.log('SetFileDate'); end);
    SetFileDate(sFilename, UnixToDateTime(flist[i].Attributes['timestamp']));
    // --> hier hört er nach einem Durchlauf auf <-- das Filedate wird noch einwanfrei gesetzt....
  end;
end;

Da du die http-Verbindung schon im ersten Scheifendurchlauf schliesst,ist da nichts mehr, was in der Schleife verarbeitet werden könnte. Auf jeden Falll aber wäre es sehr interessant, das Codeschnpsel zu sehen, das vor Abarbeitung der Schleife und bei/nach Verbindungsherstellung abläuft.

Gruss
Delbor

PS: *** Das Programmverzeichnis ist nach fertigsttellung deines Programmes und nach dessen Istallation C:\Programme. Und da hat kein User Zugriff darauf (seit WinXP(?)). Und deshalb wird dannzumal jeder VCersuch, da in eine Ini-Datei oder sonstwas zu schreiben, fehlschlagen.
Eine Mögliche Lösung findest du zum Beispiel hier

[gabneo]

Hallo K-H,
das war schon mal ein sehr guter Hinweis. Hatte vergessen das integriertes Debuggen noch abgeschaltet war, so ist mir aufgefallen das die SSL Dlls schon mal gefehlt haben.
Ich bekomme einen EOutOfMemory 'Zu wenig Arbeitsspeicher' (siehe Screenshot) Fehler.
Zum Zeitpunkt der Fehlermeldung springt der Speicherverbrauch der Anwendung von 40 MB auf 610 MB an (Habe 16 GB insgesamt) beim Download einer 4 MB Datei.

@Delbor
Das Programmverzeichnis ist nach Auslieferung Das Lokale AppData-Verzeichnis. Es wird auch bereits fehlerfrei beschrieben.

Delphi-Quellcode:

fhttp.Disconnect;

Ist drin um sicherzustellen das der Zugriff auf den Stream beendet wird. Auch wenn man das auskommentiert, ändert sich nichts. Zudem idHTTP die Verbindung mit dem nächsten

Delphi-Quellcode:

fhttp.Post(...

wieder aufbaut. 8 Stück schafft er jetzt in Reihe...bis eben der Arbeitsspeicher knapp wird

[EDIT]

Zitat:

PS: *** Das Programmverzeichnis ist nach fertigsttellung deines Programmes und nach dessen Istallation C:\Programme. Und da hat kein User Zugriff darauf (seit WinXP(?)). Und deshalb wird dannzumal jeder VCersuch, da in eine Ini-Datei oder sonstwas zu schreiben, fehlschlagen.
Eine Mögliche Lösung findest du zum Beispiel hier

Das mag oft so sein...aber nicht in diesem Projekt ;) Die Setup Routine ist für User ohne Installationsrechte und speichert deshalb in den AppData=>Local Folder auf den fast alles und jeder Rechte hat! Dieses System verwende ich bereits, weltweit bei tausenden Usern. Ohne Probleme...

[Delbor]

Hi gabneo

Lass den Speichermanager doch mal allfällige Speicherlecks anzeigen.

Zitat:

fhttp.Disconnect; Ist drin um sicherzustellen das der Zugriff auf den Stream beendet wird.

Wie ich schon geschrieben habe, wäre es interesant, zu wissen, was vor der Schleife passiert. Es scheint so, als müsse in der Schleife auf Objekte zugegriffen werden, die es plötzlich nicht mehr gibt.

Gruss
Delbor

[gabneo]

Reportmemoryleaks ist gecheckt und es gibt keine Lecks.
Dasselbe Problem taucht auch auf wenn man mit idHTTP auf einer Form einen Responsestream über .Post mit angibt.

Hier ist die Unit...

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;

type
  http = class(TThread)
  private
    { Private-Deklarationen }
    fhttp: TIdHttp;
    fUser, fPass, fHardwarekennung, fURL, fcfg, fsrc, fsalt: string;
  protected
    procedure Execute; override;
  public
    constructor Create(User, Pass, Hardwarekennung, URL, cfg, src, salt:widestring);
  end;

implementation

uses main, downloadForm, languageStrings, passwordForm, functions, debug;

constructor http.Create(User, Pass, Hardwarekennung, URL, cfg, src, salt:widestring);
begin
  inherited Create(False);
  FreeOnTerminate := true;
  fUser := User;
  fPass := Pass;
  fHardwarekennung := Hardwarekennung;
  fURL := url;
  fcfg := cfg;
  fsrc := src;
  fsalt := salt;
  Self.Execute;
end;

procedure http.Execute;
var s,sFilename,pfad,s1:string; nlist,flist:iXMLNodeList; cfgdata: tstringlist; PHPXML: IXMLDOCUMENT; sFile: TStream; fparams, currentList:tstringlist; i:integer; Handle1:THandle; fileStream:THandleStream;
begin
  phpxml := NewXMLDocument;
  fhttp := TIdHTTP.Create(nil);
  try
    fhttp.HandleRedirects := True;
    fhttp.AllowCookies := True;
    fhttp.ReadTimeout := 15000; //Sonst Timeouts auf > Windows 8 BSystemen
    fhttp.IOHandler := TIdSSLIOHandlerSocketOpenSSL.Create(fhttp);

    fparams:=tstringlist.Create;
    fparams.Add('RPC=login');
    fparams.Add('username='+fUser);
    fparams.Add('password='+fPass);
    fparams.Add('hardware='+fHardwarekennung);
    s := fhttp.Post(TIdURI.URLEncode(fURL), fparams);

    try PHPXML.LoadFromXML(s); phpxml.Active := true; except end;

    if not PHPXML.IsEmptyDoc then
    begin
      if (phpxml.DocumentElement.HasChildNodes) then
        begin
          nlist := phpxml.DocumentElement.ChildNodes;
          if (nlist.FindNode('problem') <> nil) then
          begin
            if (((nlist.FindNode('blocked') <> nil)) and (nlist.FindNode('blocked').Text>'0000-00-00 00:00:00')) or (((nlist.FindNode('removed') <> nil)) and (nlist.FindNode('removed').Text>'0000-00-00 00:00:00')) then begin try DeleteFile(PChar(fcfg)); except end; Application.Terminate; end;
             Queue( procedure begin showmessage(language.Label1.Caption) end ); //'Username or password not valid. Please check your input.'
            exit;
          end;
          //setIniFile;

          //Neues Password TODO
          //if (((nlist.FindNode('newpassword') <> nil)) and (nlist.FindNode('newpassword').Text='1')) then Form12.ShowModal;

          //XML Verschlüsseln und Speichern
          try DeleteFile(PChar(fcfg)) except end;
          try Queue( procedure begin Form1.xml.LoadFromXML(Form1.IdDecoderMIME1.DecodeString(nlist.FindNode('cfg').Text, SysUtils.TUTF8Encoding.UTF8));
              cfgdata := tstringlist.Create; try cfgdata.Text := functions.Encrypt(Form1.xml.XML.Text, fsalt + fUser + fPass + fHardwarekennung); cfgdata.SaveToFile(fcfg); finally cfgdata.Free; end; end );
          except end;

          //APPLICATION UPDATE
          //Versionscheck und ggf. Download der aktuellen Version
          if (nlist.FindNode('version') <> nil) then if (phpxml.DocumentElement.ChildNodes.FindNode('version').Text <> GetVersion) then 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; 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;

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

            Queue ( procedure begin Form2.log('flist.count: ' + inttostr(flist.Count)); end);
            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
              Queue ( procedure begin Form2.log('entry ' + inttostr(i) + ': ' + flist[i].NodeValue + #255 + flist[i].Attributes['timestamp']); end);
              //Download
              sFilename := extractfilepath(paramstr(0)) + flist[i].NodeValue;
              sFile := TFileStream.Create(sFilename, fmCreate);
              //Handle1 := CreateFile(PChar(sFilename), GENERIC_WRITE, FILE_SHARE_WRITE, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
              //fileStream := THandleStream.Create(Handle1);
              try
                fparams.Text := 'RPC=download';
                fparams.Add('file=' + flist[i].NodeValue);
                fhttp.Post(TIdURI.URLEncode(fURL), fparams, sFile); //sFile fileStream
              finally
                //fhttp.Disconnect;
                //fhttp.Response.Clear;
                sFile.Free;
                //fileStream.Free;
                //CloseHandle(Handle1);
                SetFileDate(sFilename, UnixToDateTime(flist[i].Attributes['timestamp']));
              end;
            end;
          finally
            currentList.Free;
          end;

        //Applikation laden
      end;
    end else Queue( procedure begin showmessage(language.Label2.Caption); {problem connecting server} {TODO Offline Modus starten}  end );
  finally
    try fparams.text := 'RPC=logout'; fhttp.Post(TIdURI.URLEncode(fURL), fparams); except end;
    fhttp.Free;
    fparams.Free;
  end;
  Self.Terminate;
end;

end.

LG

[bra]

Ist das unter Windows oder bei einer mobilen Plattform? Wir hatten bei uns ein Problem unter iOS/Android, dass Indy den Stream bei einem Get nicht freigibt. Gelöst haben wir das so:

Delphi-Quellcode:

    {$IFDEF AUTOREFCOUNT}
    http.Response.ContentStream := nil;  // Referenz auf AStream freigeben
    {$ENDIF AUTOREFCOUNT}

Möglicherweise braucht man bei einem Post auch sowas in der Art?

[gabneo]

Hallo bra,

das war eine super Idee, ich denke das ist die Richtige Spur und habe es getestet. Aber das hat den Fehler leider auch noch nicht gelöst.

Ähnlich gibt es noch:

Delphi-Quellcode:

fhttp.Response.ContentStream.Free
fhttp.Response.Clear;

Die leider auch nichts geholfen haben. So langsam sieht es nach einem Fehler in Indy aus, oder Indy ist für Post & Downloads nicht vorgesehen. Ich sehe mich mal nach nem Umweg um.

[himitsu]

Zitat:

Zitat von gabneo (Beitrag 1344023)

So langsam sieht es nach einem Fehler in Indy aus, oder Indy ist für Post & Downloads nicht vorgesehen.

Einige der INDY-Leute hüpfen zwar auch hier im Forum rum, aber im Notfall kann man sich auch direkt an INDY wenden.
http://www.indyproject.org/Support.DE.aspx

Der FileStream und HandleStream brauchen fast keinen Arbeitsspeicher (den Virtuellen in deiner Anwendung).
Die Daten landen zwar im WindowsFileCache, aber der wird automatisch geleert, wenn der physische Arbeitsspeicher (RAM) zur Neige geht.

Als Erstes kann man versuchen mit ReportMemoryLeaksOnShutdown (nutzt eine der wenigen Funktionen des integrierten kleinen FastMM) oder den erweiterten Funktionen des großen FastMM rauszufinden, womit der Arbeitsspeicher sich füllt.
Es gibt auch noch andere Möglichkteiten, um den Speicher zu debuggen/prüfen/auszuwwerten.
delphi memory leak

[Delbor]

Hi zusammen

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.
Des weiteren arbeitet der Thread mit einem Filestream, greift also auf die Festplatte zu...

Gruss
Delbor

[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.