Zugriffsverletzung

[schand99]

Ich glaub ich werd welk...

Der Tipp von Benedikt Magnus, das ist DER Tipp. Dachte ich mir. Habe das Programm so umgebaut, dass die DLL für jeden Aufruf dynamisch geladen wird. Die ganze Funktion sieht nun so aus:

Delphi-Quellcode:

Function UDllCall(FType, FName: String; TKM, XVar: Double): Double;
 Type
  TFreon1Para = function(ref: PAnsiChar; var dlret: Double): Boolean; stdcall;
  TFreon2Para = function(ref: PAnsiChar; t: Double; var dlret: Double): Boolean; stdcall;
  TFreon3Para = function(ref: PAnsiChar; t, p: Double; var dlret: Double): Boolean; stdcall;
 Var
  hDLL: THandle;
  FarProc1: TFreon1Para;
  FarProc2: TFreon2Para;
  FarProc3: TFreon3Para;
  Temp, res: Double;
  Refr: PAnsiChar;
  Erg: WordBool;
  f: TextFile;
  Adw: String;
Begin
   //GetMem(Refr, 16);
   Temp := 273.15 + TKM;
   // Berechnen der Stoffwerte
   Refr := PAnsiChar('r407c');
   if FType = 'R404A' then
      Refr := PAnsiChar('r404a')
   else if FType ='R407C' then
      Refr := PAnsiChar('r407c')
   else if FType ='R134A' then
      Refr := PAnsiChar('r134a')
   else if FType ='R410A' then
      Refr := PAnsiChar('r410a')
   else if FType ='R507' then
      Refr := PAnsiChar('r507')
   else if FType ='R22' then
      Refr := PAnsiChar('r22');
   hDLL := LoadLibrary(DLLName);
   if hDLL = 0 then
      begin

      end
     else
      Begin
         if Uppercase(FName) = 'S_TC' then
            Begin
               FarProc1 := GetProcAddress(hDLL, 'S_tc');
               if Assigned(FarProc1) then
                  erg := FarProc1(refr, res)
                 else
                  res := -999999;
               //erg := S_tc(Refr, res);
            End;
         if Uppercase(FName) = 'S_PC' then
            Begin
               FarProc1 := GetProcAddress(hDLL, 'S_pc');
               if Assigned(FarProc1) then
                  erg := FarProc1(refr, res)
                 else
                  res := -999999;
               //erg := S_pc(Refr, res);
            End;
         if Uppercase(FName) = 'S_P_D' then
            Begin
               FarProc2 := GetProcAddress(hDLL, 'S_p_d');
               if Assigned(FarProc2) then
                  erg := FarProc2(refr, Temp, res)
                 else
                  res := -999999;
               //erg := S_p_d(Refr, Temp, res);
            End;
         if Uppercase(FName) = 'S_H_L' then
            Begin
               FarProc2 := GetProcAddress(hDLL, 'S_h_l');
               if Assigned(FarProc2) then
                  erg := FarProc2(refr, Temp, res)
                 else
                  res := -999999;
               //erg := S_h_l(Refr, Temp, res);
            End;
         if Uppercase(FName) = 'S_H_V' then
            Begin
               FarProc3 := GetProcAddress(hDLL, 'S_h_v');
               if Assigned(FarProc3) then
                  erg := FarProc3(refr, Temp, XVar, res)
                 else
                  res := -999999;
               //erg := S_h_v(Refr, Temp, XVar, res);
            End;
         if Uppercase(FName) = 'S_SIGMA_L' then
            Begin
               FarProc2 := GetProcAddress(hDLL, 'S_sigma_l');
               if Assigned(FarProc2) then
                  erg := FarProc2(refr, Temp, res)
                 else
                  res := -999999;
               //erg := S_sigma_l(Refr, Temp, res);
            End;
         if Uppercase(FName) = 'S_VISC_L' then
            Begin
               FarProc2 := GetProcAddress(hDLL, 'S_visc_l');
               if Assigned(FarProc2) then
                  erg := FarProc2(refr, Temp, res)
                 else
                  res := -999999;
               //erg := S_visc_l(Refr, Temp, res);
            End;
         if Uppercase(FName) = 'S_VISC_V'then
            Begin
               FarProc3 := GetProcAddress(hDLL, 'S_visc_v');
               if Assigned(FarProc3) then
                  erg := FarProc3(refr, Temp, XVar, res)
                 else
                  res := -999999;
               //erg := S_visc_v(Refr, Temp, XVar, res);
            End;
         if Uppercase(FName) = 'S_V_L' then
            Begin
               FarProc2 := GetProcAddress(hDLL, 'S_v_l');
               if Assigned(FarProc2) then
                  erg := FarProc2(refr, Temp, res)
                 else
                  res := -999999;
               //erg := S_v_l(Refr, Temp, res);
            End;
         if Uppercase(FName) = 'S_V_V' then
            Begin
               FarProc3 := GetProcAddress(hDLL, 'S_v_v');
               if Assigned(FarProc3) then
                  erg := FarProc3(refr, Temp, XVar, res)
                 else
                  res := -999999;
               //erg := S_v_v(Refr, Temp, XVar, res);
            End;
         if Uppercase(FName) = 'S_CP_L' then
            Begin
               FarProc2 := GetProcAddress(hDLL, 'S_cp_l');
               if Assigned(FarProc2) then
                  erg := FarProc2(refr, Temp, res)
                 else
                  res := -999999;
               //erg := S_cp_l(Refr, Temp, res);
            End;
         if Uppercase(FName) = 'S_LAMBDA_L' then
            Begin
               FarProc2 := GetProcAddress(hDLL, 'S_lambda_l');
               if Assigned(FarProc2) then
                  erg := FarProc2(refr, Temp, res)
                 else
                  res := -999999;
               //erg := S_lambda_l(Refr, Temp, res);
            End;
         if Uppercase(FName) = 'S_LAMBDA_V' then
            Begin
               FarProc3 := GetProcAddress(hDLL, 'S_lambda_v');
               if Assigned(FarProc3) then
                  erg := FarProc3(refr, Temp, XVar, res)
                 else
                  res := -999999;
               //erg := S_lambda_v(Refr, Temp, XVar, res);
            End;
         if Uppercase(FName) = 'S_VS' then
            Begin
               FarProc3 := GetProcAddress(hDLL, 'S_vs');
               if Assigned(FarProc3) then
                  erg := FarProc3(refr, Temp, XVar, res)
                 else
                  res := -999999;
               //erg := S_vs(Refr, Temp, XVar, res);
            End;
         if Uppercase(FName) = 'S_T_D' then
            Begin
               FarProc2 := GetProcAddress(hDLL, 'S_t_d');
               if Assigned(FarProc2) then
                  erg := FarProc2(refr, XVar, res)
                 else
                  res := -999999;
               //erg := S_t_d(Refr, XVar, res);
            End;
         if Uppercase(Fname) = 'S_CV' then
            Begin
               FarProc3 := GetProcAddress(hDLL, 'S_cv');
               if Assigned(FarProc3) then
                  erg := FarProc3(refr, Temp, XVar, res)
                 else
                  res := -999999;
               //erg := S_cv(Refr, Temp, XVar, res);
            End;
      End;
   if Erg then
      Adw := 'erg True'
     else
      Adw := 'erg False';

   AssignFile(f, Logfile);
   if FileExists(Logfile) then
      Append(f)
     else
      Rewrite(f);
   WriteLn(f, FType + ' -> ' + FName + ' -> ' + FloatToStr(TKM) + ' -> ' + FloatToStr(XVar) + ' => ' + FloatToStr(res)+ ' / ' + Adw);
   CloseFile(f);
   erg := FreeLibrary(hDLL);
   Result := res;
End;

Aber leider: nach dem 62zigsten Aufruf der Funktion ist Ende. Genau der selbe Fehler wegen Schutzverletzung. Querprüfung mit dem alten VB6-Code zeigt, dass die an die DLL übergebenen Werte weitestgehend übereinstimmen. Im VB6 gibt es aber keinerlei Probleme.

Bereichsprüfung sehe ich soeben in einem anderen Post. Ist das eine Compileroption?