AV in DLL mit Datenbankanbindung über Zeos

[Cyberaxx]

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

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

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

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
---------------------------

[DeddyH]

Ich hab mich jetzt nicht durch den ganzen Source gewühlt, aber wo werden die Objekte in der DLL eigentlich instanziiert?

[Cyberaxx]

sry total vergesssen diese acu hzu posten.

Delphi-Quellcode:

{ **************************************************************************** }
{ * LOAD_SQL - Initialisieren der DLL                                        * }
{ **************************************************************************** }
function LOAD_SQL: Boolean; stdcall;
begin
  try
    ConnectionList := TObjectlist.Create(True);
    QueryList := TObjectlist.Create(True);
    DataSourceList := TObjectList.Create(True);

    Result := True;
  except
    Result := False;
  end;

  DBConnection := TZConnection.Create(DBConnection);
  DBConnection.HostName := 'localhost';
  DBConnection.User := 'root';
  DBConnection.Protocol := 'mysql';
  DBConnection.Database := 'kleiderverwaltung';
  DBConnection.Connect;
end;

{ **************************************************************************** }
{ * UNLOAD_SQL - Entlädt die DLL                                             * }
{ **************************************************************************** }
function UNLOAD_SQL: Boolean; stdcall;
  var
    I: Integer;
    AConnection: TZConnection;
begin
  try
    for I := 0 to ConnectionList.Count -1 do begin
      AConnection := (ConnectionList.Items[I]) as TZConnection;
      AConnection.Disconnect;
      FreeandNil(AConnection);
      ConnectionList.Delete(I);
      end;

    ConnectionList.Clear;
    QueryList.Clear;
    DataSourceList.Clear;
    if (ConnectionList.Count <> 0) or (QueryList.Count <> 0) or (DataSourceList.Count <> 0) then begin
      Result := False;
      Exit;
      end;

    ConnectionList.Free;
    QueryList.Free;
    DataSourceList.Free;

    Result := True;
  except
    Result := False;
  end;
end;

{ **************************************************************************** }
{ * CONNECTION_ADD - Erstellt eine neue Verbindung                           * }
{ **************************************************************************** }
function CONNECTION_ADD(Protocol: PChar; Host: PChar; Port: Integer; User: PChar; Password: PChar; Database: PChar): Integer; stdcall;
  var
    AConnection: TZConnection;
    ConnectionIndex: Integer;
begin
  AConnection := TZConnection.Create(nil);

  if Protocol = 'mysql' then begin
    AConnection.Protocol := 'mysql';

    AConnection.HostName := Host;
    AConnection.Port := Port;
    AConnection.User := User;
    AConnection.Password := Password;
    AConnection.Database := Database;
    AConnection.Catalog := DataBase;
    end;

  if Protocol = 'sqlite' then begin
    AConnection.Protocol := 'sqlite-3';

    AConnection.HostName := Host;
    AConnection.Port := Port;
    AConnection.User := User;
    AConnection.Password := Password;
    AConnection.Database := Database;
    AConnection.Catalog := DataBase;
    end;

  if Protocol = 'mssql' then begin
    AConnection.Protocol := 'ado';

    AConnection.HostName := Host;
    AConnection.Port := Port;
    AConnection.User := User;
    AConnection.Password := Password;
    AConnection.Database := Database;
    AConnection.Catalog := DataBase;
    end;

  if Protocol = 'mdb' then begin
    AConnection.Protocol := 'ado';

    AConnection.HostName := Host;
    AConnection.Port := Port;
    AConnection.User := User;
    AConnection.Password := Password;
    AConnection.Database := Database;
    AConnection.Catalog := DataBase;
    end;

  try
    AConnection.Connect;
    AConnection.Disconnect;

    ConnectionList.Add(AConnection);
    ConnectionIndex := ConnectionList.IndexOf(AConnection);

    AConnection.Name := Format('connection_%d', [ConnectionIndex]);
    AConnection.Tag := ConnectionIndex;

    Result := ConnectionIndex;
  except
    FreeandNil(AConnection);

    Result := -1;
  end;
end;

{ **************************************************************************** }
{ * QUERY_ADD - Fügt ein neues Query Hinzu                                   * }
{ **************************************************************************** }
function QUERY_ADD(Connection_ID: Integer): Integer; stdcall;
  var
    AConnection: TZConnection;
    AQuery: TZQuery;
    ADataSource: TDataSource;
    I: Integer;
    QueryIndex: Integer;
    //DataSourceIndex: Integer;
begin
  for I := 0 to ConnectionList.Count -1 do begin
    AConnection := (ConnectionList.Items[Connection_ID]) as TZConnection;
    if (AConnection.Tag = Connection_ID) and (AConnection.Name = Format('connection_%d', [Connection_ID])) then begin
      AQuery := TZQuery.Create(nil);
      AQuery.Connection := AConnection;
      ADataSource := TDataSource.Create(nil);
      ADataSource.DataSet := AQuery;

      QueryList.Add(AQuery);
      QueryIndex := QueryList.IndexOf(AQuery);
      AQuery.Name := Format('query_%d', [QueryIndex]);
      AQuery.Tag := QueryIndex;

      DataSourceList.Add(ADataSource);
      //DataSourceIndex := DataSourceList.IndexOf(ADataSource);
      ADataSource.Name := Format('datasource_%d', [QueryIndex]);
      ADataSource.Tag := QueryIndex;

      Result := QueryIndex;
      Exit;
      end;

    end;

  Result := -1;
end;