Hallo,

in letzter Zeit häufen sich AccessViolations in unseren Projekten, wo ich leider an meine Grenzen stoße. Die sind für mich nicht nachzuvollziehen, ev. hat hier jemand eine Idee. Folgend der Protokolleintrag (JCL Error Dialog):

markieren

Code:

Zugriffsverletzung bei Adresse 00404ED4 in Modul 'lps.exe'. Lesen von Adresse FFFFFFFD.
------------------------------------------------------------------------------
Fehlerklasse: EAccessViolation
Fehlermeldung: Zugriffsverletzung bei Adresse 00404ED4 in Modul 'lps.exe'. Lesen von Adresse FFFFFFFD.
Fehleradresse: 00404ED4
------------------------------------------------------------------------------
Hauptthread ID = 1084
Fehlerthread ID = 1084
------------------------------------------------------------------------------
Fehlerstack
Stackliste, erzeugt 05.12.2011 14:04:27
[00404ED4]{lps.exe    } System.TObject.Free
[0085B3AD]{lps.exe    } HTTPV2.TFormHTTPV2.Post (Line 354, "..\MainSystem\HTTPV2.pas" + 7)
[0088EDFE]{lps.exe    } Main.TForm_Main.UploadPrograms (Line 2636, "Main.pas" + 21)
[00893E1C]{lps.exe    } Main.TForm_Main.ShowProgramEditorDelayed (Line 3856, "Main.pas" + 43)
[0046721B]{lps.exe    } ExtCtrls.TTimer.Timer (Line 2281, "C:\builds\Tp\vcl\i18n\de\ExtCtrls.pas" + 1)
[0043844C]{lps.exe    } Classes.StdWndProc
------------------------------------------------------------------------------
Callstack des Hauptthread
Stackliste, erzeugt 05.12.2011 14:04:27
[77DA64F4]{ntdll.dll  } KiFastSystemCallRet

Meiner Meinung nach dürfte der Fehler so aber gar nicht auftreten können. In der Zeile 354 von HTTPV2.TFormHTTPV2.Post wird eine Funktion der selben Form aufgerufen:

zusammenfalten · markieren

Delphi-Quellcode:

function TFormHTTPV2.Post(Url, Filename, ErrorHint: string): integer;
begin
348: ClearItems;
349: // Anmerkung: Items[x] ist ein array-property, das das interne array - bei bedarf - automatisch erhöht
350: Items[0].RequestType := httpPost;
351: Items[0].URL := Url;
352: Items[0].LocalFile := Filename;
353:
354: Result := Send(ErrorHint);
end;

function TFormHTTPV2.Send(ErrorHint: string): integer;
begin
...
end;

Also meiner Meinung nach müsste er doch zumindest in .Send reinlaufen und dort einen Fehler protokollieren. Laut stack list wäre ja entweder die Form selbst, die Funktion "Send" oder der string Errorhint nicht vorhanden, alles eher unwahrscheinlich

Deutet das auf interne Speicherlecks/bugs hin, die sich erst später auswirken? Im Normalfall funktioniert der Aufruf anstandslos, aber sporadisch werden uns AccessViolations ähnlich dieser gemeldet, mit denen man einfach nichts mehr anfangen kann.

Jo, auch ich habe ein Problem den Fehler nachzuvollziehen, da ich vermute, daß das clearItems; den Fehler verursacht.
Aber ohne die entsprechenden Sourcen, fällt es schwer, hierzu etwas Vernünftiges zu sagen.
Ach ja, wie Items definiert ist, würde mich auch interessieren.
(array of TMyRecord...?)

Gruß
K-H

Zeig mal TFormHTTPV2.Send(ErrorHint: string): integer;

Nun, da wird's halt etwas ausführlicher

zusammenfalten · markieren

Delphi-Quellcode:

  
  TV2Request = record
    RequestType: TV2RequestType;
    Res: integer;
    URL: string;
    LocalFile: string;
    HTTPContent: string;
    RequestVars: TStringList;
  end;
  PV2Request = ^TV2Request;

  TFormHTTPV2 = class(TForm)
  private
    FV2Requests: array of TV2Request;

    function GetItem(x: integer): PV2Request;
    function GetItemCount: integer;
  public
    procedure ClearItems;

    property ItemCount: integer read GetItemCount;
    property Items[x: integer]: PV2Request read GetItem;
  end;

procedure TFormHTTPV2.ClearItems;
begin
  SetLength(FV2Requests, 0);
end;

function TFormHTTPV2.GetItem(x: integer): PV2Request;
begin
  if (x >= 0) and (x <= High(FV2Requests)) then
  begin
    Result := @FV2Requests[x];
    exit;
  end;

  SetLength(FV2Requests, Length(FV2Requests) + 1);
  FillChar(FV2Requests[High(FV2Requests)], SizeOf(TV2Request), 0);

  Result := @FV2Requests[High(FV2Requests)];
  Result.RequestVars := TStringList.create;
end;

function TFormHTTPV2.GetItemCount: integer;
begin
  Result := length(FV2Requests);
end;

Das sollte alles an relevantem Code sein. Eine Sache die mir selber gerade auffällt, bei ClearItems sollte ich nat. auch die StringList freigeben. Möglich, dass sich ein fehlendes Freigeben von Stringlists so auswirkt?

Besten Dank schon mal

IMHO wäre das Ganze um Längen einfacher zu verwalten, wenn man aus TV2Request eine Klasse macht (zumindest solange eine Objektinstanz, hier eine Stringliste, enthalten ist) und aus FV2Requests eine TObjectList.

Ok, sorry, das .free für die Stringlists übernimmt das die .Send-Funktion, kA warum aber irgendeinen Sinn wird das schon gehabt haben. Die .Send kann ich nat. posten, aber dadurch wird's halt nicht kürzer ...

zusammenfalten · markieren

Delphi-Quellcode:

function TFormHTTPV2.Send(ErrorHint: string): integer;
var
  E, I, FS: integer;
  FileStream: TFileStream;
  MemoryLst: TStringList;
  ActiveCursor: TCursor;
  ErrorMsg: string;
  HTTPRequest: TclHttpRequest;
  Rec: TRect;
begin
  ModalResult := mrNone;
  LastReasonPhrase := 'OK';

  // Leave on demo mode
  if FIsDemoMode then
  begin
    Result := -10000;
    Hide;
    exit;
  end;

  if Visible then
  begin
    Rec := Rect(left, top, width - left, height - top);
    MouseFencer.ExecuteEnh(Rec);
  end;

  Result := -1;
  ErrorMsg := '';

  ActiveCursor := Screen.Cursor;
  if Length(FV2Requests) > 1 then
    MaxValue := Length(FV2Requests)
  else
    MaxValue := 60;
  UserValue := 0;
  Busy := False;

  // Load error message
  if ErrorHint <> '' then
    LoadErrorHint(ErrorHint);

  // Set minimum timeout (30000) if visible, or not timeout (100 sec) if file exists
  if FileExists(ExtractFilePath(application.exename) + '~notimeout.txt') then
    HTTP.TimeOut := 100000
  else if Visible then
    HTTP.TimeOut := Max(HTTP.Timeout, FMiddleTimeOut);

  // Init
  I := 0;
  
  repeat
    if HTTP.Active then
      try
        HTTP.Close;
      except
      end;

    ModalResult := mrNone;

    // Change cursor if invisible
    if not Visible then
      Screen.Cursor := crHourGlass;

    // Reset controls
    Notebook.PageIndex := 0;
    LabelError1.Hide;
    LabelProxy.Hide;
    LabelProxy2.Hide;
    ButtonOK.Hide;
    ButtonAbort.Caption := '&Abbrechen';

    UserValue := 0;
    if Length(FV2Requests) > 1 then
      MaxValue := Length(FV2Requests)
    else
      MaxValue := HTTP.TimeOut div 25;

    Application.ProcessMessages;
    TimerTime.Enabled := True;

    if not IsConnectedToInternet then
    begin
      Result := INTERNET_STATE_DISCONNECTED;
      ErrorMsg := 'HTTP-Fehler: Keine bestehende Internetverbindung gefunden';
    end
    else
    begin
      SetProxySettings;
      FWebAccess := noSuccess;

      while I <= High(FV2Requests) do
      begin
        if Length(FV2Requests) <= 1 then
        begin
          UserValue := 0;
          if Visible then
            Sleep(250);
        end;

        HTTPRequest := TclHttpRequest.Create(self);
        HTTPRequest.Header.Accept := '*/*';
        //HTTPRequest.Header.CharSet := 'UTF-8';
        HTTPRequest.Header.ContentType := 'multipart/form-data';

        // Replace spaces
        if Pos('?', FV2Requests[i].URL) > 0 then
          FV2Requests[i].URL := ReplaceStr(FV2Requests[i].URL, #32, '%20');
        DebugOut('DL # ' + inttostr(i) + ': ' + FV2Requests[i].URL);

        try
          // Reset controls
          MemoryLst := Nil;
          FileStream := Nil;

          // Prepare request
          if Pos('=', FV2Requests[i].LocalFile) > 0 then
            HTTPRequest.AddSubmitFile(StrBefore('=', FV2Requests[i].LocalFile), StrAfter('=', FV2Requests[i].LocalFile));
          for e := 0 to FV2Requests[i].RequestVars.count - 1 do
            HTTPRequest.AddFormField(StrBefore('=', FV2Requests[i].RequestVars[e]), StrAfter('=', FV2Requests[i].RequestVars[e]));
          for e := 0 to HTTPRequest.Count - 1 do
            HTTPRequest.Items[e].Canonicalized := False;

          // Prepare stringlist/stream
          if (FV2Requests[i].RequestType = httpGet) and (FV2Requests[i].LocalFile <> '') then
            FileStream := TFileStream.create(FV2Requests[i].LocalFile, fmCreate)
          else
            MemoryLst := TStringList.create;

          try
            FV2Requests[i].Res := 0;
            FV2Requests[i].HTTPContent := '';

            Busy := True;
            if FV2Requests[i].LocalFile = '' then
            begin
              if FV2Requests[i].RequestType = httpGet then
                HTTP.Get(FV2Requests[i].URL, MemoryLst)
              else
                HTTP.Post(FV2Requests[i].URL, HTTPRequest, MemoryLst);
            end
            else
            begin
              if FV2Requests[i].RequestType = httpGet then
                HTTP.Get(FV2Requests[i].URL, FileStream)
              else
                HTTP.Post(FV2Requests[i].URL, HTTPRequest, MemoryLst);
            end;
            Busy := False;

            if MemoryLst <> Nil then
              FV2Requests[i].HTTPContent := MemoryLst.Text
            else if FileStream <> Nil then
              FV2Requests[i].HTTPContent := 'FILE';

            Result := 200;
            FV2Requests[i].Res := Result;
            LastReasonPhrase := 'OK';
            ErrorMsg := '200: OK';

            if HTTP.ProxySettings.Server <> '' then
              FWebAccess := proxySuccess
            else
              FWebAccess := directSuccess;

            if MemoryLst <> Nil then
              LogHTTPMessage(ErrorMsg, Length(MemoryLst.Text))
            else if FileStream <> Nil then
              LogHTTPMessage(ErrorMsg, FileStream.Size);

          finally

            if MemoryLst <> Nil then
              MemoryLst.Free
            else if FileStream <> Nil then
            begin
              FS := FileStream.Size;
              FileStream.free;

              if FS = 0 then
              if FV2Requests[i].RequestType = httpGet then
              if FV2Requests[i].LocalFile <> '' then
              if FileExists(FV2Requests[i].LocalFile) then
              if FS = 0 then
                DeleteFile(FV2Requests[i].LocalFile);
            end;

            if HTTPRequest <> Nil then
              HTTPRequest.Free;
            HTTPRequest := Nil;

          end;
        except
          on E: EclSocketError do
          begin
            Busy := False;
            Result := E.ErrorCode;
            LastReasonPhrase := E.Message;
            ErrorMsg := Format('%s #%d: %s', ['EclSocketError', E.ErrorCode, E.Message]);
            FV2Requests[i].Res := Result;
            LogHTTPMessage(ErrorMsg, 0);

            if E.ErrorCode = 404 then
            begin
              // not found
              Result := 200;
              LastReasonPhrase := 'OK';
              FV2Requests[i].Res := Result;
              ErrorMsg := '200: OK';
            end
            else if HTTP.ProxySettings.Server <> '' then
            begin
              // Try without proxy
              UserValue := 0;
              HTTP.ProxySettings.Server := '';
              Abort;
              Continue;
            end
            else
              break;

          end;

          on E: EclHttpError do
          begin
            Busy := False;
            Result := E.ErrorCode;
            LastReasonPhrase := E.ResponseText;
            FV2Requests[i].Res := Result;
            ErrorMsg := Format('%s #%d: %s', ['EclHttpError', E.ErrorCode, E.ResponseText]);

            LogHTTPMessage(ErrorMsg, 0);
            break;
          end;

          on E: Exception do
          begin
            Busy := False;
            Result := E.HelpContext;
            LastReasonPhrase := E.Message;
            FV2Requests[i].Res := Result;
            ErrorMsg := Format('%s #%d: %s', ['Exception', E.HelpContext, E.Message]);

            LogHTTPMessage(ErrorMsg, 0);
            break;
          end;

        end;

        if Length(FV2Requests) <= 1 then
          UserValue := ProgressBar.MaxValue
        else
          UserValue := UserValue + 1;

        Inc(i);
      end;
    end;

    Busy := False;
    
    // Set progress to max
    TimerTime.Enabled := False;
    UserValue := ProgressBar.MaxValue;

    // Set error messages
    LabelError1.caption := ErrorMsg;
    LabelError1.hint := ErrorMsg;
    LabelError2.caption := ErrorMsg;
    LabelError2.hint := ErrorMsg;

    // Change to error page if necessary
    if Result <> 200 then
    if ErrorHint <> '' then
      Notebook.PageIndex := 1;

    // Reset cursor or hide on success
    if not Visible then
      Screen.Cursor := ActiveCursor
    else if Result = 200 then
      Hide;

    // Wait for retry or cancel button
    if Result <> 200 then
    if Result <> INTERNET_STATE_DISCONNECTED then
    if Visible then
    if ModalResult <> mrAbort then
    begin
      LabelError1.Show;

      if Assigned(FOnProxyClick) then
      begin
        LabelProxy.Show;
        LabelProxy2.Show;
      end;

      ButtonAbort.Caption := '&Überspringen';
      ButtonOK.Show;

      repeat
        Application.ProcessMessages;
        Sleep(1);

        if not Visible then
          ModalResult := mrAbort;

      until ModalResult <> mrNone;

    end;

    // Leave if: invisible, success, noInternet or Cancel-Button
  until (Visible = False) or (Result = 200) or (Result = INTERNET_STATE_DISCONNECTED) or (ModalResult <> mrOK);

  // Set timeout for next try (faster)
  if Result <> INTERNET_STATE_DISCONNECTED then
  if Result <> 200 then
    HTTP.TimeOut := FMinTimeOut;

  // Free request string lists
  for i := 0 to High(FV2Requests) do
    if FV2Requests[i].RequestVars <> Nil then
      FV2Requests[i].RequestVars.Free;

  // Run finish procedure if assigned
  if Assigned(FOnFinished) then
    FOnFinished(self);

  // Hide and reset
  Visible := False;
  MouseFencer.Stop;
end;

Bei jedem Zugriff auf GetItem wird eine StringList erzeugt. Das ist gelinde gesagt sehr unschön. Besser die entsprechende (schon erzeugte) Stringlist als Parameter mitschicken.

Moment... Die Stringlist wird nur erzeugt wenn die Liste erhöht wird, also nur 1x pro Item. Falls das Item vorhanden ist springt die Funktion ja mit exit raus.

An Deiner Stelle würde ich zunächst einmal schauen, ob man den Code nicht übersichtlicher gestalten kann (z.B. mit ein paar Unterfunktionen). Und dann wie gesagt aus dem Record eine Klasse machen und über TObjectList verwalten, dann ist auch die Klasse für die enthaltene Stringliste verantwortlich, von außen würde ich den direkten Zugriff verweigern, indem man die Stringliste verbirgt und lediglich Schnittstellen in Form von Methoden und/oder Properties bereitstellt.

Zitat von genesisv:

Moment... Die Stringlist wird nur erzeugt wenn die Liste erhöht wird, also nur 1x pro Item. Falls das Item vorhanden ist springt die Funktion ja mit exit raus.

Hatte ich gesehen. Trotzdem. Dann kann Create und Fee auf derselben Ebene stattfinden.(Siehe Assigns bei Delphi, sind immer Proceduren).

// Edit: Und CLearItems (sinngemäß):

markieren

Delphi-Quellcode:

procedure TFormHTTPV2.DelItem(I: integer);
begin
  FV2Requests[I].RequestVars.Free;
  SetLength(FV2Requests, Length(FV2Requests) - 1);
end;

procedure TFormHTTPV2.ClearItems;
begin
  while Length(FV2Requests) > 0 do DelItem(Length(FV2Requests)-1);
end;

// Edit2: Oder über TList:

zusammenfalten · markieren

Delphi-Quellcode:

unit uTListBeispielUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TV2Request = record
    RequestType: TV2RequestType;
    Res: integer;
    URL: string;
    LocalFile: string;
    HTTPContent: string;
    RequestVars: TStringList;
  end;
  TV2RequestList = class (TList)
    function GetItem (const Index: integer): TV2Request;
    procedure AddItem (const U: TV2Request);
    procedure InsItem (const Index: integer; const U: TV2Request);
    procedure DelItem (const Index: integer);
    procedure SetItem (const Index: integer; const U: TV2Request);
    procedure ClearList;
  public
    destructor Destroy; override;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  end;

var
  Form1: TForm1;
  List: TV2RequestList;

implementation

{$R *.dfm}

destructor TV2RequestList.Destroy;
begin
  ClearList;
  inherited;
end;

procedure TV2RequestList.ClearList;
begin
  while Count > 0 do delItem(Count-1);
end;

function TV2RequestList.GetItem (const Index: integer): TV2Request;
var
  V: ^TV2Request;
begin
  V:= Items[Index];
  Result:= V^;
end;

procedure TV2RequestList.SetItem (const Index: integer; const U: TV2Request);
var
  V: ^TV2Request;
begin
  V:= Items[Index];
  V^:= U;
end;

procedure TV2RequestList.AddItem (const U: TV2Request);
var
  V: ^TV2Request;
begin
  New (V);
  V^:= U;
  V.RequestVars:= TStringList.Create;
  Add(V);
end;

procedure TV2RequestList.InsItem (const Index: integer; const U: TV2Request);
var
  V: ^TV2Request;
begin
  New (V);
  V^:= U;
  V.RequestVars:= TStringList.Create;
  Insert(Index, V);
end;

procedure TV2RequestList.DelItem (const Index: integer);
var
  V: ^TV2Request;
begin
  V:= Items[Index];
  V.RequestVars.Free;
  Dispose(V);
  Delete(Index);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  List:= TV2RequestList.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  List.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  I: integer;
  Request: TV2Request;
begin
  for I:= 1 to 10 do
    List.AddItem(Request);
end;

end.