![]() |
AV in DLL mit Datenbankanbindung über Zeos
Liste der Anhänge anzeigen (Anzahl: 1)
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:
Zitat:
|
Re: AV in DLL mit Datenbankanbindung über Zeos
Ich hab mich jetzt nicht durch den ganzen Source gewühlt, aber wo werden die Objekte in der DLL eigentlich instanziiert?
|
Re: AV in DLL mit Datenbankanbindung über Zeos
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; |
Alle Zeitangaben in WEZ +1. Es ist jetzt 19:58 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz