Probleme mit SHGetKnownFolderPath

[Andidreas]

Hallo zusammen,

ich habe mir vor einiger Zeit eine Funktion gebastelt über die ich unter Windows 7 die Standard Pfade von Windows auslesen kann:

Delphi-Quellcode:

  //Constants
  const
    FOLDERID_Desktop:       KNOWNFOLDERID = '{B4BFCC3A-DB2C-424C-B029-7FE99A87C641}';     //CSIDL_DESKTOPDIRECTORY
    FOLDERID_LocalAppData:  KNOWNFOLDERID = '{F1B32785-6FBA-4FCF-9D55-7B8E7F157091}';     //CSIDL_LOCAL_APPDATA
    FOLDERID_ProgramData:   KNOWNFOLDERID = '{62AB5D82-FDC1-4DC3-A9DD-070D1D495D97}';     //CSIDL_COMMON_APPDATA
    FOLDERID_PuplicDesktop: KNOWNFOLDERID = '{C4AA340D-F20F-4863-AFEF-F87EF2E6BA25}';     //CSIDL_COMMON_DESKTOPDIRECTORY
    FOLDERID_Fonts:         KNOWNFOLDERID = '{FD228CB7-AE11-4AE3-864C-16F3910AB8FE}';     //CSIDL_FONTS


//******************************************************************************
// fnGetKnownFolderPath --> Get Constant Special Item ID Path from Windows     *
//                                                                             *
//                      Only for WIN 7                                         *
//                      WIN XP has to use fnGetShellFolder in this Unit        *
//                                                                             *
// Parameter --> iCSIDL (Constant Special Item ID)                             *
// Return    --> Boolean True/False                                            *
//******************************************************************************

function fnGetKnownFolderPath(sKnownFolderID : String) : String;

var
sPath : LPWSTR;

begin

  //Set Result
  Result := EmptyStr;

  {$IFDEF VER220}
  If sKnownFolderID = 'FOLDERID_Desktop'        Then SHGetKnownFolderPath(FOLDERID_Desktop,0, 0, sPath);
  If sKnownFolderID = 'FOLDERID_LocalAppData'   Then SHGetKnownFolderPath(FOLDERID_LocalAppData,0, 0, sPath);
  If sKnownFolderID = 'FOLDERID_ProgramData'    Then SHGetKnownFolderPath(FOLDERID_ProgramData,0, 0, sPath);
  If sKnownFolderID = 'FOLDERID_PuplicDesktop'  Then SHGetKnownFolderPath(FOLDERID_PuplicDesktop,0, 0, sPath);
  If sKnownFolderID = 'FOLDERID_Fonts'          Then SHGetKnownFolderPath(FOLDERID_Fonts,0, 0, sPath);
  {$ENDIF}

  //Set Result
  Result := sPath;

end;

Nun hab ich mit der Funktion das folgende Problem...

Wir haben ein Hauptprogramm was das UI darstellt...
Über das UI kann der User diverse Module aufrufen die in DLLs ausgelagert sind (die DLLs werden dynamisch gelinkt)...

Rufe ich die Funktion im Hauptprogramm auf, habe ich kein Problem...
Rufe ich die Funktion aber in einer DLL auf bekomme ich einen Runtime Error 216...

Woran kann das liegen? Ist in der Funktion was falsch Programmiert?

[DeddyH]

Was mir zuerst auffällt:

Delphi-Quellcode:

{ Wichtiger Hinweis zur DLL-Speicherverwaltung: ShareMem muss die erste
  Unit in der USES-Klausel Ihrer Bibliothek UND in der USES-Klausel Ihres Projekts
  (wählen Sie 'Projekt-Quelltext anzeigen') sein, wenn Ihre DLL Prozeduren oder Funktionen
  exportiert, die Strings als Parameter oder Funktionsergebnisse übergeben. Dies
  gilt für alle Strings, die an oder von Ihrer DLL übergeben werden, auch für solche,
  die in Records und Klassen verschachtelt sind. ShareMem ist die Interface-Unit zur
  gemeinsamen BORLNDMM.DLL-Speicherverwaltung, die zusammen mit Ihrer DLL
  weitergegeben werden muss. Übergeben Sie String-Informationen mit PChar- oder ShortString-Parametern, um die Verwendung von BORLNDMM.DLL zu vermeiden.
 }

[Andidreas]

Ich hab folgendes gemacht...

main_form --> Ruft alle DLLs auf
update_form --> Form der DLL in ders knallt (und die die Funktion aufruft)
Global_unit --> Unit in der sich die Funktion befindet

Überall habe ich in der Uses Klausel "ShareMem" als erste Uses hinzugefügt...
Der beschriebene Fehler kommt trotzdem...

[DeddyH]

Auch in der *.dpr?

[edit] Nachtrag: evtl. solltest Du die Aufrufkonvention noch auf stdcall setzen. [/edit]

[Andidreas]

... oder muss das hier rein???

Delphi-Quellcode:

library updatecomdata;

uses
  ShareMem,
  Forms,
  ...;

Mist Deddy war schneller :stupid:

[Andidreas]

Der Fehler kommt immer noch...

In den Units der Forms habe ich ShareMem wieder entfernt, war das falsch?

So sieht es jetzt aus:

*.dpr des Hauptprogrammes

Delphi-Quellcode:

program Main;

uses
  ShareMem,
  Forms,

Aufruf der DLL

Delphi-Quellcode:

procedure Tmain_form.prOfflineModuleLoad_Single(sDLLModulePath : String);

type
TMyFormClass           = function : TFormClass; stdcall;
TSQLiteFileConnection   = procedure(SQLiteFileConnection : TUniConnection); stdcall;
TSQLiteMemoryConnection = procedure(SQLiteMemoryConnection : TUniConnection); stdcall;
TParms                  = procedure(Language, UserSewingPlant, UserEANCheckPlantID : String) stdcall;

var
i                       : Integer;
lMyFormClass            : TMyFormClass;
lSQLiteFileConnection   : TSQLiteFileConnection;
lSQLiteMemoryConnection : TSQLiteMemoryConnection;
lParms                  : TParms;

begin

  //Define Variables
  gsDLL := sDLLModulePath;
  hDLL  := LoadLibrary(PChar(gsDLL));
  gblDLLLoaded := True;

  //SQLite File Connection
  lSQLiteFileConnection := GetProcAddress(hDLL, 'prSQLiteFileConnect');
  If Assigned (lSQLiteFileConnection) Then
  Begin
    lSQLiteFileConnection(dmsqlite.SQLiteFile);
  End;

  //SQLite Memory Connection
  lSQLiteMemoryConnection := GetProcAddress(hDLL, 'prSQLiteMemoryConnect');
  If Assigned (lSQLiteMemoryConnection) Then
  Begin
    lSQLiteMemoryConnection(dmsqlite.SQLiteMemory);
  End;

  //Parameters
  lParms := GetProcAddress(hDLL, 'prModuleParameters');
  If Assigned (lParms) Then
  Begin
    lParms(gsPSTLanguage, gsPSTUserSewingPlant, gsPSTUserEANCheckPlantID);
  End;

  //Load DLL Form
  lMyFormClass := GetProcAddress(hDLL, 'fnForm');
  If @lMyFormClass <> Nil Then
  Begin
    frmLoadedForm   := lMyFormClass.Create(nil);
    frmLoadedForm.Position := poScreenCenter;
    frmLoadedForm.ShowModal;
  End Else
  Begin
    fnDisplayMyActionBox('ERR', 'System Error', 'prOfflineModuleLoad_Single', 'Could not load Module:', sDLLModulePath, EmptyStr, True);
  End;

end;

*.dpr der DLL

Delphi-Quellcode:

library updatecomdata;

uses
  ShareMem,
  Forms,
  Globals in '..\..\..\Globals\Globals.pas',
  Messages in '..\..\01_Globals\Messages.pas',
  myactionbox in '..\..\01_Globals\myactionbox.pas' {actionbox_form},
  myerrorbox in '..\..\01_Globals\myerrorbox.pas' {errorbox_form},
  Globals in '..\..\01_Globals\Globals.pas',
  updatecomdata in 'updatecomdata.pas' {updatecomdata_form},
  updatecomdata_info in 'updatecomdata_info.pas' {updatecomdata_info_form};

{$R *.res}

exports
  fnForm, prSQLiteFileConnect, prSQLiteMemoryConnect, prModuleParameters;

begin
end.

[DeddyH]

Das Gedöns mit der Formklasse erscheint mir etwas merkwürdig. Versuchst Du da Klassen/Objekte zwischen Anwendung und DLL auszutauschen?

[Andidreas]

Nein...
Eigentlich werden nur die Connections zu den DBs übergeben?!
Oder welche Stelle meinst Du?

[DeddyH]

Das hier meine ich:

Zitat:

Delphi-Quellcode:

//Load DLL Form
  lMyFormClass := GetProcAddress(hDLL, 'fnForm');
  If @lMyFormClass <> Nil Then
  Begin
    frmLoadedForm   := lMyFormClass.Create(nil);
    frmLoadedForm.Position := poScreenCenter;
    frmLoadedForm.ShowModal;
  End Else
  Begin
    fnDisplayMyActionBox('ERR', 'System Error', 'prOfflineModuleLoad_Single', 'Could not load Module:', sDLLModulePath, EmptyStr, True);
  End;

[Andidreas]

Das ist ja nur dazu da um die Form anzuzeigen...
Wir haben hier zwei Varianten... entweder wird die Form als eigenständiges Fenster angezeigt oder in einem Bereich der Hauptform...


Was ich kurios finde...
Die Funktion die ich oben beschrieben habe, habe ich auch für Windows XP:

Delphi-Quellcode:

//******************************************************************************
// fnGetShellFolder --> Get Constant Special Item ID Path from Windows         *
//                                                                             *
//                      Only for WIN XP                                        *
//                      WIN7 has to use fnGetKnownFolderPath in this Unit      *
//                                                                             *
// Parameter --> iCSIDL (Constant Special Item ID)                             *
// Return    --> Boolean True/False                                            *
//******************************************************************************

function fnGetShellFolder(iCSIDL: integer): string;

var
pIDL          : PItemIdList;
sFolderPath   : string;
iSystemFolder : Integer;
Malloc        : IMalloc;
  
begin

  Malloc := nil;
  sFolderPath := '';
  SHGetMalloc(Malloc);

  If Malloc = nil Then
  Begin
    Result := sFolderPath;
    Exit;
  End;

  Try
    iSystemFolder := iCSIDL;
    If SUCCEEDED(SHGetSpecialFolderLocation(0, iSystemFolder, pIDL)) then
    Begin
      SetLength(sFolderPath, max_path);
      If SHGetPathFromIDList(pidl, PChar(sFolderPath)) Then
      Begin
        SetLength(sFolderPath, length(PChar(sFolderPath)));
      End;
    End;
    Result := sFolderPath;
  Finally
    Malloc.Free(pIDL);
  End;

end;

Ich hab die gleiche DLL jetzt unter Windows XP getestet... hier kommt kein Fehler! Also kein Runtime Error...

Liegt der Fehler dann nicht eher in der Funktion für Windows 7, das diese einen Speicherfehler verursacht?

[TiGü]

Zitat:

Zitat von Andidreas (Beitrag 1237051)

Liegt der Fehler dann nicht eher in der Funktion für Windows 7, das diese einen Speicherfehler verursacht?

Weiß jetzt nicht, ob es dein Problem beseitigt, aber es wäre schon gut

Delphi-Quellcode:

CoTaskMemFree(sPath)

in deiner Funktion zu ergänzen (siehe MSDN).

[Andidreas]

In der DLL habe ich jetzt mal meine Funktion die unter Windows 7 die Pfade ermitteln soll, gegen den folgenden Code ausgetauscht:

Delphi-Quellcode:

  SHGetKnownFolderPath(FOLDERID_ProgramData, 0, 0, sPath);
  ShowMessage(sPath);
  CoTaskMemFree(sPath);

Mein Runtime Error kommt immer noch...
Kann das evtl. auch an der ShlObj Unit liegen?

Als letzte Idee würde mir noch einfallen das ganze gegen die Funktion GetEnvironmentVariable auszutauschen... Was ich nicht unbedingt möchte...

@DeddyH
Ich hoffe ich konnte in meinem letzten Beitrag deine Fragen nach dem Austausch von Objekten und Klassen zwischen Forms und DLLs beantworten?!

[Sir Rufo]

Also hiermit habe ich keine Probleme

Delphi-Quellcode:

library PathLib;

uses
  Winapi.ActiveX,
  Winapi.ShellAPI,
  Winapi.ShlObj,
  Winapi.Windows,
  System.SysUtils,
  System.Classes;

{$R *.res}

function GetKnownFolderPath( ACSIDL : TGUID ) : WideString;
  var
    LPath : PWideChar;
  begin
    if SHGetKnownFolderPath( ACSIDL, 0, 0, LPath ) = S_OK
    then
      Result := LPath
    else
      Result := '';
  end;

function GetSpecialFolder( AFolderID : Integer ) : WideString;
  var
    LPath : PWideChar;
  begin
    GetMem( LPath, MAX_PATH * SizeOf( WideChar ) );
    try
      if SHGetSpecialFolderPathW( 0, LPath, AFolderID, False )
      then
        Result := LPath
      else
        Result := '';
    finally
      FreeMem( LPath );
    end;
  end;

function DocumentRoot : WideString; stdcall;
  begin
    if CheckWin32Version( 9 )
    then
      Result := GetKnownFolderPath( StringToGUID( '{FDD39AD0-238F-46AF-ADB4-6C85480369C7}' ) )
    else
      Result := GetSpecialFolder( CSIDL_MYDOCUMENTS );
  end;

exports
  DocumentRoot;

begin

end.

Delphi-Quellcode:

unit View.Main;

interface

  uses
    Winapi.Windows,
    Winapi.Messages,
    System.SysUtils,
    System.Variants,
    System.Classes,
    Vcl.Graphics,
    Vcl.Controls,
    Vcl.Forms,
    Vcl.Dialogs,
    Vcl.StdCtrls;

  type
    TMainView = class( TForm )
      Button1 : TButton;
      procedure Button1Click( Sender : TObject );
    private
      { Private-Deklarationen }
    public
      { Public-Deklarationen }
    end;

  var
    MainView : TMainView;

implementation

{$R *.dfm}
  function DocumentRoot : WideString; stdcall; external 'PathLib.dll';

  procedure TMainView.Button1Click( Sender : TObject );
    begin
      Caption := DocumentRoot;
    end;

end.

[Andidreas]

@Sir Rufo...

Hab deinen Source in meiner DLL getestet, ich bekommen weiterhin den Runtime Error... :cry:

Liegt es evtl. wirklich an DeddyH's Vermutung?

[Sir Rufo]

Zitat:

Zitat von Andidreas (Beitrag 1237345)

@Sir Rufo...

Hab deinen Source in meiner DLL getestet, ich bekommen weiterhin den Runtime Error... :cry:

Liegt es evtl. wirklich an DeddyH's Vermutung?

Probier doch mal komplett meinen Source aus ... wenn der funktioniert, dann hat es damit rein gar nichts zu tun ;)

[hathor]

SHGetKnownFolderPath ist in ShlObj, aber funktioniert erst ab VISTA.

@Andidreas:
Du hast zwar "WINDOWS 7" geschrieben, aber bist Du versehentlich auf einem anderen BS?

[Sir Rufo]

Zitat:

Zitat von hathor (Beitrag 1237354)

SHGetKnownFolderPath ist in ShlObj, aber funktioniert erst ab VISTA.

Er schreibt ja, dass er mit Windows 7 Probleme hat.
Unter Windows XP war die Welt noch in Ordnung (darum hat er es mit SHGetKnownFolderPath für Windows 7 versucht) ;)

[jaenicke]

Fehlt vielleicht ein CoInitialize/Ex?
Was sagt GetLastError?

Runtime Error direkt aus der API Funktion hört sich seltsam an.

[rwalper]

1. Nur mal eine Idee: Benutzt Du vielleicht in Deiner DLL einen anderen oder auch speziellen Speichermanager als in der Exe?

2. Testhalber würde ich mal folgendes in der DLL ändern:

Delphi-Quellcode:

function fnGetKnownFolderPath(sKnownFolderID : String) : String;
var
  sPath: String;
begin
  SetLength(SPath, MAX_PATH);
  {$IFDEF VER220}
  If sKnownFolderID = 'FOLDERID_Desktop' Then SHGetKnownFolderPath(FOLDERID_Desktop,0, 0, PWideChar(sPath));