I'm using this code to enumerate all values in a registry key.
Private ReadOnly HKeyLocalMachine As New IntPtr(-2147483646)
Private Const KeyQueryValueWow64Key As Integer = &H101
Private Const ErrorNoMoreItems As Integer = &H103
Private Const errorSuccess As Integer = &H0
Dim keyHandle As IntPtr = Nothing
RegOpenKeyEx(HKeyLocalMachine, newPath, 0, KeyQueryValueWow64Key, keyHandle)
If keyHandle = Nothing Then
Return "Error accessing registry key"
End If
Dim index As Integer = 0
Dim valueName As New StringBuilder(1000)
Dim valueLenght As UInteger
Dim valueDataLenght As IntPtr
If RegQueryInfoKey(keyHandle, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, valueLenght, valueDataLenght, Nothing, Nothing) = errorSuccess Then
Debug.WriteLine("SUCCESS IN REGQUERYINFOKEY")
End If
Do
returnValue = RegEnumValue(keyHandle, index, valueName, valueLenght, Nothing, Nothing, datalenght, valueDataLenght)
If returnValue = errorSuccess Then
Debug.WriteLine("Success")
End If
index = index + 1
Loop Until returnValue = ErrorNoMoreItems
Here are my API declarations:
<DllImport("advapi32.dll", CharSet:=CharSet.Unicode)> _
Private Shared Function RegOpenKeyEx( _
hKey As IntPtr, _
subKey As String, _
ulOptions As Integer, _
samDesired As Integer, _
ByRef hkResult As IntPtr _
) As Integer
End Function
<DllImport("advapi32.dll", SetLastError:=True)> _
Private Shared Function RegEnumValue( _
ByVal hKey As IntPtr, _
ByVal dwIndex As Integer, _
ByVal lpValueName As StringBuilder, _
ByRef lpcValueName As UInteger, _
ByVal lpReserved As IntPtr, _
ByVal lpType As IntPtr, _
ByVal lpData As IntPtr, _
ByVal lpcbData As IntPtr _
) As Integer
End Function
<DllImport("advapi32.dll")> _
Private Shared Function RegQueryInfoKey( _
hkey As IntPtr, _
ByRef lpClass As StringBuilder, _
ByRef lpcbClass As UInteger, _
lpReserved As IntPtr, _
ByRef lpcSubKeys As UInteger, _
ByRef lpcbMaxSubKeyLen As UInteger, _
ByRef lpcbMaxClassLen As UInteger, _
ByRef lpcValues As UInteger, _
ByRef lpcbMaxValueNameLen As UInteger, _
ByRef lpcbMaxValueLen As IntPtr, _
ByRef lpcbSecurityDescriptor As UInteger, _
lpftLastWriteTime As IntPtr _
) As Integer
End Function
And i'm getting AccessViolationException when i pass the last parameter of RegEnumValue non-null, if i pass a null IntPtr the function succeeds but no data is retrieved, only the name.
I've tried changing the API variables with no luck, the other two functions always succeed.
The reason that the code fails is that you did not initialise valueDataLenght. Incidentally, you mean to name this variable valueDataLength.
You need the IntPtr variable valueDataLength to refer to a DWORD that contains the length of the data buffer. Using IntPtr here makes life difficult for you. I'd declare the parameter like this instead:
ByRef lpcbData As Integer
Related
I wrote a small program in VB .Net to physically sort folder entries on FAT partitions (see http://www.public.bplaced.net). To do this, I use API calls to Kernel32.dll. I open the partition with CreateFileA, use the handle to lock the drive with DeviceIoControl FSCTL_LOCK_VOLUME and then read and write sectors directly with SetFilePointer / ReadFile / WriteFile (synchronous, with NO_BUFFERING).
All works PERFECTLY, except when I use my program with partitions larger than 2147483647 sectors (7FFF FFFF hex), WriteFile reports success but returns (and has) 0 byte written. This is the case no matter which sector I try to write. EVERYTHING else seems to still work as it should (including correct sector reading). When I use PartitionWizard to shrink the partition below the above limit, writing works again.
Question: does ANYBODY have a clue what could cause this strange behavior? My wild guess is that 'something' might interpret a value greater than 7FFF FFFF as 'signed'? Not within my code, the 'total sectors of partition' is not needed anywhere.
A friend also said that when he did something similar with 'streams', writing worked even with a 'large' partition...
I'm a total N00b, I can't even memorize all the terminology (but I still want to program so dearly...), so if you might have an explanation / hint / whatever, please describe it as simple-worded and detailled as possible.
Some code snippets (don't know where to start)... program is compiled for x86 systems. Problem occurs on both Win7 x86 and Win7 x64.
<DllImport("kernel32.dll", ExactSpelling:=True, SetLastError:=True, CharSet:=CharSet.Auto)> _
Public Shared Function DeviceIoControl _
( _
ByVal hDevice As IntPtr, _
ByVal dwIoControlCode As UInteger, _
ByVal lpInBuffer As IntPtr, _
ByVal nInBufferSize As UInteger, _
ByVal lpOutBuffer As IntPtr, _
ByVal nOutBufferSize As UInteger, _
ByRef lpBytesReturned As UInteger, _
ByVal lpOverlapped As IntPtr _
) _
As Integer
End Function
Public Declare Function CreateFile Lib "kernel32" _
Alias "CreateFileA" ( _
ByVal lpFileName As String, _
ByVal dwDesiredAccess As Int32, _
ByVal dwShareMode As Int32, _
ByVal lpSecurityAttributes As IntPtr, _
ByVal dwCreationDistribution As Int32, _
ByVal dwFlagsAndAttributes As Int32, _
ByVal hTemplateFile As Int32 _
) _
As IntPtr
Public Declare Function SetFilePointer Lib "kernel32" _
( _
ByVal hFile As IntPtr, _
ByVal lpDistanceToMove As UInt32, _
ByRef lpDistanceToMoveHigh As Int32, _
ByVal dwMoveMethod As UInt32 _
) _
As UInt32
Public Declare Function WriteFile Lib "kernel32" _
( _
ByVal hFile As IntPtr, _
ByVal lpBuffer As Byte(), _
ByVal nNumberOfBytesToWrite As Int32, _
ByRef lpNumberOfBytesWritten As Int32, _
ByVal lpOverlapped As IntPtr _
) _
As Boolean
' **********************************************************
' open the partition by drive letter
devicehandle = CreateFile( _
"\\.\" & driveletter & ":", _
GENERIC_READ Or GENERIC_WRITE, _
FILE_SHARE_READ Or FILE_SHARE_WRITE, _
IntPtr.Zero, _
OPEN_EXISTING, _
FILE_ATTRIBUTE_NORMAL Or FILE_FLAG_NO_BUFFERING, _
0 _
)
' **********************************************************
' lock the partition
Dim unused_lv As UInteger
Dim locked As Integer = DeviceIoControl( _
devicehandle, _
FSCTL_LOCK_VOLUME, _
IntPtr.Zero, _
0, _
IntPtr.Zero, _
0, _
unused_lv, _
IntPtr.Zero _
)
' **********************************************************
' set the file pointer, sector = sector to read, bytes_per_sector = 512. I use Bitconverter to get the hi and lo DWORDs
Dim s_bytes() As Byte = BitConverter.GetBytes(sector * bytes_per_sector)
' Hi-DWORD
Dim byte_dist_high As Int32 = BitConverter.ToInt32(s_bytes, 4) ' byte 4 - 7
' Lo-DWORD
Dim byte_dist_low As UInt32 = BitConverter.ToUInt32(s_bytes, 0) ' byte 0 - 3
' move file pointer
Dim move As UInt32 = SetFilePointer( _
devicehandle, _
byte_dist_low, _
byte_dist_high, _
FILE_BEGIN _
)
' **********************************************************
' write a sector
Dim write As Boolean = WriteFile( _
devicehandle, _
buffer, _
bytes_per_sector, _
bytes_written, _
IntPtr.Zero _
)
If write = False Then
Return False
Else
Return True
End If
I have the Problem that my script writes only the default value to the new Ini-File. It sould read the value from the BackupConfig. I do not see my error, yet. The output of the MessageBox should be the old URL but it prints google.
I hope you can help me, thank you.
My script looks like this
My.Computer.FileSystem.MoveFile(ConfigName, "backup.Config.ini", True)
Thread.Sleep(2000)
Dim Config As IniFile = New IniFile(ConfigName)
Dim BackupConfig As IniFile = New IniFile("backup.Config.ini")
MessageBox.Show(BackupConfig.GetString("Window08", "Url", "http://google.de"))
Config.WriteInteger("Setup", "Opacity", BackupConfig.GetInteger("Setup", "Opacity", 100))
This is my IniFile Class, i found it here on Stackoverflow an do not know which user posted it. (Sorry for that)
Public Class IniFile
' API functions
Private Declare Ansi Function GetPrivateProfileString _
Lib "kernel32.dll" Alias "GetPrivateProfileStringA" _
(ByVal lpApplicationName As String, _
ByVal lpKeyName As String, ByVal lpDefault As String, _
ByVal lpReturnedString As System.Text.StringBuilder, _
ByVal nSize As Integer, ByVal lpFileName As String) _
As Integer
Private Declare Ansi Function WritePrivateProfileString _
Lib "kernel32.dll" Alias "WritePrivateProfileStringA" _
(ByVal lpApplicationName As String, _
ByVal lpKeyName As String, ByVal lpString As String, _
ByVal lpFileName As String) As Integer
Private Declare Ansi Function GetPrivateProfileInt _
Lib "kernel32.dll" Alias "GetPrivateProfileIntA" _
(ByVal lpApplicationName As String, _
ByVal lpKeyName As String, ByVal nDefault As Integer, _
ByVal lpFileName As String) As Integer
Private Declare Ansi Function FlushPrivateProfileString _
Lib "kernel32.dll" Alias "WritePrivateProfileStringA" _
(ByVal lpApplicationName As Integer, _
ByVal lpKeyName As Integer, ByVal lpString As Integer, _
ByVal lpFileName As String) As Integer
Dim strFilename As String
' Constructor, accepting a filename
Public Sub New(ByVal Filename As String)
strFilename = Filename
End Sub
' Read-only filename property
ReadOnly Property FileName() As String
Get
Return strFilename
End Get
End Property
Public Function GetString(ByVal Section As String, _
ByVal Key As String, ByVal [Default] As String) As String
' Returns a string from your INI file
Dim intCharCount As Integer
Dim objResult As New System.Text.StringBuilder(256)
intCharCount = GetPrivateProfileString(Section, Key, _
[Default], objResult, objResult.Capacity, strFilename)
If intCharCount > 0 Then GetString = _
Left(objResult.ToString, intCharCount)
End Function
Public Function GetInteger(ByVal Section As String, _
ByVal Key As String, ByVal [Default] As Integer) As Integer
' Returns an integer from your INI file
Return GetPrivateProfileInt(Section, Key, _
[Default], strFilename)
End Function
Public Function GetBoolean(ByVal Section As String, _
ByVal Key As String, ByVal [Default] As Boolean) As Boolean
' Returns a boolean from your INI file
Return (GetPrivateProfileInt(Section, Key, _
CInt([Default]), strFilename) = 1)
End Function
Public Sub WriteString(ByVal Section As String, _
ByVal Key As String, ByVal Value As String)
' Writes a string to your INI file
WritePrivateProfileString(Section, Key, Value, strFilename)
Flush()
End Sub
Public Sub WriteInteger(ByVal Section As String, _
ByVal Key As String, ByVal Value As Integer)
' Writes an integer to your INI file
WriteString(Section, Key, CStr(Value))
Flush()
End Sub
Public Sub WriteBoolean(ByVal Section As String, _
ByVal Key As String, ByVal Value As Boolean)
' Writes a boolean to your INI file
WriteString(Section, Key, CStr(CInt(Value)))
Flush()
End Sub
Private Sub Flush()
' Stores all the cached changes to your INI file
FlushPrivateProfileString(0, 0, 0, strFilename)
End Sub
End Class
I have the below code to load an icon using Shell32 dll. It works fine on my machine. But one of the systems in production environment got an exception saying "System.ArgumentException: Win32 handle that was passed to Icon is not valid or is the wrong type".
Any idea why we get this error? Thank you!
Public Function GetExecutableIcon() As Icon
Dim large As IntPtr
Dim small As IntPtr
ExtractIconEx(Application.ExecutablePath, 0, large, small, 1)
Return Icon.FromHandle(small)
End Function
<DllImport("Shell32")> _
Public Shared Function ExtractIconEx(ByVal sFile As String, ByVal iIndex As Integer,
ByRef piLargeVersion As IntPtr, ByRef piSmallVersion As IntPtr,
ByVal amountIcons As Integer) As Integer
End Function
Try this:
<DllImport("Shell32")> _
Public Shared Function ExtractIconEx(ByVal sFile As String, ByVal iIndex As Integer,
ByRef piLargeVersion As IntPtr, ByRef piSmallVersion As IntPtr,
ByVal amountIcons As Integer) As Integer
Public Function GetExecutableIcon() As Icon
Dim num As Integer = 10
Dim large(num - 1) As IntPtr
Dim small(num - 1) As IntPtr
ExtractIconEx("C:\Windows\System32\Shell32.dll", 0, large(0), small(0), num)
Return Icon.FromHandle(small(6)) 'change the index accordingly
End Function
Is your declaration correct? http://www.pinvoke.net/default.aspx/shell32.ExtractIconEx shows
<DllImport("shell32.dll", CharSet:=CharSet.Auto)> _
Shared Function ExtractIconEx(ByVal szFileName As String, _
ByVal nIconIndex As Integer, _
ByVal phiconLarge() As IntPtr, _
ByVal phiconSmall() As IntPtr, _
ByVal nIcons As UInteger) As UInteger
End Function
I currently have it defined as
Private Declare Function ReadProcessMemory1 Lib "kernel32" Alias "ReadProcessMemory" (ByVal hProcess As IntPtr, ByVal lpBaseAddress As Integer, ByRef lpBuffer As Integer, ByVal nSize As Integer, ByRef lpNumberOfBytesWritten As Integer) As Integer
and I have another declaration for each type.
I'm trying to use this instead
<DllImport("kernel32.dll", SetLastError:=True)> _
Public Shared Function ReadProcessMemory( _
ByVal hProcess As IntPtr, _
ByVal lpBaseAddress As Integer, _
<Out()> ByRef lpBuffer As Byte(), _
ByVal dwSize As Integer, _
ByRef lpNumberOfBytesRead As Integer) As Boolean
End Function
Which is off pvinvoke.net, heres how I'm trying to use it:
Public Shared Function Int(address As Integer)
Dim buffer(3) As Byte
ReadProcessMemory(pHandle, address, buffer, 4, 0)
Return BitConverter.ToInt32(buffer, 0)
End Function
This errors and says Attempt to read or write protected memory, but I use the old RPM declaration I have like this and it works fine.
Public Shared Function Int(address As Integer)
Dim buffer As Integer
ReadProcessMemory(pHandle, address, buffer, 4, 0)
Return buffer
End Function
What am I doing wrong?
Your p/invoke declaration is wrong. It should be:
<DllImport("kernel32.dll", SetLastError:=True)> _
Public Shared Function ReadProcessMemory( _
ByVal hProcess As IntPtr, _
ByVal lpBaseAddress As IntPtr, _
<Out()> ByVal lpBuffer As Byte(), _
ByVal dwSize As IntPtr, _
ByRef lpNumberOfBytesRead As IntPtr) As Boolean
End Function
I have been using the standard password textbox written by Daniel Klann (http://www.ozgrid.com/forum/showthread.php?t=72794) to hide the password inputs.
The main problem is that the standard InputBox returns empty fields and cancel the same way. Application.InputBox however is capable of returning a False on cancel.
Updating Daniel Klann's script to work with the Application.InputBox is beyond me. How would this be done?
Here is Daniel's code:
Option Explicit
'////////////////////////////////////////////////////////////////////
'Password masked inputbox
'Allows you to hide characters entered in a VBA Inputbox.
'
'Code written by Daniel Klann
'http://www.danielklann.com/
'March 2003
'// Kindly permitted to be amended
'// Amended by Ivan F Moala
'// http://www.xcelfiles.com
'// April 2003
'// Works for Xl2000+ due the AddressOf Operator
'////////////////////////////////////////////////////////////////////
'******************** CALL FROM FORM *********************************
' Dim pwd As String
'
' pwd = InputBoxDK("Please Enter Password Below!", "Database Administration Security Form.")
'
' 'If no password was entered.
' If pwd = "" Then
' MsgBox "You didn't enter a password! You must enter password to 'enter the Administration Screen!" _
' , vbInformation, "Security Warning"
' End If
'**************************************
'API functions to be used
Private Declare Function CallNextHookEx _
Lib "user32" ( _
ByVal hHook As Long, _
ByVal ncode As Long, _
ByVal wParam As Long, _
lParam As Any) _
As Long
Private Declare Function GetModuleHandle _
Lib "kernel32" _
Alias "GetModuleHandleA" ( _
ByVal lpModuleName As String) _
As Long
Private Declare Function SetWindowsHookEx _
Lib "user32" _
Alias "SetWindowsHookExA" ( _
ByVal idHook As Long, _
ByVal lpfn As Long, _
ByVal hmod As Long, _
ByVal dwThreadId As Long) _
As Long
Private Declare Function UnhookWindowsHookEx _
Lib "user32" ( _
ByVal hHook As Long) _
As Long
Private Declare Function SendDlgItemMessage _
Lib "user32" Alias "SendDlgItemMessageA" ( _
ByVal hDlg As Long, _
ByVal nIDDlgItem As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) _
As Long
Private Declare Function GetClassName _
Lib "user32" _
Alias "GetClassNameA" ( _
ByVal hWnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) _
As Long
Private Declare Function GetCurrentThreadId _
Lib "kernel32" () _
As Long
'Constants to be used in our API functions
Private Const EM_SETPASSWORDCHAR = &HCC
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5
Private Const HC_ACTION = 0
Private hHook As Long
Public Function NewProc(ByVal lngCode As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Dim RetVal
Dim strClassName As String, lngBuffer As Long
If lngCode < HC_ACTION Then
NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)
Exit Function
End If
strClassName = String$(256, " ")
lngBuffer = 255
If lngCode = HCBT_ACTIVATE Then 'A window has been activated
RetVal = GetClassName(wParam, strClassName, lngBuffer)
If Left$(strClassName, RetVal) = "#32770" Then 'Class name of the Inputbox
'This changes the edit control so that it display the password character *.
'You can change the Asc("*") as you please.
SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0
End If
End If
'This line will ensure that any other hooks that may be in place are
'called correctly.
CallNextHookEx hHook, lngCode, wParam, lParam
End Function
'// Make it public = avail to ALL Modules
'// Lets simulate the VBA Input Function
Public Function InputBoxDK(Prompt As String, Optional Title As String, _
Optional Default As String, _
Optional Xpos As Long, _
Optional Ypos As Long, _
Optional Helpfile As String, _
Optional Context As Long) As String
Dim lngModHwnd As Long, lngThreadID As Long
'// Lets handle any Errors JIC! due to HookProc> App hang!
On Error Goto ExitProperly
lngThreadID = GetCurrentThreadId
lngModHwnd = GetModuleHandle(vbNullString)
hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)
If Xpos Then
InputBoxDK = InputBox(Prompt, Title, Default, Xpos, Ypos, Helpfile, Context)
Else
InputBoxDK = InputBox(Prompt, Title, Default, , , Helpfile, Context)
End If
ExitProperly:
UnhookWindowsHookEx hHook
End Function
the standard InputBox returns empty fields and cancel the same way
No it does not. It returns a null pointer (vbNullString) on cancel and an empty string ("") for empty input.
Dim s As String
s = InputBox("Test")
If StrPtr(s) = 0 Then
'Cancel pressed
Else
'Ok pressed
End If
Because InputBoxDK returns the InputBox's value unchanged, same logic applies to it.