TWideStriblist kann nicht zu TStringlist zugewiesen werden

[DGL-luke]

Nimm Elvis' Ansatz oder meinen; zu meinem kann ich jetzt nur sagen: warum deklarierst du den parameter als "var"? das wird ja nirgends neu zugewiesen.

[Smiley]

Über den Typ ISharedStringList habe ich jetzt den Beitrag von Elvis gefunden in dem das Problem näher erläutert wird.
Wenn ich das richtig verstanden habe, dann muss ich die Typendeklaration und das Interface Programm in meine DLL mit einbauen und auch in das Aufrufende Programm.
Ansonsten sind die Begriffe "ISharedStringList" und "TSharedStringListWrapper.Wrap" ja gar nicht bekannt.

[DGL-luke]

Du musst das Interface in beiden Modulen deklarieren.
Die Implementation nur im Hauptprogramm.

So als Codebrocken ist es ganz nett von Elvis, aber schlecht zu verstehen wenn man das Konzept von Interfaces nicht so gut kennt.

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

[xaromz]

Hallo,

Zitat:

Zitat von Smiley

Was mache ich hier falsch ?

das hier:

Delphi-Quellcode:

Procedure DBListTables(const Liste: ISharedStringlist); stdcall;
Var
  i                : Integer;
  xListe:TStringList;

Begin
 xListe := TStringList(Liste); <-------------
 xListe.Clear;

Du bekommst keine TStringList, sondern ein ISharedStringList. Damit musst Du arbeiten. Die beiden (TStringList und ISharedStringList) sind komplett unterschiedlich, und haben im Aufbau keinerlei Gemeinsamkeit.
Nutze einfach die von ISharedStringList zur Verfügung gestellten Methoden.

Gruß
xaromz

[Smiley]

Du meinst ich soll mit einer der TSharedStringListWrapper.xxx die Konvertierung in meine StringList machen.
Da ich aber nicht verstehe, welche Routine welche Umwandlung macht, weiß ich nicht wie die Übergabe aussehen soll.
Muss ich das mit einer Schleife machen oder kann ich eine der Routinen benutzen um das in einem zu übergeben ?

Moment mal, da sehe ich gerade was.
Die Zeile ist ja gar nicht gewollt, das war noch aus den anderen Versuchen.
Das sollte heißen
xListe:=TStringList.Create;

Das mit der Übergabe habe ich doch dann am Ende der Routine gemacht.

[Smiley]

So funktioniert es:

Delphi-Quellcode:

//******************************************************************************
//***************** Vorhandene Tabellen in der DB anzeigen *********************
//******************************************************************************
Procedure DBListTables(Const Liste: ISharedStringList); Stdcall;
Var
  i                           : Integer;
  xListe                      : TStringList;

Begin
  xListe := TStringList.Create;
  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;

Danke für Eure Hilfe.
Ihr seid große Klasse!

[DeddyH]

Zitat:

Delphi-Quellcode:

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

Bist Du sicher, dass das so funktioniert? Ich würde eher eine absteigende for-Schleife verwenden.

Delphi-Quellcode:

for i := xliste.Count - 1 downto 0 do
  Begin
    If (Pos('Cellinfo', xListe[i])) > 0 Then
      xListe.Delete(i);
  End;

[Smiley]

Ja, meine Routine funktioniert auch, ich habe sie step für step durchgeprüft und zugesehen was der zähler und die Liste dabei macht.
Dazu muss man wissen, dass in meiner Liste pro Tabbellenname zwei Tabellen vorhanden sind.
Eine mit dem Anhängsel Cellinfo und eine mit dem Anhängsel Data.
z.B. Test1Cellinfo und Test1Data.
Nach außen soll aber nur der Name Test1 erscheinen, daher der ganze Aufwand.

Deine Routine ist aber kürzer und schöner, daher werde ich sie verwenden.
Ich hatte es anfangs auch mit For-Next probiert, aber ohne Downto und das ging natürlich nicht, daher kam ich auf diese anderen Version mit Repeat.