Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Object-Pascal / Delphi-Language (https://www.delphipraxis.net/32-object-pascal-delphi-language/)
-   -   Delphi Threads und records / record-var "nicht mehr da/gültig" (https://www.delphipraxis.net/66412-threads-und-records-record-var-nicht-mehr-da-gueltig.html)

Meta777 29. Mär 2006 13:16


Threads und records / record-var "nicht mehr da/gültig&
 
Hallo,

wie kann ich sichergehen das eine variable (ein record) noch gültig ist (so nenn ich das jetzt mal) wenn diese ein Thread weiterverarbeiten soll? Also normalerweise geht das auch alles nur manchmal gibts es in der TLog.DoSynchronize Procedure AVs beim Zugriff auf die Feldvariable FPrtData!?

Aufrufen tu ich es wie folgt:
Delphi-Quellcode:
procedure TfrmProt.Add2Prot(const AStr: String);
var
  prtData: TDaPrtData;
begin
  FillChar(prtData, SizeOf(prtData), #0); //INITIALISIEREN DES RECORDS
  prtData.Msg := AStr;                   //LOG-TEXT ZUWEISEN
  TLog.Add(prtData);                     //prtData VAR ÜBERGEBEN...
end;
Es folgenden der Record und die Klasse für die Protokollierungszwecke:
Delphi-Quellcode:
type//DAS IST DER RECORD DER DANN NICHT MEHR "GÜLTIG IST" orso...
  TDaPrtData = record
    Typ: TDaPrtMsgType;
    Msg: String;
    Cls: ShortString;
    Code: Integer;
    SQL: String;
    Details: String;
    DoId: Integer;
    ConfigId: Integer;
  end;

//This is based on the example found in the indy newsgroup
  TLog = class(TIdSync)
  protected
    FPrtData: TDaPrtData;
    procedure DoSynchronize; override;
    constructor Create(const APrtData: TDaPrtData);
  public
    class procedure Add(const APrtData: TDaPrtData); overload;
  end;




//---------------------------------------------------//
//------------------------ TLog ---------------------//

constructor TLog.Create(const APrtData: TDaPrtData);
begin
  FPrtData := APrtData; //SOLLTE DOCH AUSREICHEN, ODER? VARS WERDEN
  inherited Create;    //DOCH BEI DER ZUWEISEUNG KOPIERT, ODER NICHT?
end;

procedure TLog.DoSynchronize;
var
  lFileStream: TFileStream;
  lMode: Word;
  lString: String;

  procedure TruncateStream;
  var
    Buffer: TMemoryStream;
    c, n1, n2, Len: Int64;
  begin
    Buffer := TMemoryStream.Create;
    try
      Buffer.Size := konPrtLowFileSize;
      lFileStream.Position := lFileStream.Position - konPrtLowFileSize;
      Len := Buffer.CopyFrom(lFileStream, konPrtLowFileSize);
      Buffer.Position := 0;
      lFileStream.Position := 0;
//TODO 1: Alternative. Works but sure slow??
      lFileStream.Size := 0;
      lFileStream.Size := konPrtLowFileSize;

      lFileStream.Position := 0;
      lFileStream.CopyFrom(Buffer, Len);
      QueryPerformanceCounter(n2);
      OutputDebugString(PChar(FloatToStr(n2-n1/c, formatSet)));
    finally
      Buffer.Free;
    end;
  end;

  procedure LogToScreen;
  begin
    try
      frmProt.memLog.Lines.BeginUpdate;
      if frmProt.memLog.Lines.Count > frmProt.PrtOptions.PrtSize then begin
        while frmProt.memLog.Lines.Count > frmProt.PrtOptions.PrtSize-50 do//Cut off 50 Lines
          frmProt.memLog.Lines.Delete(0);
        frmProt.memLog.Lines.Add('$$$'+konPrtColDel+DateTimeToStr(Now, formatSet)+'LOG TRUNCATE'+konPrtLineDel);
      end;
      frmProt.memLog.Lines.Add(lString);
//      if True{Optionen_Form.miscAutoScrollLog }then begin
        frmProt.memLog.Perform(EM_LINESCROLL, 0, frmProt.memLog.Lines.Count);
//      end;
      frmProt.memLog.Lines.EndUpdate;
    except
      frmProt.PrtOptions.AbledPrtModes := frmProt.PrtOptions.AbledPrtModes -
        [pmScreen];
    end;
  end;//procedure LogToScreen

  procedure LogToFile;
  begin
    try
      if FileExists(frmProt.PrtOptions.PrtFileName) then
        lMode := fmOpenReadWrite or fmShareDenyWrite
      else
        lMode := fmCreate;
      lFileStream := TFileStream.Create(frmProt.PrtOptions.PrtFileName, lMode);
      try
        if lMode <> fmCreate then
          lFileStream.Seek(0, soFromEnd);
        lFileStream.Write(LString[1], Length(lString));
        lFileStream.Write(sLineBreak, Length(sLineBreak)); // <-- sLineBreak is defined by VCL
        if lFileStream.Size > konPrtHighFileSize then begin
          TruncateStream;
        end;
      finally
        lFileStream.Free;
      end;
    except
      frmProt.PrtOptions.AbledPrtModes := frmProt.PrtOptions.AbledPrtModes -
        [pmFile];
    end
  end;//procedure LogToFile
begin
  lString := '';
  try //DIE TRY-EXCEPTS DIENTEN DER FEHLERSUCHE. UNTER UNBEKANNTEN
      //UMSTÄNDEN KOMMEN HIER BEIM ZUGRIFF AUF FPrtData AVs!
      //(VLLT WENN TLog.Add() VON 2 THREAD GLEICHZEITIG AUFGERUFEN WIRD?)
    case FPrtData.Typ of
      pmtInformation: lString := '###' + konPrtColDel;
      pmtConfirmation: lString := '???' + konPrtColDel;
      pmtWarning: lString := 'x!x' + konPrtColDel;
      pmtError: lString := 'XXX' + konPrtColDel;
    end;
  except
    on e:exception do begin
      MessageBeep(MB_ICONERROR);
      ShowMessage(e.Message+#13#10+e.ClassName);
    end;
  end;
                       //Using a formatSetting var it is thread save.
  try
    lString := lString + DateTimeToStr(Now, formatSet) + konPrtColDel +
      FPrtData.Msg + konPrtColDel + FPrtData.Cls + konPrtColDel + FPrtData.SQL + konPrtColDel +
      FPrtData.Details + konPrtColDel + IntToStr(FPrtData.DoId) + konPrtColDel +
      IntToStr(FPrtData.ConfigId) +
      konPrtLineDel;//2006_01_29 We need a Line-Delimiter cause of multiline prt entries!
  except
    on e:exception do begin
      MessageBeep(MB_ICONERROR);
      ShowMessage(e.Message+#13#10+e.ClassName);
    end;
  end;

  try
    case frmProt.PrtOptions.PrtUsage of
      cbChecked: begin
        if pmScreen in frmProt.PrtOptions.AbledPrtModes then
  //        LogToScreen; //REMED OUT FORM DEBUGGING PURPOSES
        if pmFile in frmProt.PrtOptions.AbledPrtModes then
  //        LogToFile;   //REMED OUT FORM DEBUGGING PURPOSES
      end;
      cbGrayed: begin
        if pmScreen in frmProt.PrtOptions.AbledPrtModes then
  //        LogToScreen; //REMED OUT FORM DEBUGGING PURPOSES
      end;
      cbUnchecked:;//nothing
    end;//case cbUseProt.State
  except
    on e:exception do begin
      MessageBeep(MB_ICONERROR);
      ShowMessage(e.Message+#13#10+e.ClassName);
    end;
  end;
end;

class procedure TLog.Add(const APrtData: TDaPrtData);
begin
  with TLog.Create(APrtData) do try
    Synchronize;
  finally
    Free;
  end;
end;

class procedure TLog.Add(const AStr: String);
var
  LPrtData: TDaPrtData;
begin
  FillChar(LPrtData, SizeOf(LPrtData), #0);
  LPrtData.Msg := AStr;
  with TLog.Create(LPrtData) do try
    Synchronize;
  finally
    Free;
  end;
end;

//------------------------ TLog ---------------------//
//---------------------------------------------------//
TIA

be blessed

Meta777 31. Mär 2006 10:36

Re: Threads und records / record-var "nicht mehr da/gül
 
:Push:

Kann es vielleicht sein das dieser Aufruf nicht threadsicher ist?
Delphi-Quellcode:
procedure TfrmProt.Add2Prot(const AStr: String);
var
  prtData: TDaPrtData;
begin
  FillChar(prtData, SizeOf(prtData), #0); //INITIALISIEREN DES RECORDS
  prtData.Msg := AStr;                   //LOG-TEXT ZUWEISEN
  TLog.Add(prtData);                     //prtData VAR ÜBERGEBEN...
end;
Aber die lokale Variable befindet sich doch im Stack des jeweiligen Threads!? Wenn dem so ist sollte es doch keine Probleme geben?
Oder hab ich ein generelles Unkenntnisproblem? :|

please help

NicoDE 31. Mär 2006 10:39

Re: Threads und records / record-var "nicht mehr da/gül
 
Zitat:

Zitat von Meta777
Aber die lokale Variable befindet sich doch im Stack des jeweiligen Threads!?

Nope, im lokalen Stack der aufrufenden Funktion (dieser ist nach dem Verlassen der Funktion nicht mehr gültig).

Meta777 31. Mär 2006 11:00

Re: Threads und records / record-var "nicht mehr da/gül
 
Zitat:

Zitat von NicoDE
Zitat:

Zitat von Meta777
Aber die lokale Variable befindet sich doch im Stack des jeweiligen Threads!?

Nope, im lokalen Stack der aufrufenden Funktion (dieser ist nach dem Verlassen der Funktion nicht mehr gültig).

Bedeutet das nun wenn 2 Threads "gleichzeitig" die procedure procedure "TfrmProt.Add2Prot(const AStr: String);" aufrufen, dass es dann nicht gehen kann?

Und wird beim Aufruf von TLog.Add(prtData) der Record kopiert oder nur ein Pointer weitergegeben?
Delphi-Quellcode:
procedure TfrmProt.Add2Prot(const AStr: String);
var
  prtData: TDaPrtData;
begin
  FillChar(prtData, SizeOf(prtData), #0);
  prtData.Msg := AStr;                  
  TLog.Add(prtData);                     //WIRD DER RECORD HIER KOPIERT????
end;

NicoDE 31. Mär 2006 11:56

Re: Threads und records / record-var "nicht mehr da/gül
 
edit: wegen Übermüdung entfernt, sorry.

Meta777 3. Apr 2006 16:28

Re: Threads und records / record-var "nicht mehr da/gül
 
Zitat:

Zitat von NicoDE
edit: wegen Übermüdung entfernt, sorry.

Na, haste jetzt ausgeschlafen? :stupid: :)

Wär schön wenn mir jmd. helfen könnte.

:PUSH: :roll:

Meta777 13. Apr 2006 19:16

Re: Threads und records / record-var "nicht mehr da/gül
 
Hallo nochmals...

Ich hab nun die TLog von TThread abgeleitet aber dennoch das selbe Problem, nur an andere Stelle. Jetzt hab ich die AV bei "TLogAdd".

Hier die TLogAdd Procedure. Die alte Version (auskommentiere) hab ich mal stehen lassen...
Delphi-Quellcode:
//class procedure TLog.Add(const APrtData: TDaPrtData);
procedure TLogAdd(const APrtData: TDaPrtData); overload;
var
  lt: TLog;
begin
  lt := TLog.Create(APrtData); <== HIER KOMMT DIE AV!!

//  with TLog.Create(APrtData) do try
//    Synchronize;
//  finally
//    Free;
//  end;
end;
Die modifizierte TLog Klasse, aber der Fehler ist ja momentan n
Delphi-Quellcode:
  TLog = class(TThread)//TIdSync
  protected
    FPrtData: TDaPrtData;
    procedure DoSynchronize;// override;
    procedure Execute; override;
    constructor Create(const APrtData: TDaPrtData);
  public
//    class procedure Add(const APrtData: TDaPrtData); overload;
//    class procedure Add(const AStr: String); overload;
  end;


constructor TLog.Create(const APrtData: TDaPrtData);
begin
  inherited Create(True);
  FPrtData := APrtData;

  FreeOnTerminate := True;
  Resume;
end;

procedure TLog.Execute;
begin
  Synchronize(Self.DoSynchronize);
end;


Alle Zeitangaben in WEZ +1. Es ist jetzt 15:02 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