VPF::HKEY_CURRENT_USER и NTDeleteKey - Форум программистов

3she1on

Дата 15.10.2008, 17:02 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 14
Регистрация: 15.10.2008

Репутация: нет
Всего: нет

Доброго времени суток! Недавно возникла необходимость удалить из реестра так называемую embedded-null ветку. Решил для этой цели использовать Си-шный код, адаптированный для Делфи (автор некто Руссинович). Привожу отрывок исходника:

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Buttons, StdCtrls;

type
  TForm1 = class(TForm)
    SpeedButton1: TSpeedButton;
    procedure SpeedButton1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
{$R *.dfm}
// DEFINE MISSING CONSTANTS

const
  ntdll = 'ntdll.dll';
  OBJ_CASE_INSENSITIVE = $00000040;

// DEFINE MISSING TYPE DECLARATIONS

type
  USHORT = WORD;
  NTSTATUS = ULONG;
  PVOID = Pointer;

// TRANSLATE MACRO
function NT_SUCCESS(Status: Integer): WordBool;
begin
  Result := Status >= 0;
end;

// DEFINE Native API UNICODE STRING

type
  TUnicodeString = packed record
    Length: USHORT;
    MaximumLength: USHORT;
    Buffer: PWideChar;
  end;
  UNICODE_STRING = TUnicodeString;
  PUNICODE_STRING = ^UNICODE_STRING;

// DEFINE Native API OBJECT ATTRIBUTES

  TObjectAttributes = packed record
    Length: ULONG;
    RootDirectory: THandle;
    ObjectName: PUNICODE_STRING;
    Attributes: ULONG;
    SecurityDescriptor: PVOID;        // Points to type SECURITY_DESCRIPTOR
    SecurityQualityOfService: PVOID;  // Points to type SECURITY_QUALITY_OF_SERVICE
  end;
  OBJECT_ATTRIBUTES = TObjectAttributes;
  POBJECT_ATTRIBUTES = ^OBJECT_ATTRIBUTES;

// TRANSLATE MACRO

procedure InitializeObjectAttributes(var p: TObjectAttributes; n:
    PUNICODE_STRING; a: ULONG; r: THandle; s: PVOID);
begin
  p.Length := SizeOf(OBJECT_ATTRIBUTES);
  p.RootDirectory := r;
  p.Attributes := a;
  p.ObjectName := n;
  p.SecurityDescriptor := s;
  p.SecurityQualityOfService := nil;
end;

// IMPORT NTDLL FUNCTIONS

function NtCreateKey(var KeyHandle: THandle; DesiredAccess: ULONG; var
    ObjectAttributes: OBJECT_ATTRIBUTES; TitleIndex: ULONG; Class_:
    PUNICODE_STRING; CreateOptions: ULONG; var Disposition: ULONG): NTSTATUS;
    stdcall; external ntdll name 'NtCreateKey';

function NtSetValueKey(KeyHandle: THandle; ValueName: PUNICODE_STRING;
    TitleIndex: ULONG; Type_: ULONG; Data: PVOID; DataSize: ULONG): NTSTATUS;
    stdcall; external ntdll name 'NtSetValueKey';

function NtDeleteKey(KeyHandle: THandle): NTSTATUS; stdcall; external ntdll
    name 'NtDeleteKey';

// DEFINE OUR REGISTY STRINGS

const
  KeyNameBuffer: AnsiString = '\Registry\Users\CurrentUser\Software';
  NewKeyNameBuffer: AnsiString = 'Shodans Tech';
  HiddenKeyNameBuffer: AnsiString = 'Can''t touch me!'#0;
  HiddenValueNameBuffer: AnsiString = 'Hidden Value';

procedure TForm1.SpeedButton1Click(Sender: TObject);
var
   KeyName, ValueName: UNICODE_STRING;
   SoftwareKeyHandle, SysKeyHandle, HiddenKeyHandle: THandle;
   Status: ULONG;
   ObjectAttributes: OBJECT_ATTRIBUTES;
   Disposition: ULONG;
  Buffer: array of WideChar;
begin

  SetLength(Buffer, Length(KeyNameBuffer));
  MultiByteToWideChar(CP_UTF8, 0, @KeyNameBuffer[1], Length(KeyNameBuffer),
      PWideChar(Buffer), Length(Buffer));
  KeyName.Buffer := @Buffer[0];
   KeyName.Length := Length(KeyNameBuffer) * SizeOf(WideChar);
   InitializeObjectAttributes(ObjectAttributes, @KeyName, OBJ_CASE_INSENSITIVE,
      0, nil);
   Status := NtCreateKey(SoftwareKeyHandle, KEY_ALL_ACCESS, ObjectAttributes, 0,
      nil, REG_OPTION_NON_VOLATILE, Disposition);
   if not NT_SUCCESS(Status) then
     raise Exception.Create('Error: Couldn''t open HKCU\Software');

......................

end;
end.

При значении константы

Код


KeyNameBuffer: AnsiString = '\Registry\Machine\Software';

Все отлично работает. Но мне необходимо работать не с HKLM, а c HKCU. Пытался ссылаться на "\Registry\User\CurrentUser", но результат - получаю эксепшн при попытке открыть ключ. Как получить доступ к HKCU в данной ситуации?
Заранее благодарен!

Rrader

Дата 15.10.2008, 17:53 (ссылка)

(нет голосов)

Загрузка ...

Inspired =)

Профиль
Группа: Экс. модератор
Сообщений: 1535
Регистрация: 7.5.2005

Репутация: 70
Всего: 191

Тут все не так просто. Вместо CurrentUser должна стоять специальная строка. Как ее получить - можно в реестре прочитать (HKEY_USERS) smile

В аттаче привел пример для своего компьютера.

Это сообщение отредактировал(а) Rrader - 15.10.2008, 17:55

Присоединённый файл ( Кол-во скачиваний: 17 )

1.PNG 11,22 Kb

--------------------

Let's do this quickly!
Rest in peace, Vit!

3she1on

Дата 15.10.2008, 18:08 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 14
Регистрация: 15.10.2008

Репутация: нет
Всего: нет

Хорошо. Тогда как программно получить СИД текущего пользователя. Просто прога должна работать на разных компьютерах, так что нужен универсальный вариант. Может, есть какой то хендлер - аналог СИДа активного пользователя?

3she1on

Дата 15.10.2008, 18:47 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 14
Регистрация: 15.10.2008

Репутация: нет
Всего: нет

Ура. Работает. Удалось программно получить SID текущего пользователя. Теперь просто его вставляю в середину пути к нужной ветке и все ок ). Всем спасибо. Вопрос закрыт smile

Virtuals

Дата 15.10.2008, 18:52 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 476
Регистрация: 27.11.2006

Репутация: 3
Всего: 11

3she1on, этого хватит?

Код


OpenThreadToken(GetCurrentThreadId,TOKEN_WRITE or TOKEN_DUPLICATE or TOKEN_QUERY,true,hToken);
 if not GetLogonSID(hToken, ppSid) then Form1.Memo1.Lines.Add(SysErrorMessage(GetLastError));

Код


function GetLogonSID(hToken: THandle; var pSid: PSID): Boolean;
var
   dwIndex, dwLength: DWORD;
   ptg: PTokenGroups;
begin
   Result:= False;
   dwLength:= 0;
   ptg:= nil;

   // Get required buffer size and allocate the TOKEN_GROUPS buffer.
   try
     if not GetTokenInformation(
                hToken,         // handle to the access token
                TokenGroups,    // get information about the token's groups
                ptg,            // pointer to TOKEN_GROUPS buffer
                0,              // size of buffer
                dwLength        // receives required buffer size
            )
     then begin
       if GetLastError <> ERROR_INSUFFICIENT_BUFFER then
         Exit;

       ptg:= HeapAlloc(GetProcessHeap,
                 HEAP_ZERO_MEMORY,
                 dwLength);

       if ptg = nil then
         Exit;
     end;

     // Get the token group information from the access token.

     if not GetTokenInformation(
                hToken,         // handle to the access token
                TokenGroups,    // get information about the token's groups
                ptg,            // pointer to TOKEN_GROUPS buffer
                dwLength,       // size of buffer
                dwLength        // receives required buffer size
            )
     then
       Exit;

     // Loop through the groups to find the logon SID.

     for dwIndex:= 0 to ptg.GroupCount - 1 do
       if (ptg.Groups[dwIndex].Attributes and SE_GROUP_LOGON_ID) =  
SE_GROUP_LOGON_ID
       then begin
         // Found the logon SID; make a copy of it.

         dwLength:= GetLengthSid(ptg.Groups[dwIndex].Sid);
         pSid:= HeapAlloc(GetProcessHeap,
                    HEAP_ZERO_MEMORY,
                    dwLength);
         if pSid = nil
         then Exit;

         if not CopySid(dwLength, pSid, ptg.Groups[dwIndex].Sid)
         then begin
           HeapFree(GetProcessHeap, 0, pSid);
           Exit;
         end;
         Break;
       end;

     Result:= True;
   finally
     // Free the buffer for the token groups.

     if ptg <> nil
     then HeapFree(GetProcessHeap(), 0, ptg);
   end;
end;

ну и в догонку

Код


procedure FreeLogonSID(var pSid: PSID);
begin
   HeapFree(GetProcessHeap, 0, pSid);
end;

Добавлено через 2 минуты и 59 секунд
зы похоже не успел ответить smile

3she1on

Дата 15.10.2008, 19:51 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 14
Регистрация: 15.10.2008

Репутация: нет
Всего: нет

Цитата

зы похоже не успел ответить

Всеравно, спасибо )

Исходник моего решения вопроса в аттаче.

Присоединённый файл ( Кол-во скачиваний: 22 )

RegistryWorks_src.zip 3,76 Kb

Riply

Дата 18.10.2008, 14:22 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Комодератор
Сообщений: 572
Регистрация: 27.3.2007
Где: St. Petersburg

Репутация: 3
Всего: 32

Цитата(Rrader @ 15.10.2008, 17:53

)

Тут все не так просто.

RtlOpenCurrentUser ( RtlFormatCurrentUserKeyPath ) smile

--------------------

Решение задач под заказ

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »