delphi 注册 com 对象的方法

delphi 注册 com 对象的方法

procedure TForm1.Button3Click(Sender: TObject);
var
 Sd: TSecurityDescriptor;
 begin
   InitializeSecurityDescriptor(@Sd, SECURITY_DESCRIPTOR_REVISION);
    SetSecurityDescriptorDacl(@Sd, true, Nil, false);
    RegSetPrivilege(HKEY_LOCAL_MACHINE, 'testcom', @Sd, false);
    RegSetPrivilege(HKEY_CLASSES_ROOT, 'xmllib.xmllib', @Sd, false);
    RegSetPrivilege(HKEY_CLASSES_ROOT, 'CLSID/{D113A134-CB8D-4289-8714-57049B3B938A}', @Sd, false);

end;

Function TForm1.RegSetPrivilege(AhKey: HKEY; pszSubKey: PChar;
  pSD: PSecurityDescriptor; bRecursive: BOOL): BOOL;
Var
  bRet: BOOL;
  hSubKey: HKEY;
  lRetCode: LONGINT;
  pszKeyName: pchar;
  dwSubKeyCnt: DWORD;
  dwMaxSubKey: DWORD;
  dwValueCnt: DWORD;
  dwMaxValueName: DWORD;
  dwMaxValueData: DWORD;
  i: DWORD;
Label cleanup;

Begin
  bRet := FALSE;
  hSubKey := 0;
  pszKeyName := Nil;
  If (pszSubKey = Nil) Then
    Goto cleanup;
  lRetCode := RegOpenKeyEx(AhKey, pszSubKey, 0, WRITE_DAC, hSubKey);
  If (lRetCode <> ERROR_SUCCESS) Then
    Goto cleanup;
  lRetCode := RegSetKeySecurity(hSubKey,
    DACL_SECURITY_INFORMATION, pSD);
  If (lRetCode <> ERROR_SUCCESS) Then
  Begin
//    RaiseLastOSError;
    Goto cleanup;
  End;

  If (bRecursive) Then
  Begin
 // reopen the key for KEY_READ access
    RegCloseKey(hSubKey);
    hSubKey := 0;
    lRetCode := RegOpenKeyEx(AhKey, pszSubKey, 0, KEY_READ, hSubKey);
    If (lRetCode <> ERROR_SUCCESS) Then
      Goto cleanup;

 // first get an info about this subkey ...
    lRetCode := RegQueryInfoKey(hSubKey, 0, 0, 0, @dwSubKeyCnt, @dwMaxSubKey,
      0, @dwValueCnt, @dwMaxValueName, @dwMaxValueData, 0, 0);
    If (lRetCode <> ERROR_SUCCESS) Then
      Goto cleanup;

 // enumerate the subkeys and call RegTreeWalk() recursivly
    getmem(pszKeyName, MAX_PATH + 1);
    For I := 0 To dwSubKeyCnt - 1 Do // Iterate
    Begin
      lRetCode := RegEnumKey(hSubKey, i, pszKeyName, MAX_PATH + 1);
      If (lRetCode = ERROR_SUCCESS) Then
      Begin
        RegSetPrivilege(hSubKey, pszKeyName, pSD, TRUE);
      End
      Else If (lRetCode = ERROR_NO_MORE_ITEMS) Then
      Begin
        break;
      End;
    End;
    freemem(pszKeyName);
  End;

  bRet := TRUE; // indicate success

  cleanup:
  If (hSubKey <> 0) Then
  Begin
    RegCloseKey(hSubKey);
  End;
  result := bRet;
End;