Thema: Delphi AV in DLL mit Datenbankanbindung über Zeos

Einzelnen Beitrag anzeigen

Benutzerbild von Cyberaxx
Cyberaxx

Registriert seit: 15. Jul 2005
311 Beiträge
 
Delphi XE5 Professional
 
#1

AV in DLL mit Datenbankanbindung über Zeos

  Alt 6. Okt 2008, 04:14
Hallo DP'ler

Habe eine DLL geschrieben über die ich Datenbankzugriffe abwickeln möchte.
Weitestgehend funktioniert sie auch, es sei denn ich greif auf Text- oder Varchar Felder zu, dann knallt es beim beenden
der Hauptanwendung. Wenn ich dies mit dem Debugger überprüfe, Entfernt er auch alle ZQueries, Datasources und ZConnections.
Die AV taucht erst beim eigentlichen beenden der Applikation auf, dort springt er wie wild noch in den Sources von Zeos rum
und endet dann schliesslich mit dr AV. Ich habe aber zu dem Zeitpunklt bereits keine Komponenten mehr die auf die Datenbank
zugreifen könnten. die sind schön alle mit entladen der DLL freigegeben worden?!


Die DLL
zusammenfalten · markieren
Delphi-Quellcode:
library SQLDLL;

uses
  SysUtils,
  Forms,
  ZConnection,
  DB,
  ZDataset,
  Contnrs;

type
  TConnection_Info = packed record
    Name: PChar;
    ID: Integer;
    Database: PChar;
    Connected: Boolean;
  end;

type
  TQuery_Info = packed Record
    Name: PChar;
    ID: Integer;
    Connection_ID: Integer;
    Connection_Name: PChar;
    Database: PChar;
  end;

const
  PROTOCOL_MSSQL = 'Provider=SQLOLEDB.1;'
                  + 'Persist Security Info=True;'
                  + 'Initial Catalog=%s;'
                  + 'Data Source=%s';

  PROTOCOL_MDB = 'Provider=Microsoft.Jet.OLEDB.4.0;'
                  + 'Data Source=%s;'
                  + 'Persist Security Info=False';
var
  ConnectionList: TObjectlist = nil;
  QueryList: TObjectlist = nil;
  DataSourceList: TObjectList = nil;
  DBConnection: TZConnection;

{$R *.res}

{ **************************************************************************** }
{ * Get_QueryList_Index - Gibt den Index des Queries und des DataSources an  * }
{ **************************************************************************** }
function Get_QueryList_Index(ID: Integer; var Query_Index: Integer; var DataSource_Index: Integer): Boolean;
  var
    AQuery: TZQuery;
    ADataSource: TDataSource;
    I: Integer;
begin
  Query_Index := -1;
  DataSource_Index := -1;

  for I := 0 to QueryList.Count -1 do begin
    AQuery := (QueryList.Items[I]) as TZQuery;
    if (AQuery.Tag = ID) and (AQuery.Name = Format('query_%d', [ID])) then begin
      Query_Index := I;
      Break;
      end;
    end;

  for I := 0 to DataSourceList.Count -1 do begin
    ADataSource := (DataSourceList.Items[I]) as TDataSource;
    if (ADataSource.Tag = ID) and (ADataSource.Name = Format('datasource_%d', [ID])) then begin
      DataSource_Index := I;
      Break;
      end;
    end;

  if (Query_Index <> -1) and (DataSource_Index <> -1) then
    Result := True
      else Result := False;
end;

{ ... }

{ **************************************************************************** }
{ * SQL_RESULT_FIELD -  * }
{ **************************************************************************** }
function SQL_RESULT_FIELD(Query_ID: Integer; Fieldname: PChar; var ResVal: Variant): Boolean; stdcall;
  var
    QueryIndex: Integer;
    DataSourceIndex: Integer;
    ADataSource: TDataSource;
begin
  QueryIndex := -1;
  DataSourceIndex := -1;

  Result := False;

  if Get_QueryList_Index(Query_ID, QueryIndex, DataSourceIndex) then begin
    ADataSource := (DataSourceList.Items[DataSourceIndex]) as TDataSource;

    try
      ResVal := ADataSource.DataSet.FieldByName( Fieldname ).AsVariant;
      Result := True;
    except
      Result := False;
    end;

    end;
end;

{ **************************************************************************** }
{ * exports - Prozeduren und Funktionen die nach aussen sichtbar sind        * }
{ **************************************************************************** }
exports
  SQL_ERROR_TEXT, SQL_ERROR_CODE,
  LOAD_SQL, UNLOAD_SQL, GET_PROTOCOL_COUNT, GET_PROTOCOL,
  GET_CONNECTION_COUNT, GET_QUERY_COUNT, GET_CONNECTION_INFO, GET_QUERY_INFO,
  CONNECTION_ADD, CONNECTION_RELEASE, CONNECTION_CONNECT, CONNECTION_DISCONNECT, CONNECTION_CONNECTED,
  QUERY_ADD, QUERY_RELEASE, QUERY_CONNECTED, QUERY_ACTIVE, QUERY_EXEC,
  SQL_QUERY_CLEAR, SQL_QUERY_ADD, SQL_QUERY_TEXT,
  SQL_RESULT_COUNT, SQL_RESULT_FIRST, SQL_RESULT_NEXT, SQL_RESULT_FIELD;

begin
end.

Unit die auf die DLL zugreift
zusammenfalten · markieren
Delphi-Quellcode:
unit SQLDLL_def;

interface

uses
  Windows, Classes;

type
  TConnection_Info = packed record
    Name: PChar;
    ID: Integer;
    Database: PChar;
    Connected: Boolean;
  end;

type
  TQuery_Info = packed Record
    Name: PChar;
    ID: Integer;
    Connection_ID: Integer;
    Connection_Name: PChar;
    Database: PChar;
  end;

const
  DLL_FILE = 'SQLDLL.DLL';

  DLL_INCOMPATIBLE = 0;
  DLL_UNDEFINED = 1;
  DLL_MISSING = 2;
  DLL_READY = 3;
  DLL_ERROR = 4;

var
  SQL_ERROR_TEXT: function(ErrorCode: Integer): PChar;
  SQL_ERROR_CODE: function() : Integer;

  LOAD_SQL: function(): Boolean; stdcall;
  UNLOAD_SQL: function(): Boolean; stdcall;

  GET_CONNECTION_COUNT: function(): Integer; stdcall;
  GET_QUERY_COUNT: function(): Integer; stdcall;
  GET_CONNECTION_INFO: function(Connection_ID: Integer): TConnection_Info; stdcall;
  GET_QUERY_INFO: function(Query_ID: Integer): TQuery_Info; stdcall;

  CONNECTION_ADD: function(Protocol: PChar; Host: PChar; Port: Integer; User: PChar; Password: PChar;
                              Database: PChar): Integer; stdcall;
  CONNECTION_RELEASE: function(Connection_ID: Integer): Boolean; stdcall;
  CONNECTION_CONNECT: function(Connection_ID: Integer): Boolean; stdcall;
  CONNECTION_DISCONNECT: function(Connection_ID: Integer): Boolean; stdcall;
  CONNECTION_CONNECTED: function(Connection_ID: Integer): Boolean; stdcall;

  QUERY_ADD: function(Connection_ID: Integer): Integer; stdcall;
  QUERY_RELEASE: function(Query_ID: Integer): Boolean; stdcall;
  QUERY_CONNECTED: function(Query_ID: Integer): Boolean; stdcall;
  QUERY_ACTIVE: function(Query_ID: Integer): Boolean; stdcall;
  QUERY_EXEC: function(Query_ID: Integer): Boolean; stdcall;

  SQL_QUERY_CLEAR: function(Query_ID: Integer): Boolean; stdcall;
  SQL_QUERY_ADD: function(Query_ID: Integer; S: PChar): Boolean; stdcall;
  SQL_QUERY_TEXT: function(Query_ID: Integer; S: PChar): Boolean; stdcall;

  SQL_RESULT_COUNT: function(Query_ID: Integer): Integer; stdcall;
  SQL_RESULT_FIRST: function(Query_ID: Integer): Boolean; stdcall;
  SQL_RESULT_NEXT: function(Query_ID: Integer): Boolean; stdcall;
  SQL_RESULT_FIELD: function(Query_ID: Integer; Fieldname: PChar; var ResVal: Variant): Boolean; stdcall;

var
  LibSQL_Handle: Cardinal;
  DLL_Status: Byte = DLL_UNDEFINED;

function LibSQL_load: Byte;
function LibSQL_Unload: Boolean;
procedure LibSQL_Protocols(List: TStrings);

implementation

function LibSQL_Unload: Boolean;
begin
  try
    if LibSQL_Handle <> 0 then begin
      UNLOAD_SQL;
      FreeLibrary(LibSQL_Handle);
      end;

    LibSQL_Handle := 0;
    DLL_Status := DLL_UNDEFINED;

    Result := True;
  except
    DLL_Status := DLL_ERROR;

    Result := False;
  end;
end;

function LibSQL_load: Byte;

  procedure Assign_Proc(var proc: FARPROC; Name: pChar);
  begin
    Proc := GetProcAddress(LibSQL_Handle, Name);
    if Proc = nil then
      DLL_Status := DLL_INCOMPATIBLE;
  end;

begin
  Result := DLL_ERROR;

  if LibSQL_Unload then begin

    LibSQL_Handle := LoadLibrary(DLL_FILE);
    if LibSQL_Handle = 0 then
      DLL_Status := DLL_MISSING
        else begin
        DLL_Status := DLL_READY;

        Assign_Proc(@SQL_ERROR_TEXT, 'SQL_ERROR_TEXT');
        Assign_Proc(@SQL_ERROR_CODE, 'SQL_ERROR_CODE');

        Assign_Proc(@LOAD_SQL, 'LOAD_SQL');
        Assign_Proc(@UNLOAD_SQL, 'UNLOAD_SQL');

        Assign_Proc(@GET_CONNECTION_COUNT, 'GET_CONNECTION_COUNT');
        Assign_Proc(@GET_QUERY_COUNT, 'GET_QUERY_COUNT');
        Assign_Proc(@GET_CONNECTION_INFO, 'GET_CONNECTION_INFO');
        Assign_Proc(@GET_QUERY_INFO, 'GET_QUERY_INFO');

        Assign_Proc(@CONNECTION_ADD, 'CONNECTION_ADD');
        Assign_Proc(@CONNECTION_RELEASE, 'CONNECTION_RELEASE');
        Assign_Proc(@CONNECTION_CONNECT, 'CONNECTION_CONNECT');
        Assign_Proc(@CONNECTION_DISCONNECT, 'CONNECTION_DISCONNECT');
        Assign_Proc(@CONNECTION_CONNECTED, 'CONNECTION_CONNECTED');

        Assign_Proc(@QUERY_ADD, 'QUERY_ADD');
        Assign_Proc(@QUERY_RELEASE, 'QUERY_RELEASE');
        Assign_Proc(@QUERY_CONNECTED, 'QUERY_CONNECTED');
        Assign_Proc(@QUERY_ACTIVE, 'QUERY_ACTIVE');
        Assign_Proc(@QUERY_EXEC, 'QUERY_EXEC');

        Assign_Proc(@SQL_QUERY_CLEAR, 'SQL_QUERY_CLEAR');
        Assign_Proc(@SQL_QUERY_ADD, 'SQL_QUERY_ADD');
        Assign_Proc(@SQL_QUERY_TEXT, 'SQL_QUERY_TEXT');

        Assign_Proc(@SQL_RESULT_COUNT, 'SQL_RESULT_COUNT');
        Assign_Proc(@SQL_RESULT_FIRST, 'SQL_RESULT_FIRST');
        Assign_Proc(@SQL_RESULT_NEXT, 'SQL_RESULT_NEXT');
        Assign_Proc(@SQL_RESULT_FIELD, 'SQL_RESULT_FIELD');
        end;

    end
      else DLL_Status := DLL_ERROR;

    try
      if LOAD_SQL then
        Result := DLL_Status;
    except
      DLL_Status := DLL_ERROR;
      Result := DLL_Status;
    end;


end;

procedure LibSQL_Protocols(List: TStrings);
  type
    TGetProtCount = function(): Integer; stdcall;
    TGetProt = function(ProtocolNum: Integer): PChar; stdcall;

  var
    GetProtCount: TGetProtCount;
    GetProt: TGetProt;
    I: Integer;
begin
  List.Clear;

  if LibSQL_Handle <> 0 then begin
    @GetProtCount := GetProcAddress(LibSQL_Handle, 'GET_PROTOCOL_COUNT');
    @GetProt := GetProcAddress(LibSQL_Handle, 'GET_PROTOCOL');

    if (@GetProtCount <> nil) and (@GetProt <> nil) then begin

      for I := 0 to GetProtCount -1 do begin
        List.Add( GetProt(I) );
        end;

      end;
    end;
end;

end.

Die Prozedur zum auslesen der Daten
zusammenfalten · markieren
Delphi-Quellcode:
procedure TForm1.Button7Click(Sender: TObject);
  var
    Recordcount: Integer;
    I: Integer;
    AVar: Variant;
begin
  if SQLDLL_Def.SQL_QUERY_CLEAR( StrtoInt(Self.JvEdit8.Text) ) then begin
    if SQLDLL_Def.SQL_QUERY_TEXT( StrtoInt(Self.JvEdit8.Text), PChar(Self.JvMemo1.Text) ) then begin
      if SQLDLL_Def.QUERY_ACTIVE( StrtoInt(Self.JvEdit8.Text) ) then begin

        Recordcount := SQLDLL_Def.SQL_RESULT_COUNT( StrtoInt(Self.JvEdit8.Text) );
        Self.JvEdit9.Text := InttoStr( Recordcount );

// Auflistung des Ergebnises

        SQLDLL_Def.SQL_RESULT_FIRST( StrtoInt(Self.JvEdit8.Text) );
//
// Self.AdvStringGrid1.RowCount := Recordcount +1;
// Self.AdvStringGrid1.ClearRows( 1, Self.AdvStringGrid1.RowCount -1 );
//
        for I := 0 to Recordcount -1 do begin
          SQLDLL_Def.SQL_RESULT_FIELD( StrtoInt(Self.JvEdit8.Text), 'pk_kleiderverwaltung_system', AVar );
// Self.AdvStringGrid1.Cells[1, I +1] := AVar;
//
// SQLDLL_Def.SQL_RESULT_FIELD( StrtoInt(Self.JvEdit8.Text), 'funktion', AVar );
// Self.AdvStringGrid1.Cells[2, I +1] := AVar;
//
// SQLDLL_Def.SQL_RESULT_FIELD( StrtoInt(Self.JvEdit8.Text), 'bezeichnung', AVar );
// Self.AdvStringGrid1.Cells[3, I +1] := AVar;
//
          SQLDLL_Def.SQL_RESULT_FIELD( StrtoInt(Self.JvEdit8.Text), 'beschreibung', AVar );
// Self.AdvStringGrid1.Cells[4, I +1] := AVar;
//
          SQLDLL_Def.SQL_RESULT_NEXT( StrtoInt(Self.JvEdit8.Text) );
          end;

// Auflistung des Ergebnises

        end
          else ShowMessage('Fehler beim ausführen des Querys');
      end
        else ShowMessage('Konnte Query nicht füllen');
    end
      else ShowMessage('Konnte nicht löschen');
end;

Getestet ist die DLL bisher nur mit MySQL
Die AV's beim beenden der App
Zitat:
---------------------------
Application Error
---------------------------
Exception EAccessViolation in module Project1.exe at 00001EDF.

Access violation at address 00401EDF in module 'Project1.exe'. Read of address 00F6F7F0.


---------------------------
OK
---------------------------
Zitat:
---------------------------
Debugger Exception Notification
---------------------------
Project Project1.exe raised exception class EAccessViolation with message 'Access violation at address 00401EDF in module 'Project1.exe'. Read of address 00F6F7F0'. Process stopped. Use Step or Run to continue.
---------------------------
OK Help
---------------------------
Angehängte Dateien
Dateityp: zip sqldll_113.zip (23,8 KB, 2x aufgerufen)
Daniel
Das Aufwachen aus einem boesen Traum muss einen nicht erleichtern. Es kann einen auch erst richtig gewahr werden lassen, was man Furchtbares getraeumt hat, vielleicht sogar welcher furchtbaren Wahrheit man im Traum begegnet ist!
  Mit Zitat antworten Zitat