So, nach ein bisschen Ge-Google bin ich u.a. auf dieser russischen
Seite gelandet, die ein komplettes VB-Skript enthielt. Was VBS kann, kann ich mit Delphi schon lange, dachte ich mir, und voilà:
Delphi-Quellcode:
uses
ActiveX, ShlObj;
function CreateFolderShortCut(
const DestinationPath, Folder:
string):
boolean;
function CreateReadOnlyDir(
const Path:
string): boolean;
begin
// schreibgeschützten Ordner erzeugen, ...
Result := (CreateDirectory(pchar(Path),
nil))
and
(SetFileAttributes(pchar(Path),FILE_ATTRIBUTE_READONLY))
and
// ... & versteckte "desktop.ini" erzeugen
(WritePrivateProfileString('
.ShellClassInfo','
CLSID2',
'
{0AFACED1-E828-11D1-9187-B532F1E9575D}',
pchar(Path + '
\desktop.ini')))
and
(WritePrivateProfileString('
.ShellClassInfo','
Flags','
2',
pchar(Path + '
\desktop.ini')))
and
(SetFileAttributes(pchar(Path + '
\desktop.ini'),
FILE_ATTRIBUTE_HIDDEN
or FILE_ATTRIBUTE_SYSTEM));
end;
function CreateComObject(
const ClassID: TGUID;
var OleResult : HRESULT): IUnknown;
begin
OleResult := CoCreateInstance(ClassID,
nil,CLSCTX_INPROC_SERVER
or
CLSCTX_LOCAL_SERVER,IUnknown,Result);
end;
var
hr : HRESULT;
link : IShellLink;
pFile : IPersistFile;
pwcData :
array[0..MAX_PATH]
of widechar;
begin
Result := false;
link :=
nil;
pFile :=
nil;
if(CoInitialize(
nil) = S_OK)
then
try
// Shortcut erzeugen
link := CreateComObject(CLSID_ShellLink,hr)
as IShellLink;
if(hr = S_OK)
and (link <>
nil)
then
begin
// Name für die Verknüpfung setzen
ZeroMemory(@pwcData,sizeof(pwcData));
if(StringToWideChar(DestinationPath + '
\target.lnk',pwcData,
sizeof(pwcData)) <>
nil)
then
begin
// Ordner erzeugen, ...
if(CreateReadOnlyDir(DestinationPath))
then
begin
// Verknüpfungsziel setzen, ...
link.SetPath(pchar(Folder));
// ... & Verknüpfung erstellen
pFile := link
as IPersistFile;
Result := (pFile.Save(pwcData,true) = S_OK);
end;
end;
end;
finally
if(pFile <>
nil)
then pFile :=
nil;
if(link <>
nil)
then link :=
nil;
CoUninitialize;
end;
end;
Beispielaufruf:
Delphi-Quellcode:
CreateFolderShortCut(
'g:\test', // <-- der anzulegende Ordner auf G:\ (= FAT-Partition)
'c:\LastCrap'); // <-- das Ziel auf C:\ (= FAT-Partition)
Muss noch was verbessert werden?
btw: Vielleicht könnte mal jemand, der des Russischen mächtig ist, den Satz übersetzen, in dem XP, 2000 und ME genannt werden. Meine Vermutung ist (ich hatte Russisch mal in der Schule, spreche aber inzwischen kein Wort mehr ...
... Na ja, außer "Ich heiße ...", "Ich wohne ...", "Gehen wir zu dir oder zu mir?"), dass dort gesagt wird: Unter XP und 2000 funktioniert´s, unter ME (und damit generell unter 9x) nicht ...
Nico-Modus: Editiert, während andere (hoffentlich) den Beitrag gerade lesen 