const
KERNEL32_DLL :
String = '
KERNEL32.DLL';
SYMBOLIC_LINK_FLAG_FILE : DWORD = $0;
// Datei als Link erstellen
SYMBOLIC_LINK_FLAG_DIRECTORY : DWORD = $1;
// Verzeichnis als Link erstellen
// CreateSymbolicLink dynamisch importieren
type
TCreateSymbolicLink =
function (lpSymlinkFileName : LPCWSTR;
lpTargetFileName : LPCWSTR;
dwFlags : DWORD) : Boolean;
stdcall;
function CreateSymbolicLink(lpSymlinkFileName : LPCWSTR;
lpTargetFileName : LPCWSTR;
dwFlags : DWORD) : Boolean;
var
DLL_Handle : THandle;
// für dynamischen Funktionsimport!
DLL_CreateSymbolicLink : TCreateSymbolicLink;
// für dynamischen Funktionsimport!
begin
Result := False;
// Handle für die KERNEL32.DLL erhalten
DLL_Handle := LoadLibrary(PChar(KERNEL32_DLL));
// Wenn Handle vorhanden, Adressen der Funktionen ermitteln
if DLL_Handle <> 0
then
begin
// Adresse in der DLL ermitteln
@DLL_CreateSymbolicLink := GetProcAddress(DLL_Handle, '
CreateSymbolicLinkW');
// Wurde CreateSymbolicLink in der DLL gefunden?
if @DLL_CreateSymbolicLink <>
nil then
begin
// Symbolischen Link erstellen
if DLL_CreateSymbolicLink(lpSymlinkFileName,
lpTargetFileName,
dwFlags)
then Result := True;
end
else
begin
// Wenn die gewünschte Funktion in der KERNEL32.DLL nicht
// gefunden wurde soll eine Fehlermeldung angezeigt werden
ShowMessage('
Es ist ein Fehler aufgetreten.' + #13#10 +
'
Eine benötigte Funktion konnte in der Datei "' + KERNEL32_DLL + '
" ' + #13#10 +
'
nicht gefunden werden.');
Result := False;
end;
FreeLibrary(DLL_Handle);
end
else
begin
// Wenn die gewünschte Datei KERNEL32.DLL nicht gefunden
// wurde soll eine Fehlermeldung angezeigt werden
ShowMessage('
Es ist ein Fehler aufgetreten.' + #13#10 +
'
Die benötigte Datei "' + KERNEL32_DLL + '
" konnte nicht geladen werden.');
Result := False;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
SelectedDir : WideString;
NameOfSymLink : WideString;
begin
if GetLastError <> 0
then
showmessage('
#' + IntToStr(GetLastError) + '
: ' + SysErrorMessage(GetLastError) + '
.');
NameOfSymLink := '
D:\Test-SymLink';
if FileOpenDialog1.Execute
then
begin
SelectedDir := WideString(FileOpenDialog1.FileName);
if CreateSymbolicLink(PWideChar(NameOfSymLink),
PWideChar(SelectedDir),
SYMBOLIC_LINK_FLAG_DIRECTORY)
then
showmessage('
Symbolic Link erstellt');
end;
if GetLastError <> 0
then
showmessage('
#' + IntToStr(GetLastError) + '
: ' + SysErrorMessage(GetLastError) + '
.');
end;