TWideStriblist kann nicht zu TStringlist zugewiesen werden

[Smiley]

Nachdem ich versucht habe alles zu verstehen, wie dieses Interface arbeitet und wie es eingebunden werden muss, habe ich folgendes

gemacht.

1. Den Typ ISharedStringList in die DLL eingebaut bei der Typen deklaration.

Delphi-Quellcode:

Unit uCellDB;

Interface
Uses
  FastMM4,
  SysUtils,
  Classes,
  ComObj,
  ADODB,
  DB,
  Variants,
  Windows,
  StdCtrls,
  Dialogs;


// ********************** ISharedStringlist Interface ***************************
type
  ISharedStringList = interface
  ['{3F5E3362-121A-4EC4-B399-9F8CD321FC34}']
    procedure Clear; stdcall;
    function GetCount : Integer; stdcall;

    function Add(const aValue : String) : Integer; stdcall;
    procedure Delete(aIndex : Integer); stdcall;
    procedure Exchange(aIndex1, aIndex2 : Integer); stdcall;
    function IndexOf(const aValue : string) : Integer; stdcall;
    procedure Insert(aIndex : Integer; const aValue : string); stdcall;

    function  GetItem(aIndex : Integer) : String; stdcall;
    procedure SetItem(aIndex : Integer; const aValue : String); stdcall;

    property Item[aIndex : Integer] : String
      read  GetItem
      write SetItem; default;
  end;

// ********************** TCEll Objekt *****************************************
Type
  TDBCell = Record
    Name: String; // name der Zelle, wird auromatisch aus col und row generiert (A5 bei Zelle(1,5))
    Row: Integer; // Zeile der Zelle
    Col: Integer; // Spalte der Zelel
    FontName: String; // Schriftart
    FontSize: Byte; // Schriftgröße
    FontColor: Word; // Schriftfarbe
    FontStyle: Byte; //normal, Fett, italic, Underline, Strikeout (0,1,2,4,8)
    RecHight: Byte; // Höhe des Zellenrechtecks
    RecWidth: Byte; // Breite des Zellenrechtecks
    RecColor: Word; // Hintergrundfarbe des Zellenrechtecks
    RecLine: Byte; // Umrandungsstriche der Zelle 0=keine, 1=unten,2=links,4=oben,8=rechts,15=alle
    // Kombinationen einfach addieren z.B. Links und rechts ergibt 2+8=10)
    Formula: String; // Formel
    FormulaActive: Boolean; // Wenn True dann ist eine Formel in der Zelle
    Pre: String; //Vorangestellter String vor Data
    Post: String; //Stringanhängsel nach Data
    Format: String; //Datenformat z.B. ###.##
    Datatype: Byte; // Datentyp des Wertes (0=String,1=Integer;2=Float,3=Date)
    Data: String; // Datenwert, abhängig von DataType wird über den Datentyp entschieden
  End;
  //******************************************************************************

Function InitDB: Boolean;
Function DestroyDB: Boolean;
Function CreateDB(DBName: String; DelIfExists: Boolean = False): String;
Function CreateTable(DBName, Tabelle: String): String;
Function OpenDB(DBName, TableName: String): String;
Function OpenTable(TableName: String): String;
Function ReadCell(Var DBCell: TDBCell): String;
Function ReadNextData(var Data: String; var Datatype: Integer): Boolean;
Function ReadNextInfo(var DBCell: TDBCell): Boolean;
Function WriteCell(Var DBCell: TDBCell; WriteInfo: Boolean): String;
Function SelectRowRange(Tabelle: String; RowVon, RowBis: Integer): Boolean;
Function SelectColRange(Tabelle: String; ColVon, ColBis: Integer): Boolean;
Function SelectRowColRange(Tabelle: String; RowVon, RowBis, ColVon, ColBis: Integer): Boolean;
Function SelectNext(DBCell: TDBCell): Boolean;
Function FieldCount: Integer;

Procedure DBListTables(const Liste: ISharedStringList); stdcall; //<------------------------------
Procedure DBCompress(DBName: String);
Procedure DeleteTable(Tabelle:String);

Function SelectDB(DBName: String): String;
Function SelectInfo(Tabelle: String; Row, Col: Integer): Boolean;
Function SelectData(Tabelle: String; Row, Col: Integer): Boolean;

Procedure ReadCellInfo(Var DBCell: TDBCell);
Procedure ReadData(Var DBCell: TDBCell);
Procedure WriteCellInfo(Var DBCell: TDBCell);
Procedure WriteData(Var DBCell: TDBCell);
.
.
.

2. Die Procedure in der DLL angepasst

Delphi-Quellcode:

//******************************************************************************
//***************** Vorhandene Tabellen in der DB anzeigen *********************
//******************************************************************************
Procedure DBListTables(const Liste: ISharedStringlist); stdcall;
Var
  i                : Integer;
  xListe:TStringList;

Begin
 xListe := TStringList(Liste);
 xListe.Clear;
 Con1.GetTableNames(xListe, False);

  i := 0;
  Repeat
    Begin
      If (Pos('Cellinfo', xListe[i])) > 0 Then
        xListe.Delete(i);
      Inc(i);
    End;
  Until xListe.Count = i;

  i := 0;
  Repeat
    Begin
      xListe[i] := Copy(xListe[i], 1, Length(xListe[i]) - 4);
      Inc(i);
    End;
  Until xListe.Count = i;

  for i:= 0 to xListe.Count - 1 do
    Liste.Add(xListe.Strings[i]);

  xListe.Free;
End;

Das hat soweit funktioniert und lies sich compilieren

3. Dann habe ich die erzeugte DLL-Datei in mein TestProgramm Verzeichnis kopiert.

4. Einbinden der Typ ISharedStringList und TSharedStringListWrapper in das Testprogramm.
5. Einbinden der Wrapper Funktionen in das Testprogramm.

Delphi-Quellcode:

Unit uMainReadTest;

Interface

Uses
  FastMM4, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, uCellDB;

Type
  TForm1 = Class(TForm)
    btnStart: TButton;
    lblText: TLabel;
    lblDauer: TLabel;
    lblText1: TLabel;
    lblText1D: TLabel;
    lblFehlerText: TLabel;
    lblFehlerDaten: TLabel;
    btnDropTable: TButton;
    btnListTables: TButton;
    lstTables: TListBox;
    btnReadRowRange: TButton;
    btnReadColRange: TButton;
    btnListFields: TButton;
    btnCreateTable: TButton;
    Procedure btnCreateTableClick(Sender: TObject);
    Procedure btnDropTableClick(Sender: TObject);
    Procedure btnListFieldsClick(Sender: TObject);
    Procedure btnReadColRangeClick(Sender: TObject);
    Procedure btnReadRowRangeClick(Sender: TObject);
    Procedure btnListTablesClick(Sender: TObject);
    Procedure btnStartClick(Sender: TObject);
    Procedure FormShow(Sender: TObject);
    Procedure FormClose(Sender: TObject; Var Action: TCloseAction);
  Private
    { Private-Deklarationen }
  Public
    { Public-Deklarationen }
  End;

type
  ISharedStringList = interface
  ['{3F5E3362-121A-4EC4-B399-9F8CD321FC34}']
    procedure Clear; stdcall;
    function GetCount : Integer; stdcall;

    function Add(const aValue : String) : Integer; stdcall;
    procedure Delete(aIndex : Integer); stdcall;
    procedure Exchange(aIndex1, aIndex2 : Integer); stdcall;
    function IndexOf(const aValue : string) : Integer; stdcall;
    procedure Insert(aIndex : Integer; const aValue : string); stdcall;

    function  GetItem(aIndex : Integer) : String; stdcall;
    procedure SetItem(aIndex : Integer; const aValue : String); stdcall;

    property Item[aIndex : Integer] : String
      read  GetItem
      write SetItem; default;
  end;

type
  TSharedStringListWrapper = class(TInterfacedObject, ISharedStringList)
  private
    fInnerList: TStrings;
  protected
    function  GetCount: Integer; stdcall;

    procedure Clear; stdcall;

    function Add(const aValue: String): Integer; stdcall;
    procedure Delete(aIndex : Integer); stdcall;
    procedure Exchange(aIndex1, aIndex2 : Integer); stdcall;
    function IndexOf(const aValue : String) : Integer; stdcall;
    procedure Insert(aIndex : Integer; const aValue : String); stdcall;

    function  GetItem(aIndex: Integer): String; stdcall;
    procedure SetItem(aIndex: Integer; const aValue: String); stdcall;
  public
    property InnerList : TStrings read fInnerList;

    constructor Create(aInnerList : TStrings);

    class function Wrap(aInnerList : TStrings) : ISharedStringList;
  end; 
  
Var
  Form1                       : TForm1;
  DBError                     : String;
  ProgPath                    : String;
  DBCell                      : TDBCell;
  Cache                       : Array[1..50, 1..10] Of TDBCell;

Function InitDB: Boolean;
Function DestroyDB: Boolean;
Function CreateDB(DBName: String; DelIfExists: Boolean = False): String;
Function CreateTable(DBName, Tabelle: String): String;
Function OpenDB(DBName, TableName: String): String;
Function OpenTable(TableName: String): String;
Function ReadCell(Var DBCell: TDBCell): String;
Function WriteCell(Var DBCell: TDBCell; WriteInfo: Boolean): String;

Function SelectDB(DBName: String): String;
Function SelectData(Tabelle: String; Row, Col: Integer): Boolean;
Procedure ReadCellInfo(Var DBCell: TDBCell);
Procedure WriteCellInfo(Var DBCell: TDBCell);
Procedure DBCompress(DBName: String);

Procedure DeleteTable(Tabelle: String);
Procedure DBListTables(Const Liste: ISharedStringList); stdcall;
//Procedure DBListTables(var Liste:TObject);

Function SelectRowRange(Tabelle: String; RowVon, RowBis: Integer): Boolean;
Function SelectColRange(Tabelle: String; ColVon, ColBis: Integer): Boolean;
Function ReadNextData(Var Data: String; Var Datatype: Integer): Boolean;
Function ReadNextInfo(Var DBCell: TDBCell): Boolean;
Function FieldCount: Integer;

Implementation

{$R *.dfm}

Const
  DllPath                     = 'CellDB.dll';

Function InitDB: Boolean;
  External DllPath;
Function DestroyDB: Boolean;
  External DllPath;
Function CreateDB(DBName: String; DelIfExists: Boolean = False): String;
  External DllPath;
Function CreateTable(DBName, Tabelle: String): String;
  External DllPath;
Function OpenDB(DBName, TableName: String): String;
  External DllPath;
Function OpenTable(TableName: String): String;
  External DllPath;
Function ReadCell(Var DBCell: TDBCell): String;
  External DllPath;
Function WriteCell(Var DBCell: TDBCell; WriteInfo: Boolean): String;
  External DllPath;
Function SelectDB(DBName: String): String;
  External DllPath;
Function SelectData(Tabelle: String; Row, Col: Integer): Boolean;
  External DllPath;
Procedure ReadCellInfo(Var DBCell: TDBCell);
  External DllPath;
Procedure WriteCellInfo(Var DBCell: TDBCell);
  External DllPath;
Procedure DBCompress(DBName: String);
  External DllPath;
Function SelectRowRange(Tabelle: String; RowVon, RowBis: Integer): Boolean;
  External DllPath;
Function SelectColRange(Tabelle: String; ColVon, ColBis: Integer): Boolean;
  External DllPath;
Procedure DBListTables(Const Liste: ISharedStringlist); stdcall;
//Procedure DBListTables(var Liste:TObject);
External DllPath;
Procedure DeleteTable(Tabelle: String);
  External DllPath;
Function ReadNextData(Var Data: String; Var Datatype: Integer): Boolean;
  External DllPath;
Function ReadNextInfo(Var DBCell: TDBCell): Boolean;
  External DllPath;
Function FieldCount: Integer;
  External DllPath;

{ TSharedStringListWrapper }

function TSharedStringListWrapper.Add(const aValue : String) : Integer;
begin
  result := InnerList.Add(aValue);
end;

procedure TSharedStringListWrapper.Clear;
begin
  InnerList.Clear();
end;

constructor TSharedStringListWrapper.Create(aInnerList : TStrings);
begin
  inherited Create();
  fInnerList := aInnerList;
end;

procedure TSharedStringListWrapper.Delete(aIndex : Integer);
begin
  InnerList.Delete(aIndex);
end;

procedure TSharedStringListWrapper.Exchange(aIndex1, aIndex2 : Integer);
begin
  InnerList.Exchange(aIndex1, aIndex2);
end;

function TSharedStringListWrapper.GetCount : Integer;
begin
  result := InnerList.Count;
end;

function TSharedStringListWrapper.GetItem(aIndex : Integer) : String;
begin
  result := InnerList[aIndex];
end;

function TSharedStringListWrapper.IndexOf(const aValue : String) : Integer;
begin
  result := InnerList.IndexOf(aValue);
end;

procedure TSharedStringListWrapper.Insert(aIndex : Integer;
  const aValue : String);
begin
  InnerList.Insert(aIndex, aValue);
end;

procedure TSharedStringListWrapper.SetItem(aIndex : Integer;
  const aValue : String);
begin
  InnerList[aIndex] := aValue;
end;

class function TSharedStringListWrapper.Wrap(aInnerList : TStrings) : ISharedStringList;
begin
  result := Create(aInnerList);
end;

6. Den Aufruf im Testprogramm angepasst.

Delphi-Quellcode:

//******************************************************************************
//*********************** Tabellen in DB auflisten *****************************
//******************************************************************************
Procedure TForm1.btnListTablesClick(Sender: TObject);

procedure FillTableNames(const aTableNames : TStrings);
begin
  DBListTables(TSharedStringListWrapper.Wrap(aTableNames));
end;

Begin
  FillTableNames(lstTables.Items); // Listbox füllen
End;

Sobald ich nun den Button btnListTables ausführe, kommt die angehängte Fehlermeldung, sobald die DLL angesprochen wird.

Was mache ich hier falsch ?