Exception ohne wirklichen Auslöser treibt mich in den Wahnsinn!

[berens]

Zitat von Union:

Was machst Du denn im Execute des Threads ausserhalb der Synchronize-Aufrufe?

Dadurch, dass ich leider auf eine Access-Datenbank über Netzlaufwerk über <2MBit VPN angewiesen bin, lade ich alle Datensätze über einen Thread direkt in Objekte. Die Objekte werden dann von den Main-Thread kopiert (neu erzeugen und .Assign)


Beispiel:
Laden der Daten aus Datenbank

Delphi-Quellcode:

  TProjekt = class(TLoadSaveItem)
  public
    txtProjektName: string;
    dtEndDatum: TDateTime;
    dtStartDatum: TDateTime;
    blAusblenden: Boolean;
    function Equals(_CompareTo: TProjekt): Boolean;
    procedure Assign(_Source: TPersistent); override;
    constructor Create(_Owner: TComponent); override;
  end;


            while (not q.Eof) and (not FblStop) and (ToDo = 0) do begin
              inc(intCounter);
//              OutputDebugString(pchar('LoadSave.Laden.Projekte.Counter: ' + inttostr(intCounter)));

              tmpProjekt := TProjekt.Create(NIL);
              with tmpProjekt do begin
                ID := q.FieldByName('ID').AsInteger;
                dtEndDatum := floor(q.FieldByName('dtEndDatum').AsDateTime);
                dtStartDatum := floor(q.FieldByName('dtStartDatum').AsDateTime);
                txtProjektName := q.FieldByName('txtProjektName').AsString;
                blAusblenden := q.FieldByName('blAusblenden').AsBoolean;
                LastUpdate := CurrentTick;
              end;

              // Genau dieses Projekt in der Liste der bereits geladenen Projekte suchen
              blGefunden := False;
              for i := 0 to FclProjekte.Count - 1 do begin
                if FclProjekte.Items[i].InheritsFrom(TProjekt) then begin
                  ListenProjekt := TProjekt(FclProjekte.Items[i]);
                  // Projekt gefunden
                  if ListenProjekt.ID = tmpProjekt.ID then begin
                    ListenProjekt.Assign(tmpProjekt);
                    blGefunden := True;
                    Break;
                  end;
                end;
              end;

              if blGefunden then begin
                FreeAndNil(tmpProjekt);
              end else begin
                Synchronize(SyncNewDataset);
                FclProjekte.Add(tmpProjekt);
              end;

              q.Next;
              Synchronize(SyncSaveAndDelete); // damit auch beim Laden abgebrochen werden kann

              if (intCounter mod 10 = 0) then begin
                FProgressText := Format('%s von %s Projekten geladen', [IntToStr(intCounter), IntToStr(q.RecordCount)]);
                Synchronize(SyncProgress);
              end;
            end;

            q.Close;
            q.SQL.Clear;

            try
              i := 0;
              // Alle Einträge durchgehen
              while i < FclProjekte.Count do begin

                // Wenn Eintrag in der Liste nicht beim aktuellen Neu-Lade Zyklus mit dabei war
                tmpLS := TLoadSaveItem(FclProjekte.Items[i]);
                if tmpLS.LastUpdate <> CurrentTick then begin
                  FclProjekte.Delete(i);
                end else begin
                  inc(i);
                end;
              end;
            except end;

            Synchronize(SyncProjekte);
            FProgressText := Format('%s Projekte geladen', [IntToStr(intCounter)]);
            Synchronize(SyncProgress);
          end;

Und dann mit Synchronize die in Objekte aus der THREAD-Componentliste (FclProjekte) in die VCL (Main-Thread)-Componentenliste (clProjekte) kopieren mittels assign.

Sollte ja nix ausmachen, dass die clProjekte ein Objekt des Threads ist? Schließlich wird ja mit .Execute NIE direkt darauf zugegriffen...

Delphi-Quellcode:

{$Region 'procedure TLoadSaveThread.SyncProjekte;'}
procedure TLoadSaveThread.SyncProjekte;
var
  i, j: integer;
  blGeloescht, blGefunden: Boolean;
  tmpProjekt: TProjekt;
begin
  SyncStop;
  try
    if FblStop then Exit;
    if FclProjekte.Count = 0 then Exit;

    while clProjekte.Count > 0 do begin
      tmpProjekt := TProjekt(clProjekte.Extract(clProjekte.Items[0]));
      FreeAndNil(tmpProjekt);
    end;
    if FblStop then Exit;
  except end;

  {$Region 'Alle Projekte aus dem Thread durchgehen'}
  try
    for i := 0 to FclProjekte.Count - 1 do begin
      if TLoadSaveItem(FclProjekte.Items[i]).InheritsFrom(TProjekt) then begin
        tmpProjekt := TProjekt.Create(NIL);
        tmpProjekt.Assign(TProjekt(FclProjekte.Items[i]));

        // Wurde das aktuelle Projekt zwischenzeitlich gelöscht?
        blGeloescht := False;
        for j := 0 to FclDelete_Outbox.Count - 1 do begin
          if TLoadSaveItem(FclDelete_Outbox.Items[j]).InheritsFrom(TProjekt) then begin
            if TLoadSaveItem(FclDelete_Outbox.Items[j]).ID = tmpProjekt.ID then begin
              blGeloescht := True;
              Break;
            end;
          end;
        end;

        // Falls gelöscht, nicht in die VCL-Liste übernehmen
        if blGeloescht then begin
          FreeAndNil(tmpProjekt);
        end else begin
          // Falls nicht gelöscht, nachsehen
          // ob dieser Eintrag zwischenzeitlich bearbeitet und gespeichert wurde.
          // Dann diesen Wert bevorzugen, denn das Abspeichern in der Datenbank ist noch nicht beendet.

          j := 0;
          while j < FclSave_Outbox.Count do begin
            if TLoadSaveItem(FclSave_Outbox.Items[j]).InheritsFrom(TProjekt) then begin
              if TLoadSaveItem(FclSave_Outbox.Items[j]).ID = tmpProjekt.ID then begin
                // falls das Objekt aus dem Datenbankthread identisch ist mit dem, was gespeichert werden soll,
                // war das speichern und anschließende Neu-Laden wohl erfolgreich.
                if TProjekt(FclSave_Outbox.Items[j]).Equals(tmpProjekt) then begin
                  FclSave_Outbox.Delete(j);
                end else begin
                  // Abspeichern noch nicht beendet, deswegen Daten aus der Datenbank mit denen aus dem Zwischenspeicher ersetzen
                  tmpProjekt.Assign(FclSave_Outbox.Items[j]);
                  inc(j);
                end;
              end else inc(j);
            end else inc(j);
          end;

          clProjekte.Add(tmpProjekt);

        end;

      end; // inheritsfrom TProjekt
    end; // Alle Projekte
  except end;
  {$EndRegion 'Alle Projekte aus dem Thread durchgehen'}

  {$Region '"Zu speichernde" -also neue- Projekte laden'}
  try
    i := 0;
    while i < FclSave_Outbox.Count do begin

      // Ist das "zu speichernde" Projekt (in Save_Outbox) denn "schon" in clProjekte enthalten?
      blGefunden := False;
      for j := 0 to clProjekte.Count - 1 do begin
        if TLoadSaveItem(clProjekte.Items[j]).ClassType = TLoadSaveItem(FclSave_Outbox.Items[i]).ClassType then begin
          if TLoadSaveItem(clProjekte.Items[j]).ID = TLoadSaveItem(FclSave_Outbox.Items[i]).ID then begin
            blGefunden := True;
          end;
        end;
      end;

      // Falls noch nicht in clProjekte vorhanden
      if not blGefunden then begin
        if FclSave_Outbox.Items[i].InheritsFrom(TProjekt) then begin
          tmpProjekt := TProjekt.Create(NIL);
          tmpProjekt.Assign(TProjekt(FclSave_Outbox.Items[i]));
          clProjekte.Add(tmpProjekt);
        end;
      end;

      inc(i);
    end;
  except end;
  {$EndRegion '"Zu speichernde" -also neue- Projekte laden'}

  {$Region 'Wurde das zu löschende Projekt nicht mehr erneut aus der Datenbank geladen?'}
  try
    i := 0;
    // Liste der zu löschenden Objekte durchgehen
    while i < FclDelete_Outbox.Count do begin

      blGefunden := False;
      // vergleichen mit dem, was eben geladen wurde
      for j := 0 to FclProjekte.Count - 1 do begin
        if TLoadSaveItem(FclProjekte.Items[j]).ClassType = TLoadSaveItem(FclDelete_Outbox.Items[i]).ClassType then begin
          // Falls das zu löschende Objekt immer noch in der Liste gefunden wird, abbrechen
          if TLoadSaveItem(FclProjekte.Items[j]).ID = TLoadSaveItem(FclDelete_Outbox.Items[i]).ID then begin
            blGefunden := True;
            Break;
          end;
        end;
      end;

      // Wenn das zu löschende Objekt nicht mehr aus der Datenbank geladen wird, wurde es erfolgreich gelöscht
      if blGefunden then begin
        inc(i);
      end else begin
        // Nachverfolgung erfolgreich, da der zu löschende Datensatz nicht erneut aus der Datenbank geladen wurde!
        FclDelete_Outbox.Delete(i);
      end;
    end;
  except end;
  {$EndRegion 'Wurde das zu löschende Projekt nicht mehr erneut aus der Datenbank geladen?'}

end;
{$EndRegion}