DLL Problem AccessViolation nach mehrfachem Aufruf

Bronstein · Verfasst: Mi 16.12.09 16:01

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:

markieren

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:

markieren

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

_________________
Es gibt keine dummen Fragen nur dumme Antworten!!!

Boldar · Verfasst: Mi 16.12.09 16:03

Hast du den Kommentar gelesen, der oben steht, wenn du eine neue dll erstellst?

btw: Ist übrigens die Falsche Sparte

Bronstein · Verfasst: Mi 16.12.09 16:14

Hallo,
vielen Dank, ich such schon seit Stunden nach dem Fehler. Ich musste einfach die ShareMem Unit einbinden

_________________
Es gibt keine dummen Fragen nur dumme Antworten!!!

Boldar · Verfasst: Mi 16.12.09 16:24

Dann musst du allerdings die Borlndmm.dll mitliefern. Besser ist es, einfach PChar zu benutzen (also für die Parameter).

Bronstein · Verfasst: Mi 16.12.09 16:31

PChar habe ich doch bei allen Parametern:
function GetRuestungPfad(Linie, Ruestung: PChar): Pchar; stdcall;

_________________
Es gibt keine dummen Fragen nur dumme Antworten!!!

Boldar · Verfasst: Mi 16.12.09 16:38

Bronstein hat folgendes geschrieben :

markieren

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:

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;

Bronstein · Verfasst: Mi 16.12.09 16:56

Diese Funktion nutze ich doch nur intern in der DLL:
function XML_Decode(XML: String):String;

Und pText ist global in der DLL deklariert:
var
pText: Pchar;

Zur Info die auch das Problem haben, die Unit ShareMem muss in der DPR-Datei eingetragen werden, ansonsten bekommt man beim Beenden eine Exception!

_________________
Es gibt keine dummen Fragen nur dumme Antworten!!!

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme