Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Object-Pascal / Delphi-Language (https://www.delphipraxis.net/32-object-pascal-delphi-language/)
-   -   Delphi Exception wenn Interface in Unterfunktion angesprochen wird (https://www.delphipraxis.net/153020-exception-wenn-interface-unterfunktion-angesprochen-wird.html)

WorstNightmare 17. Jul 2010 15:35

Delphi-Version: 2010

Exception wenn Interface in Unterfunktion angesprochen wird
 
Hi, ich habe schon wieder ein Problem :(

Verschiedene Plugin-DLLs und das Host-Programm kommunizieren über Interfaces, soweit so gut. Eine der Hilfsfunktionen die jedes Plugin mitliefert ist es, Cookies aus HTML-Headern zu suchen und in einen String zu packen.

Delphi-Quellcode:
function KillDoubleEntries(Load: IHTTP; s: string): string;
var
  rStr, ws, Val: string;
  Names, Values: TStringArray;
  Next: Integer;
  i, j: Integer;
begin
  Names := nil;
  Values := nil;
  ws := s;
  rStr := Load.Tools.RegEx('.*?=', ws);
  while rStr <> NOT_MATCHED do
  begin
    SetLength(Names, Length(Names) + 1);
    Names[High(Names)] := Copy(rStr, 1, Length(rStr) - 1);

    if (Pos(';', ws) > 0) and (Find(ws, rStr, ';', val)) then
    begin
      SetLength(Values, Length(Values) + 1);
      Values[High(Values)] := Val;
    end
    else // am letzten ist kein ; mehr
    begin
      ws := Replace(ws, Names[High(Names)] + '=', '');
      SetLength(Values, Length(Values) + 1);
      Values[High(Values)] := ws;
    end;

    Next := Pos(';', ws);
    if Next = 0 then
      Break;

    Delete(ws, 1, Next);
    while (Length(ws) > 0) and (Ord(ws[1]) < 33) do
      Delete(ws, 1, 1);

    rStr := Load.Tools.RegEx('.*?=', ws);
  end;

  // verkackt
  if Length(Names) <> Length(Values) then
    Exit(s);

  // Alles von hinten durchgehen, wenn vorne was gleiches ist das '' machen
  for i := High(Names) downto 0 do
    for j := i - 1 downto 0 do
      if Names[i] = Names[j] then
      begin
        Names[j] := '';
        Values[j] := '';
      end;

  Result := '';

  for i := 0 to High(Names) do
    if Names[i] <> '' then
      Result := Result + Names[i] + '=' + Values[i] + '; ';

  // ; am Ende zuviel
  Delete(Result, Length(Result) - 1, 2);

  Names := nil;
  Values := nil;
  Showmessage('KillDoubleEntries ENDE'); // Diese Nachricht wird noch angezeigt
end;

function GetCookie(Load: IHTTP; Headers: string): string;
var
  i: Integer;
  Cok: TCSList;
  c: WideString;

  function Clean(s: string): string;
  var
    Crap: string;
  begin
    Result := s;
    Result := Replace(Result, 'path=/; ', '');
    Result := Replace(Result, 'path=/', '');

    Crap := Load.Tools.RegEx('domain=.*?;', Result);  // Sobald diese Zeile drin ist knallt es
  (*  while Crap <> NOT_MATCHED do
    begin
      Result := Replace(Result, Crap, '');
      Crap := Load.Tools.RegEx('domain=.*?;', Result);
    end;

    Crap := Load.Tools.RegEx('expires=.*?;', Result);
    while Crap <> NOT_MATCHED do
    begin
      Result := Replace(Result, Crap, '');
      Crap := Load.Tools.RegEx('expires=.*?;', Result);
    end;

    Crap := Load.Tools.RegEx('domain=.*?' + Result[Length(Result)], Result);
    while Crap <> NOT_MATCHED do
    begin
      Result := Replace(Result, Crap, '');
      Crap := Load.Tools.RegEx('domain=.*?' + Result[Length(Result)], Result);
    end;   *)

    Result := ChrKill(Result, [#10, #13]);

    while Pos(#32#32, Result) > 0 do
      Result := Replace(Result, #32#32, #32);
  end;

begin
  Result := 'PHPSESSID=abcdefghijklmnopqrstuvwxyz';

  (*Cok := TCSList.CreateFrom(Headers, 'Set-Cookie: ', #13#10);
  if Cok.IsEmpty then
    Exit
  else
  begin
    for i := 0 to Cok.Count - 1 do
      Result := Result + Cok[i] + '; ';

    Cok.Free;
  end;                 *)
   c := Load.Tools.RegEx('domain=.*?;', Result);
  Result := Clean(Result);
  // Am Ende steht kein ; und auch kein Leerzeichen
  while AnsiChar(Result[Length(Result)]) in [#32, ';'] do
    Delete(Result, Length(Result), 1);

  Result := KillDoubleEntries(Load, Result);

  // Hier A/V, nur wenn Clean() aufgerufen wird.
 
  Showmessage(Result);
end;
Load ist das Hauptinterface, was das Plugin bekommt und Tools ist eine Funktion, die ein weiteres Interface rausgibt, welches Funktionen bereitstellt, die die Plugins zu stark vergrößern würden (weil Extraunits eingebunden werden müssten, die Plugins sollen eine Größe von ~50 KB beibehalten).
Leider kommt eine Zugriffsverletzung, wenn Clean UND KillDoubleEntries ausgeführt werden (nur eines von beiden geht). Wenn ich den Zugriff auf das Interface in Clean() auskommentiere, geht es auch. Das seltsame ist, dass es nur Probleme gibt, wenn in dieser Unterfunktion Clean aufs Interface zugegriffen wird. Wenn die Zeile (wie im Code) in der Hauptprozedur steht geht alles.
Achja, alle String-Typen in den interfaces sind ausschließlich WideStrings.

Habe ich wieder irgendetwas mit der Referenzzählung nicht beachtet? :?

Stevie 21. Jul 2010 13:32

AW: Exception wenn Interface in Unterfunktion angesprochen wird
 
Es gibt einen "Bug" (ich find leider den QC Eintrag nicht) mit Funktionen, die ein Interface zurückliefern und auf die direkt wieder (ohne das Ergebnis in einer Variable zu speichern) zugegriffen wird. Könnte sein, dass du hier ein Opfer davon bist. Ansonsten einfach mal das _Release debuggen und schauen, wo einmal zu viel der RefCount verringert wird.


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