(******************************************************************************
                               REGLINK.TXT v1.00

                           The code is PUBLIC DOMAIN
                 [ http://assarbad.net/stuff/!export/reglink.txt ]

 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
                 Written and published by -=Assarbad=- (2003-08-07)

                              http://assarbad.net
                           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 ;
}