Solved

Need help Porting - Access Violation / 500pts + Grade A

Posted on 2007-03-20
10
352 Views
Last Modified: 2008-02-07
Hello all,

I'm trying to port this sysinternals reghide code to VB. I found the original source (C) here on EE and a delphi port on some german site (linked below). Below is my horribly broken port, I'm getting an access violation on NtCreateKey - I'm thinking the problem is in the InitializeObjectAttributes call.

Can anyone please help?

C- http://www.experts-exchange.com/Programming/System/Windows__Programming/Q_10062388.html?qid=10062388

Delphi - http://www.delphipraxis.net/post21827.html

---------------------My broken attempt---------------------------------------------------------------

Private Const ntdll = "ntdll.dll"
Private Const OBJ_CASE_INSENSITIVE = &H40

Private Const KeyNameBuffer As String = "\Registry\Machine\SOFTWARE"
Private Const NewKeyNameBuffer As String = "Systems Internals"
Private Const HiddenKeyNameBuffer As String = "Can't touch me!/0"
Private Const HiddenValueNameBuffer As String = "Hidden Value"
Private Const CP_UTF8 = 65001
Private Const CP_THREAD_ACP = 3
Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_SET_VALUE = &H2
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_CREATE_LINK = &H20
Private Const SYNCHRONIZE = &H100000
Private Const REG_OPTION_NON_VOLATILE = 0       ' Key is preserved when system is rebooted
Private Const REG_SZ = 1                         ' Unicode nul terminated string
Private Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))

Private Type UNICODE_STRING
   Length As Integer
   MaximumLength As Integer
   Buffer As Long
End Type


Private Type Object_Attributes '= packed record
   Length As Long
   RootDirectory As Long
   ObjectName As UNICODE_STRING
   Attributes As Long
   SecurityDescriptor As Long        '// Points to type SECURITY_DESCRIPTOR
   SecurityQualityOfService As Long  '// Points to type SECURITY_QUALITY_OF_SERVICE
End Type

Private Declare Function NtCreateKey Lib "ntdll.dll" (KeyHandle As Long, DesiredAccess As Long, _
    ObjectAttributes As Object_Attributes, TitleIndex As Long, Class As Any, _
    CreateOptions As Long, Disposition As Long) As Long ': NTSTATUS;
    'stdcall; external ntdll name 'NtCreateKey';

Private Declare Function NtSetValueKey Lib "ntdll.dll" (KeyHandle As Long, ValueName As UNICODE_STRING, _
    TitleIndex As Long, Type1 As Long, Data As Long, DataSize As Long) As Long ';: NTSTATUS;
   'stdcall; external ntdll name 'NtSetValueKey';

Private Declare Function NtDeleteKey Lib "ntdll.dll" (KeyHandle As Long) As Long ' NTSTATUS; stdcall; external ntdll
   ' name 'NtDeleteKey';
   
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As String, ByVal cchMultiByte As Long, ByVal lpWideCharStr As String, ByVal cchWideChar As Long) As Long


Private Function NT_SUCCESS(Status As Integer) As Boolean
  NT_SUCCESS = Status >= 0
End Function


Private Sub InitializeObjectAttributes(p As Object_Attributes, n As UNICODE_STRING, _
    a As Long, r As Long, s As Long)

  p.Length = Len(Object_Attributes)
  p.RootDirectory = r
  p.Attributes = a
  p.ObjectName = n
  p.SecurityDescriptor = s
  p.SecurityQualityOfService = 0&
End Sub

Private Sub Command1_Click()


   Dim KeyName As UNICODE_STRING, ValueName As UNICODE_STRING
   Dim SoftwareKeyHandle As Long, SysKeyHandle As Long, HiddenKeyHandle As Long
   Dim Status As Long
   Dim ObjectAttributes As Object_Attributes
   Dim Disposition
   Dim Buffer As String

 ' ShowMessage('Reghide'#13#10 + 'Creates a Registry key that cannot be ' +
 '     'opened with Regedit/Regedt32'#13#10#13#10'original by Mark Russinovich' +
 '     #13#10'Delphi-Version by Daniel Wischnewski'#13#10'http://www.' +
 '     'sysinternals.com'#13#10'http://www.gatenetwork.com');

'   //
'   // Open the Software key
'   //
  Buffer = Space(Len(KeyNameBuffer) * 2)
 
  joe = MultiByteToWideChar(CP_UTF8, 0, KeyNameBuffer, Len(KeyNameBuffer), _
      StrPtr(Buffer), Len(Buffer))

   KeyName.Buffer = StrPtr(Buffer)
   KeyName.Length = Len(KeyNameBuffer) * 2
   Call InitializeObjectAttributes(ObjectAttributes, KeyName, OBJ_CASE_INSENSITIVE, 0, 0&)
   
   
   
   Status = NtCreateKey(SoftwareKeyHandle, KEY_ALL_ACCESS, ObjectAttributes, 0, 0&, REG_OPTION_NON_VOLATILE, Disposition)
   Debug.Print Status
   If Not Status Then
   MsgBox "error occurred"
     'raise Exception.Create('Error: Couldn''t open HKLM\Software')
   End If
'   //
'   // Create the "Systems Internals" key
'   //
  Buffer = Space(Len(NewKeyNameBuffer))
  joe = MultiByteToWideChar(CP_THREAD_ACP, 0, NewKeyNameBuffer, Len( _
      NewKeyNameBuffer), StrPtr(Buffer), Len(Buffer))
  KeyName.Buffer = Buffer
   KeyName.Length = Len(NewKeyNameBuffer) * 2
  Call InitializeObjectAttributes(ObjectAttributes, KeyName, OBJ_CASE_INSENSITIVE, SoftwareKeyHandle, 0&)
   
   Status = NtCreateKey(SysKeyHandle, KEY_ALL_ACCESS, ObjectAttributes, 0, _
      0&, REG_OPTION_NON_VOLATILE, Disposition)
     
   If Not Status Then
   MsgBox "error occurred"
    'raise Exception.Create(
        'Error: Couldn''t create HKLM\Software\Systems Internals');
   End If
'   //
'   // Create the Hidden key
'   //
  Buffer = Space(Len(HiddenKeyNameBuffer))
  joe = MultiByteToWideChar(CP_UTF8, 0, HiddenKeyNameBuffer, Len( _
      HiddenKeyNameBuffer), StrPtr(Buffer), Len(Buffer))
     
  KeyName.Buffer = Buffer
 
  KeyName.Length = Len(HiddenKeyNameBuffer) * 2
   
  Call InitializeObjectAttributes(ObjectAttributes, KeyName, OBJ_CASE_INSENSITIVE, _
      SysKeyHandle, 0&)
     
   Status = NtCreateKey(HiddenKeyHandle, KEY_ALL_ACCESS, ObjectAttributes, 0, _
      0&, REG_OPTION_NON_VOLATILE, Disposition)
     
   If Not Status Then
   MsgBox "error occurred"
    'raise Exception.Create(
    '    'Error: Couldn''t create HKLM\Software\Systems Internals\RegHide');
   End If
'   //
'   // Create the hidden value
'   //
  Buffer = Space(Len(HiddenValueNameBuffer))
  joe = MultiByteToWideChar(CP_UTF8, 0, HiddenValueNameBuffer, Len( _
      HiddenValueNameBuffer), StrPtr(Buffer), Len(Buffer))
  ValueName.Buffer = Buffer
  ValueName.Length = Len(HiddenValueNameBuffer) * 2
   
   Status = NtSetValueKey(HiddenKeyHandle, ValueName, 0, REG_SZ, _
      HiddenValueNameBuffer, Len(HiddenValueNameBuffer) * 2)
   If Not Status Then
   MsgBox "error occured"
      NtDeleteKey (HiddenKeyHandle)
    'raise Exception.Create('Error: Couldn''t create our hidden value');
   End If

'   //
'   // Let the user try and open our key!
'   //
'  ShowMessage('Try and open the key "HKLM\SOFTWARE\Systems Internals\Can''t ' +
'      'touch me!"'#13#10'with Regedit or Regedt32 (or any other Registry ' +
'      'editor). There is a value'#13#10'in the key called "Hidden Value".' +
'      #13#10#13#10'When done trying, press any key to have the key deleted ' +
'      'and exit.');


   NtDeleteKey (HiddenKeyHandle)
End Sub

Thanks in advance,
500pts + Grade A








0
Comment
Question by:mugman21
10 Comments
 
LVL 22

Expert Comment

by:danaseaman
ID: 18757502
There are basically 3 ways to pass unicode strings via API in Vb6.
1. Put API functions into a TLB and pass the string normally, just as you would do with an ANSI string.
2. Use a byte array to pass the Unicode strings.
3. Declare the API parameter as Long and then use StrPtr(UniCcodeString) when you call the API.
   This is the recommended method.

Also do not multiply the length by 2, simply use Len(sUnicodeString).

i.e.
Private Declare Function NtSetValueKey Lib "ntdll.dll" (KeyHandle As Long, ValueName As UNICODE_STRING, _
    TitleIndex As Long, Type1 As Long, Data As Long, DataSize As Long) As Long

should be

Private Declare Function NtSetValueKey Lib "ntdll.dll" (KeyHandle As Long, ValueName As Long, _
    TitleIndex As Long, Type1 As Long, Data As Long, DataSize As Long) As Long

The call would then be:
   NtSetValueKey KeyHandle, StrPtr(ValueName), TitleIndex, Type1, Data, DataSize

0
 
LVL 8

Author Comment

by:mugman21
ID: 18762698
Thanks for the feed back, but as of now I can't even get a handle. I've been playing around all morning(night) and I'm getting a little frustrated here...

I've found a little unrelated code out there, my newest incarnation to try and get a handle is:
----------------------------------------------------------------------------------

Private Const CP_UTF8 = 65001
Private Const CP_THREAD_ACP = 3
Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_SET_VALUE = &H2
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_CREATE_LINK = &H20
Private Const SYNCHRONIZE = &H100000
Private Const REG_OPTION_NON_VOLATILE = 0       ' Key is preserved when system is rebooted
Private Const REG_SZ = 1                         ' Unicode nul terminated string
Private Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))
Private Const OBJ_CASE_INSENSITIVE = &H40

Private Type UNICODE_STRING
   Length As Integer
   MaxLength As Integer
   Buffer As String
End Type

Private Type OBJECT_ATTRIBUTES
   Length As Long
   RootDirectory As Long
   ObjectName As Long
   Attributes As Long
   SecurityDescriptor As Long
   SecurityQOS As Long
End Type

Private Declare Function NtCreateKey Lib "ntdll.dll" (KeyHandle As Long, DesiredAccess As Long, _
    ObjectAttributes As OBJECT_ATTRIBUTES, TitleIndex As Long, Class As UNICODE_STRING, _
    CreateOptions As Long, Disposition As Long) As Long

Private Declare Function NtSetValueKey Lib "ntdll.dll" (KeyHandle As Long, ValueName As Long, _
    TitleIndex As Long, Type1 As Long, Data As Long, DataSize As Long) As Long

Private Declare Function NtDeleteKey Lib "ntdll.dll" (KeyHandle As Long) As Long
 
Private Sub Command1_Click()

Dim KeyName As UNICODE_STRING
Dim Attributes As OBJECT_ATTRIBUTES
Dim SoftwareKeyHandle As Long
Dim dispo As Long
Dim test As UNICODE_STRING

With KeyName
.Buffer = "\Registry\Machine\SOFTWARE" & Chr(0)
.MaxLength = Len(.Buffer) * 2
.Length = .MaxLength - 2
End With

With Attributes
.Length = Len(Attributes)
.ObjectName = VarPtr(KeyName)
.Attributes = OBJ_CASE_INSENSITIVE
.SecurityDescriptor = 0&
.RootDirectory = VarPtr(KeyName)
.SecurityQOS = 0&
End With

Status = NtCreateKey(SoftwareKeyHandle, KEY_ALL_ACCESS, Attributes, 0, test, REG_OPTION_NON_VOLATILE, dispo)
Debug.Print Status

End Sub
0
 
LVL 8

Author Comment

by:mugman21
ID: 18762718
In the code above, NtCreateKey is returning 0xc00000d (status invalid parameter).

Thanks
0
Top 6 Sources for Identifying Threat Actor TTPs

Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

 
LVL 3

Expert Comment

by:thomaswright
ID: 18768879
1. Paste the Following Code into a Module:
--------------------------- start of code -------------------------------------

Option Explicit

Public Enum RegistryKeys
  HKEY_CLASSES_ROOT = &H80000000
  HKEY_CURRENT_USER = &H80000001
  HKEY_LOCAL_MACHINE = &H80000002
  HKEY_USERS = &H80000003
  HKEY_CURRENT_CONFIG = &H80000005
  HKEY_DYN_DATA = &H80000006
End Enum

Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const ERROR_SUCCESS = 0&
Public Const REG_SZ = 1
Public Const REG_DWORD = 4
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Public Sub SaveKey(ByVal hKey As RegistryKeys, ByVal strPath As String)
On Error Resume Next
Dim KeyHand As Long
RegCreateKey hKey, strPath, KeyHand
RegCloseKey KeyHand
End Sub
Public Function DeleteKey(ByVal hKey As RegistryKeys, ByVal strkey As String)
On Error Resume Next
RegDeleteKey hKey, strkey
End Function
Public Function DeleteValue(ByVal hKey As RegistryKeys, ByVal strPath As String, ByVal strValue As String)
On Error Resume Next
Dim KeyHand As Long
RegOpenKey hKey, strPath, KeyHand
RegDeleteValue KeyHand, strValue
RegCloseKey KeyHand
End Function
Public Function GetString(ByVal hKey As RegistryKeys, ByVal strPath As String, ByVal strValue As String) As String
On Error Resume Next
Dim KeyHand As Long
Dim datatype As Long
Dim lResult As Long
Dim strBuf As String
Dim lDataBufSize As Long
Dim intZeroPos As Integer
Dim lValueType As Long
RegOpenKey hKey, strPath, KeyHand
lResult = RegQueryValueEx(KeyHand, strValue, 0&, lValueType, ByVal 0&, lDataBufSize)
If lValueType = REG_SZ Then
  strBuf = String(lDataBufSize, " ")
  lResult = RegQueryValueEx(KeyHand, strValue, 0&, 0&, ByVal strBuf, lDataBufSize)
  If lResult = ERROR_SUCCESS Then
    intZeroPos = InStr(strBuf, Chr(0))
    If intZeroPos > 0 Then
      GetString = Left(strBuf, intZeroPos - 1)
    Else
      GetString = strBuf
    End If
  End If
End If
End Function
Public Sub SaveString(ByVal hKey As RegistryKeys, ByVal strPath As String, ByVal strValue As String, ByVal strData As String)
On Error Resume Next
Dim KeyHand As Long
RegCreateKey hKey, strPath, KeyHand
RegSetValueEx KeyHand, strValue, 0, REG_SZ, ByVal strData, Len(strData)
RegCloseKey KeyHand
End Sub
Function GetDWORD(ByVal hKey As RegistryKeys, ByVal strPath As String, ByVal strValueName As String) As Long
On Error Resume Next
Dim lResult As Long
Dim lValueType As Long
Dim lBuf As Long
Dim lDataBufSize As Long
Dim KeyHand As Long
RegOpenKey hKey, strPath, KeyHand
lDataBufSize = 4
lResult = RegQueryValueEx(KeyHand, strValueName, 0&, lValueType, lBuf, lDataBufSize)
If lResult = ERROR_SUCCESS Then
  If lValueType = REG_DWORD Then
    GetDWORD = lBuf
  End If
End If
RegCloseKey KeyHand
End Function
Function SaveDWORD(ByVal hKey As RegistryKeys, ByVal strPath As String, ByVal strValueName As String, ByVal lData As Long)
On Error Resume Next
Dim lResult As Long
Dim KeyHand As Long
RegCreateKey hKey, strPath, KeyHand
lResult = RegSetValueEx(KeyHand, strValueName, 0&, REG_DWORD, lData, 4)
RegCloseKey KeyHand
End Function

----------------------- end of code ----------------------------------------

2. Use this syntax to add a registry entry:
SaveString HKEY_LOCAL_MACHINE, "Software\<Your Software Program  Name>\", "<your key name>", "<your string"


0
 
LVL 8

Author Comment

by:mugman21
ID: 18769339
Thanks Thomas, but I MUST use native api here. Using the w32 api I can't add double nulls to key names.
0
 
LVL 39

Accepted Solution

by:
itsmeandnobodyelse earned 500 total points
ID: 18770098
I don't know whether it solves you problem but the hidden key name definitively is wrong in your code:

>>>> Private Const HiddenKeyNameBuffer As String = "Can't touch me!/0"

In the original C code it is "Can't touch me!\0"  where \ is an escape character what means it is not printed and gives the next char a special meaning. Here '\0' is a binary zero character what makes the trick. If you pass the string not addititionally giving the length including that 0 character the called function would need to determine the string length. It uses strlen function what would look for the first binary zero character in the string assuming that it is the terminator. So, in the case above strlen would return the real length - 1.

Unfortunately my Basic is lousy but maybe it is like

   Private Const HiddenKeyNameBuffer As String = "Can't touch me!"  & Chr$(0);

After that you should check whether the Len function returns the correct length or not. If not you should replace the Len calls by 16 or add 1 wherever the correct length was required.

The above most likely will not solve the access violation problem. That maybe is due to not checking return codes or to providing buffers with buffer len = 0. For my opinion you are using too much the Len function which does not return the size but the string length what might be very different.

Regards, Alex






0
 
LVL 3

Expert Comment

by:thomaswright
ID: 18770213
Maybe this will work for you?  This is how you declare the Unicode in VB:

Declare Sub MySub Lib "x" Alias "MySubW" (ByVal Text As Long)

.. and this this is how you pass the Unicode string:

MySub StrPtr(Text)
0

Featured Post

Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

747 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now