(******************************************************************************
REGLINK.TXT v1.00
The code is PUBLIC DOMAIN
[ http://assarbad.net/stuff/!export/reglink.txt ]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Written and published by -=Assarbad=- (2003-08-07)
[url]http://assarbad.net[/url]
Assarbad AT gmx DOT info
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!!!!!!!!!!!!!!!!!This is considered to work on NT platform only!!!!!!!!!!!!!!!!
-------------------------------------------------------------------------------
It is recommended to check out the site: "http://www.ntinternals.net"
for a way on how to delete symbolic links (aka REG_LINK).
They use a method where the native API is being called. When trying to use the
Win32 API with different flags I got bluescreens over and over. Therefore one
should consider using the Native API.
If I should find appropriate flags for deletion of REG_LINK I will update the
source. If YOU find it, please let me know (but only if it is Win32 API!!! I
can write a Native API function myself - but ii's more excting here to find the
proper flags with the Win32 API).
-------------------------------------------------------------------------------
Although my method uses the Win32 API, I use undocumented flags that are anyway
passed down to the Native API. That's why a cannot attest the correct function
under all circumstances. It is more a prototype for studying REG_LINK. It's not
meant to be used directly without careful testing!
Therefore: YOU HAVE TO KNOW WHAT YOU DO WHEN USING THIS SOURCE. BACKUP THE
REGISTRY BEFORE TO NOT DAMAGE IT! I TAKE NO RESPONSIBILITY FOR ANY DAMAGE
CAUSED BY THE USE OF THIS CODE!
IF YOU SET IMPROPER PATHES AS LINK TARGET, THE RESULTING LINKS CANNOT BE
ACCESSED PROPERLY ANYMORE!
******************************************************************************)
{
const
REG_OPTION_RESERVED = $00000000; // Parameter is reserved
REG_OPTION_NON_VOLATILE = $00000000; // Key is preserved when system is rebooted
REG_OPTION_VOLATILE = $00000001; // Key is not preserved when system is rebooted
REG_OPTION_CREATE_LINK = $00000002; // Created key is a symbolic link
REG_OPTION_BACKUP_RESTORE = $00000004; // open for backup or restore special access rules privilege required
REG_OPTION_OPEN_LINK = $00000008; // Open symbolic link
}
const
REG_OPTION_OPEN_LINK = $00000008;
// Open unicode symbolic registry link
function CreateReglinkW(Keyname, LinkTarget: WideString): Boolean;
(*
Creates a unicode symbolic link in the registry.
That's why I called this function CreateRegLinkW() and not CreateRegLinkA().
It will not work if you use a LinkTarget in ANSI format!!!
Note: The format of the link target HAS TO BE in Windows NT native format.
I am not sure wether this also implies that the function would only work
on Windows NT and later.
The Windows NT notion is, where Keyname lies in
HKEY_LOCAL_MACHINE\Keyname -> \Registry\Machine\Keyname
HKEY_USERS\Keyname -> \Registry\User\Keyname
The notion follows the common object namespace notion of NT.
*)
var
key: HKEY;
len, err: DWORD;
data: Pointer;
begin
Result := False;
err := RegCreateKeyExW(HKEY_LOCAL_MACHINE, @keyname[1], 0,
nil, REG_OPTION_CREATE_LINK, KEY_ALL_ACCESS,
nil, key,
nil);
if err = ERROR_SUCCESS
then
try
len := length(linktarget) * sizeof(WideChar);
data := GetMemory(len + sizeof(WideChar));
if Assigned(data)
then
try
lstrcpynW(data, @linktarget[1], len + sizeof(WideChar));
result := RegSetValueExW(key, '
SymbolicLinkValue', 0, REG_LINK, data, len) = ERROR_SUCCESS;
finally
FreeMemory(data);
end;
finally
RegCloseKey(key);
end;
end;
function SetReglinkW(Keyname, LinkTarget: WideString): Boolean;
(*
Changes the LinkTarget of a symbolic link
Parameters and conventions similar to CreateRegLinkW().
*)
var
key: HKEY;
len, err: DWORD;
data: Pointer;
begin
Result := False;
err := RegCreateKeyExW(HKEY_LOCAL_MACHINE, @keyname[1], 0,
nil, REG_OPTION_OPEN_LINK, KEY_ALL_ACCESS,
nil, key,
nil);
if err = ERROR_SUCCESS
then
try
len := length(linktarget) * sizeof(WideChar);
data := GetMemory(len + sizeof(WideChar));
if Assigned(data)
then
try
lstrcpynW(data, @linktarget[1], len + sizeof(WideChar));
result := RegSetValueExW(key, '
SymbolicLinkValue', 0, REG_LINK, data, len) = ERROR_SUCCESS;
finally
FreeMemory(data);
end;
finally
RegCloseKey(key);
end;
end;
//------------------------------------------------------------------------------
{
Here are two examples for calling the functions:
if CreateRegLinkW('Software\!Testlink2', '\Registry\Machine\Software\Microsoft') then ;
if SetRegLinkW('Software\!Testlink2', '\Registry\Machine\Software\Microsoft\Windows NT') then ;
}