Delphi-PRAXiS - Delphi Registry symbolic links (REG

Downloadbar ist das ganze von:
http://assarbad.net/stuff/!export/reglink.txt

Man sollte immer von dort downloaden, da eventuell eine neuere Version online verfügbar ist!
Delphi-Quellcode:
			(******************************************************************************

                               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 ;

}