AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Sprachen und Entwicklungsumgebungen Object-Pascal / Delphi-Language TFilestream in Schleife funktioniert nur einmalig
Thema durchsuchen
Ansicht
Themen-Optionen

TFilestream in Schleife funktioniert nur einmalig

Ein Thema von gabneo · begonnen am 2. Aug 2016 · letzter Beitrag vom 6. Aug 2016
Antwort Antwort
Seite 2 von 2     12   
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
44.184 Beiträge
 
Delphi 12 Athens
 
#11

AW: TFilestream in Schleife funktioniert nur einmalig

  Alt 2. Aug 2016, 23:07
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.
$2B or not $2B
  Mit Zitat antworten Zitat
Benutzerbild von Neutral General
Neutral General

Registriert seit: 16. Jan 2004
Ort: Bendorf
5.219 Beiträge
 
Delphi 10.2 Tokyo Professional
 
#12

AW: TFilestream in Schleife funktioniert nur einmalig

  Alt 3. Aug 2016, 11:05
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?

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.
Michael
"Programmers talk about software development on weekends, vacations, and over meals not because they lack imagination,
but because their imagination reveals worlds that others cannot see."
  Mit Zitat antworten Zitat
Bambini
(Gast)

n/a Beiträge
 
#13

AW: TFilestream in Schleife funktioniert nur einmalig

  Alt 3. Aug 2016, 11:48
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.

Geändert von Bambini ( 3. Aug 2016 um 12:03 Uhr)
  Mit Zitat antworten Zitat
Fritzew

Registriert seit: 18. Nov 2015
Ort: Kehl
678 Beiträge
 
Delphi 11 Alexandria
 
#14

AW: TFilestream in Schleife funktioniert nur einmalig

  Alt 3. Aug 2016, 13:15
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.
Fritz Westermann
  Mit Zitat antworten Zitat
Delbor

Registriert seit: 8. Okt 2006
Ort: St.Gallen/Schweiz
1.186 Beiträge
 
Delphi 11 Alexandria
 
#15

AW: TFilestream in Schleife funktioniert nur einmalig

  Alt 3. Aug 2016, 14:18
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.

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.

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
Roger
Man muss und kann nicht alles wissen - man muss nur wissen, wo es steht.
Frei nach Albert Einstein
http://roase.ch
  Mit Zitat antworten Zitat
bra

Registriert seit: 20. Jan 2015
711 Beiträge
 
Delphi 10.2 Tokyo Enterprise
 
#16

AW: TFilestream in Schleife funktioniert nur einmalig

  Alt 3. Aug 2016, 14:32
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.
  Mit Zitat antworten Zitat
Benutzerbild von p80286
p80286

Registriert seit: 28. Apr 2008
Ort: Stolberg (Rhl)
6.659 Beiträge
 
FreePascal / Lazarus
 
#17

AW: TFilestream in Schleife funktioniert nur einmalig

  Alt 3. Aug 2016, 15:43
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
Programme gehorchen nicht Deinen Absichten sondern Deinen Anweisungen
R.E.D retired error detector
  Mit Zitat antworten Zitat
gabneo

Registriert seit: 15. Okt 2006
Ort: Deutsche Toskana :)
93 Beiträge
 
Delphi 10.2 Tokyo Professional
 
#18

AW: TFilestream in Schleife funktioniert nur einmalig

  Alt 6. Aug 2016, 20:11
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.
  Mit Zitat antworten Zitat
Antwort Antwort
Seite 2 von 2     12   


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 03:40 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz