Entwickler-Ecke :: Thema anzeigen - DLL Problem AccessViolation nach mehrfachem Aufruf

Bronstein - Mi 16.12.09 16:01
Titel: DLL Problem AccessViolation nach mehrfachem Aufruf

Hallo, ich habe ein Problem beim Aufrufen einer DLL.

Ich kann die Funktion GetUruestdauer ein paar mal aufrufen, und die Funktion funktioniert. Wenn ich sie dann nochmal aufrufe, bekomme ich eine Exception:
Project xxx.exe raised exception class EAccessViolation with message 'Access violation at address 004048EB in module 'xxx.exe'. Read of address 01354038'. Process stopped. Use Step or Run to continue.

Hier der Code vom Formular:

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:

function DeallocXMLStrings(DLLName: String): PChar;
type
  TDeallocXMLStrings = procedure(); stdcall;
var
  hDLL: THandle; // Handle zur DLL
  iRes: integer; // Ergebnis der Funktion
  FarProc: TDeallocXMLStrings;
  sDLLPath, XML: PChar;
  xmlDocTaktZeit: IXmlDocument;
  tmpStr: String;
begin
  try
    sDLLPath := pChar(ExtractFilePath(ParamStr(0)) + ''+DLLName);
    hDLL := LoadLibrary(sDLLPath);
    if hDLL = 0 then
      Form1.Statusmeldung('Error', DLLName + ' konnte nicht geladen')
    else
    begin
      try
        FarProc := GetProcAddress(hDLL, 'DeallocXMLStrings');
      except
        Form1.Statusmeldung('Error', 'Funktion der DLL konnte nicht ausgeführt werden.');
      end;
    end;
    FreeLibrary(hDLL);
  except
    Form1.Statusmeldung('Error', 'Fehler DeallocXMLStrings');
  end;
end;

function GetPfadRuestung(DLLName, Linie, Ruestung: String): PChar;
type
  TGetRuestungPfad = function(Linie, Ruestung: Pchar): PChar;  stdcall;
var
  hDLL: THandle; // Handle zur DLL
  iRes: integer; // Ergebnis der Funktion
  FarProc: TGetRuestungPfad;
  sDLLPath, XML: PChar;
  xmlDocTaktZeit: IXmlDocument;
  tmpStr: String;
begin
  try
    Application.ProcessMessages;
    sDLLPath := pChar(ExtractFilePath(ParamStr(0)) + ''+DLLName);
    hDLL := LoadLibrary(sDLLPath);
    if hDLL = 0 then
      Form1.Statusmeldung('Error', DLLName + ' konnte nicht geladen')
    else
    begin
      try
        FarProc := GetProcAddress(hDLL, 'GetRuestungPfad');
        if Assigned(FarProc) then
        begin
          //CoInitialize(nil);
          XML := FarProc(pChar(Linie), pChar(Ruestung));
          xmlDocTaktZeit := LoadXMLData(XML);
          tmpStr := xmlDocTaktZeit.DocumentElement.ChildNodes['Ruestung'].NodeValue + '\';
          result := PChar(tmpStr);
        end;
        DeallocXMLStrings(DLLName);
      except
        Form1.Statusmeldung('Error', 'Funktion der DLL konnte nicht ausgeführt werden.');
      end;
    end;
    FreeLibrary(hDLL);
  except
    ShowMessage('Fehler GetPfadRuestung: DLL: ' + DLLName + 'Linie: ' + Linie + ' Ruestung: ' + Ruestung);
  end;
end;

function GetUmruestDauer(DLLName, Linie, RuestungVon, RuestungNach: PChar): Integer;
type
  TGetUmruestung = function(RuestungVon, RuestungNach: Pchar): PChar;  stdcall;
var
  hDLL: THandle; // Handle zur DLL
  iRes: integer; // Ergebnis der Funktion
  FarProc: TGetUmruestung;
  sDLLPath, XML: PChar;
  xmlDocTaktZeit: IXmlDocument;
  tmpVon, tmpNach, tmpStr: String;
begin
  try
    Application.ProcessMessages;
    //CoInitialize(nil);
{    tmpVon := GetPfadRuestung(DLLName, Linie, RuestungVon);
    tmpNach := GetPfadRuestung(DLLName, Linie, RuestungNach);}

    tmpVon := 'Linie_1\980_186\B_980_186_1\';
    tmpNach := 'Linie_1\980_321\B_980_321_2\';
    sDLLPath := pChar(ExtractFilePath(ParamStr(0)) + ''+DLLName);
    hDLL := LoadLibrary(sDLLPath);
    if hDLL = 0 then
      Form1.Statusmeldung('Error', DLLName + ' konnte nicht geladen')
    else
    begin
      try
        FarProc := GetProcAddress(hDLL, 'GetUmruestung');
        if Assigned(FarProc) then
        begin
          //CoInitialize(nil);
          XML := FarProc(pChar(tmpVon), pChar(tmpNach));
          xmlDocTaktZeit := LoadXMLData(XML);
          tmpStr := xmlDocTaktZeit.DocumentElement.Attributes['Dauer'];
          result := StrToInt(tmpStr);
        end;
        DeallocXMLStrings(DLLName);
      except
        Form1.Statusmeldung('Error', 'Funktion der DLL konnte nicht ausgeführt werden.');
      end;
    end;
    FreeLibrary(hDLL);
  except
    ShowMessage('Fehler: GetUmruestDauer  ' + DLLName + '  '  + Linie + '  '  + RuestungVon + '  '  + RuestungNach + XML);
  end;
end;

Hier der Code der DLL funktionen:

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:

function XML_Decode(XML: String):String;
begin
  XML := StringReplace(XML, '&', '&', [rfReplaceAll]);
 { XML := StringReplace(XML, '<', '<', [rfReplaceAll]);
  XML := StringReplace(XML, '>', '>', [rfReplaceAll]);
  XML := StringReplace(XML, '"', '"', [rfReplaceAll]);  }

  XML := StringReplace(XML, 'Ä', 'Ä', [rfReplaceAll]);
  XML := StringReplace(XML, 'Ö', 'Ö', [rfReplaceAll]);
  XML := StringReplace(XML, 'Ü', 'Ü', [rfReplaceAll]);
  XML := StringReplace(XML, 'ä', 'ä', [rfReplaceAll]);
  XML := StringReplace(XML, 'ö', 'ö', [rfReplaceAll]);
  XML := StringReplace(XML, 'ü', 'ü', [rfReplaceAll]);
  XML := StringReplace(XML, 'ß', 'ß', [rfReplaceAll]);
  result := XML;
end;

procedure DeallocXMLStrings(); stdcall;
begin
  try
    StrDispose(pText); //Speicher des PChar wieder freigeben
  except
    Protokoll_Log('DeallocXMLStrings: unbekannter Fehler');
  end;
end;

function GetRuestungPfad(Linie, Ruestung: PChar): Pchar; stdcall;
var
  ini: TIniFile;
  Benutzer, Passwort, Server: String;
  AdoQueryDESK: TAdoQuery;
  i: Integer;
  XML: WideString;
  tmpStr: String;
begin
  result := 'Error';
  try
    ini:=TIniFile.Create(ExtractFilePath(ParamStr(0)) + '\ruestkontrolle.ini');
    Benutzer := ini.ReadString('SMD', 'Benutzer', 'sa');
    Passwort := ini.ReadString('SMD', 'Passwort', 'ms128');
    Server := ini.ReadString('SMD', 'ServerDB' , 'OVW009');
    ini.Free;
    AdoQueryDESK := TAdoQuery.Create(nil);
    AdoQueryDESK.ConnectionString := '....';
    AdoQueryDESK.SQL.Clear;
    AdoQueryDESK.SQL.Add('SELECT .....');
    AdoQueryDESK.Active := true;
    tmpStr := 'Error';
    if AdoQueryDESK.RecordCount > 0 then
    begin
      tmpStr := AdoQueryDESK.FieldByName('ObjectName').AsString;
    end


    XML := '<RuestungsPfad>';
    XML := XML + '<Ruestung Name="' + Ruestung + '">'+tmpStr+'</Ruestung>';
    XML := XML + '</RuestungsPfad>';

    AdoQueryDESK.Free;

    XML := XML_Decode(XML);
    pText := StrAlloc(Length(XML) + 1);
    StrPLCopy(pText, XML, Length(XML));
    result := pText;
  except
    Protokoll_Log('Fehler bei GetRuestungPfad');
  end;    
end;

Wenn ich diese beiden Zeilen ausblende funktioniert es immer:
tmpVon := GetPfadRuestung(DLLName, Linie, RuestungVon);
tmpNach := GetPfadRuestung(DLLName, Linie, RuestungNach);

Moderiert von Narses: Topic aus VCL (Visual Component Library) verschoben am Mi 16.12.2009 um 17:31

Entwickler-Ecke.de based on phpBB
Copyright 2002 - 2011 by Tino Teuber, Copyright 2011 - 2025 by Christian Stelzmann Alle Rechte vorbehalten.
Alle Beiträge stammen von dritten Personen und dürfen geltendes Recht nicht verletzen.
Entwickler-Ecke und die zugehörigen Webseiten distanzieren sich ausdrücklich von Fremdinhalten jeglicher Art!