unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ShellApi, ShlObj,
ActiveX;
type
TForm1 =
class(TForm)
Label1: TLabel;
Edit1: TEdit;
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
FShellLibrary: IShellLibrary;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function SHCreateLibrary(
const riid: TIID;
var ppv: Pointer): HRESULT;
begin
result := CoCreateInstance(CLSID_ShellLibrary,
nil, CLSCTX_INPROC_SERVER,
IID_IShellLibrary, Pointer(ppv) ) ;
end;
function SHLoadLibraryFromParsingName( libraryParsingName: PWideChar;
stgmFlags: dword;
const riid: TIID;
var ppv: IShellLibrary): HResult;
var libraryFilePidl: PItemIDList;
libraryFileShellItem: IShellItem;
shellLibrary: IShellLibrary;
attributes: dword;
begin
attributes := 0;
result := SHILCreateFromPath(libraryParsingName,libraryFilePidl, attributes );
if result = S_OK
then begin
result := SHCreateItemFromIDList(libraryFilePidl, IID_IShellItem, Pointer(libraryFileShellItem) );
if result = S_OK
then begin
result := SHCreateLibrary(IID_IShellLibrary, Pointer(shellLibrary) );
if result = S_OK
then begin
result := shellLibrary.LoadLibraryFromItem(libraryFileShellItem, STGM_READWRITE );
if result = S_OK
then
ppv := shellLibrary;
end;
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
CoInitialize(
nil);
Edit1.Text := '
::{031E4825-7B94-4DC3-B131-E946B44C8DD5}\Documents.library-ms';
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
CoUninitialize;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if Succeeded(SHLoadLibraryFromParsingName(PWideChar(Edit1.Text),STGM_READWRITE,IID_IShellLibrary, FShellLibrary ))
then
ShowMessage('
Success');
end;
end.