I have the following VB6 code which tries to enumerate registry subkeys. This works on all machines I tried it on, except for one new Windows 7 VM that I'm trying to setup as a dev machine.
This is Windows 7 pro, with all updates made. VB6 with SP6.
The keys that I'm trying to enumerate definitely exist. However, on the new VM I'm getting error 87 - "The parameter is incorrect", when calling RegQueryInfoKey.
Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegQueryInfoKey Lib "advapi32.dll" Alias "RegQueryInfoKeyA" (ByVal hKey As Long, ByVal lpClass As String, lpcbClass As Long, ByVal lpReserved As Long, lpcSubKeys As Long, lpcbMaxSubKeyLen As Long, lpcbMaxClassLen As Long, lpcValues As Long, lpcbMaxValueNameLen As Long, lpcbMaxValueLen As Long, lpcbSecurityDescriptor As Long, lpftLastWriteTime As Any) As Long
Private Sub Command1_Click()
Dim lResult As Long
Dim hKey As Long
Dim cJunk As Long
Dim cNameMax As Long
Dim ft As Currency
lResult = RegOpenKeyEx(&H80000001, "Software\Speedocs\[...]", 0, &H1, hKey)
If (lResult = ERROR_SUCCESS) Then
MsgBox RegQueryInfoKey(hKey, "", cJunk, 0, cJunk, cJunk, cJunk, cJunk, cNameMax, cJunk, cJunk, ft)
End If
End Sub
Just for anyone who ever comes across this: the problem was that VB6 was used in Compatibility Mode (specifically for Windows XP). I am running VB6 on a Windows 7 machine. I remember reading somewhere that VB6 must be used in compatibility mode, and therefore had set it to Windows XP Compatibility. Once I unchecked Compatibility Mode all together, the problem had been solved.
Related
Error 127 is 'ERROR_PROC_NOT_FOUND' ('The specified procedure could not be found').
I'm running on a Windows Server 2016 running Citrix XenApp with Remote Desktop Services. The CryptAcquireContext API is in advapi32.dll. I ran Microsoft's Depends32.exe on it, and the function CryptAcquireContextA and CryptAcquireContextW are definitely in the DLL file. Same error seems to happen with all the crypto api functions. I tested CryptDestroyHash and it also returns an error of 127 (ERROR_PROC_NOT_FOUND).
Here is my C++ code:
HCRYPTPROV hProv = 0;
BOOL bCryptAcquireContext = CryptAcquireContext(&hProv, NULL, MS_ENH_RSA_AES_PROV, PROV_RSA_AES, 0);
dwError = GetLastError();
This C++ does work in an EXE, but if the same code is put into a DLL that is called from VB6, it does not work. It's almost like any vb6 app is blocked from those APIs?
Here is the VB6 code:
Private Declare Function CryptAcquireContext Lib "advapi32.dll" Alias "CryptAcquireContextA" (ByRef phProv As Long, ByVal pszContainer As String, ByVal pszProvider As String, ByVal dwProvType As Long, ByVal dwFlags As Long) As Long
Private Sub Form_Load()
Dim sProvider As String
Dim rv as Long
Dim sContainer As String
Dim m_lProvider As Long
Const PROV_RSA_FULL = 1
Const CRYPT_VERIFYCONTEXT As Long = &HF0000000
Const MS_DEF_PROV As String = "Microsoft Base Cryptographic Provider v1.0"
sProvider = MS_DEF_PROV & vbNullChar
sContainer = vbNullChar
rv = CryptAcquireContext(m_lProvider, 0, MS_ENH_RSA_AES_PROV, PROV_RSA_AES, CRYPT_VERIFYCONTEXT)
dwError = Err.LastDllError
If rv = 0 and dwError <> 127 Then
rv = CryptAcquireContext(m_lProvider, 0&, ByVal sProvider, PROV_RSA_FULL, CRYPT_NEWKEYSET)
End If
End Sub
You're passing a Long to a parameter (pszContainer) you defined to be a string:
Private Declare Function CryptAcquireContext Lib "advapi32.dll" _
Alias "CryptAcquireContextA" _
(ByRef phProv As Long, ByVal pszContainer As String, _
ByVal pszProvider As String, ByVal dwProvType As Long, _
ByVal dwFlags As Long) As Long
rv = CryptAcquireContext(m_lProvider, 0, MS_ENH_RSA_AES_PROV, PROV_RSA_AES, CRYPT_VERIFYCONTEXT)
Try this instead (also for the 2nd call of CryptAcquireContext):
rv = CryptAcquireContext(m_lProvider, vbNullString, MS_ENH_RSA_AES_PROV, PROV_RSA_AES, CRYPT_VERIFYCONTEXT)
I can say that I observed similar issue at a customer machine (error code 127 - ERROR_PROC_NOT_FOUND - set by CryptAcquireContextA Windows API function). Googling led me to the http://tracker.firebirdsql.org/browse/CORE-6154 page where the same issue was discussed. The page said that the issue "was solved Updating Windows Server 2016 with Windows Update". The customer I worked with reported that the issue disappeared after Windows updates were installed.
How can I send a right windows key with Dragon NaturallySpeaking's advanced scripting?
Looking at What is the difference between the commands SendKeys, SendSystemKeys or SendDragonKeys? it doesn't seem possible with SendKeys, SendSystemKeys or SendDragonKeys.
Pressing the right windows key:
' From https://knowbrainer.com/forums/forum/messageview.cfm?catid=3&threadid=3032
' Author: monkey8
' Tested with Dragon NaturallySpeaking 12.5 with Windows 7 SP1 x64 Ultimate
Declare Function keybd_event Lib "user32.dll" (ByVal vKey As _
Long, bScan As Long, ByVal Flag As Long, ByVal exInfo As Long) As Long
Const VK_RWIN = 92
Sub Main
keybd_event(VK_RWIN,0,0,0)
'if you want to send a key while holding down the Windows key then insert the code here
keybd_event(VK_RWIN,0,2,0)
End Sub
Pressing the left windows key:
' From https://knowbrainer.com/forums/forum/messageview.cfm?catid=3&threadid=3032
' Author: monkey8
' Tested with Dragon NaturallySpeaking 12.5 with Windows 7 SP1 x64 Ultimate
Declare Function keybd_event Lib "user32.dll" (ByVal vKey As _
Long, bScan As Long, ByVal Flag As Long, ByVal exInfo As Long) As Long
Const VK_LWIN = 91
Sub Main
keybd_event(VK_LWIN,0,0,0)
'if you want to send a key while holding down the Windows key then insert the code here
keybd_event(VK_LWIN,0,2,0)
End Sub
Useful reference for the keyboard codes: List of Virtual Key Codes (mirror)
Note the Declare stuff has to be ABOVE the Sub Main in your script. Then this is what it will look like if you're using a modifier key:
Declare Function keybd_event Lib "user32.dll" (ByVal vKey As Long, bScan As Long, ByVal Flag As Long, ByVal exInfo As Long) As Long
Const VK_LWIN = 91
Sub Main
keybd_event(VK_LWIN,0,0,0)
SendSystemKeys "{Right}"
keybd_event(VK_LWIN,0,2,0)
I am still supporting and old vb6 application that utilizes GetWindowLong and SetWindowLong to remove the ControlBox at runtime depending on a setting. This works great on all 32-bit systems but when it runs on a 64bit system the main window no longer refreshes properly. The problem seems to be input controls like TextBox, ListBox, or CommandButton. After being covered up by certain windows they don't display until they receive the focus and even then their borders don't show up properly.
I've read the MSDN documentation http://msdn.microsoft.com/en-us/library/ms633591%28v=vs.85%29.aspx that says these functions have been superseded by ...WindowLongPtr functions to be compatible with both 32-bit and 64-bit systems. From everything I've been able to read that is really talking about compiling both 32-bit and 64-bit version instead of running on the different platforms. I've tried changing my declare from
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
To
Public Declare Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongPtrA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongPtrA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
But I get the error "Can't find DLL entry point GetWindowLongPtrA in user32". So I tried leaving the Alias as "...WindowLongA" and that runs and as I would expect doesn't make any difference in the refresh problem.
Has anybody else seen this or have any suggestions.
Here is a sample of how the code is used.
Private Sub Form_Activate()
...
Call SetControlBox(Me.hWnd, DisableFullScreen)
End Sub
Public Sub SetControlBox(ByVal hWnd As Long, ByVal Value As Boolean)
' Set WS_SYSMENU On or Off as requested.
Call FlipBit(hWnd, WS_SYSMENU, Value)
End Sub
Public Function FlipBit(ByVal hWnd As Long, ByVal Bit As Long, ByVal Value As Boolean) As Boolean
Dim nStyle As Long
' Retrieve current style bits.
nStyle = GetWindowLongPtr(hWnd, GWL_STYLE)
' Attempt to set requested bit On or Off,
' and redraw
If Value Then
nStyle = nStyle Or Bit
Else
nStyle = nStyle And Not Bit
End If
Call SetWindowLongPtr(hWnd, GWL_STYLE, nStyle)
Call Redraw(hWnd)
' Return success code.
FlipBit = (nStyle = GetWindowLongPtr(hWnd, GWL_STYLE))
End Function
Public Sub Redraw(ByVal hWnd As Long)
' Redraw window with new style.
Const swpFlags As Long = SWP_FRAMECHANGED Or SWP_NOMOVE Or SWP_NOZORDER Or SWP_NOSIZE
SetWindowPos hWnd, 0, 0, 0, 0, 0, swpFlags
End Sub
Thanks
dbl
Try adding SWP_NOACTIVATE (&H10) bit to your swpFlags constant.
Btw, this redraws non-client area only. A name like RedrawNonclient would make it apparent.
I am trying to modify specific registry keys, but it will only work when I debug the application not after I build it.
I find this very weird so I am turning to you guys for help.
Private 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
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Const BM_CLICK = &HF5
Const REG_DWORD = 4
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const REGKEY = "Software\Microsoft\Windows\CurrentVersion\Policies\system"
Const KEY_WRITE = &H20006
Dim Path As Long
Dim Value As Long
Sub TASK()
On Error GoTo hell:
Value = 1
If RegOpenKeyEx(HKEY_CURRENT_USER, REGKEY, 0, KEY_WRITE, Path) Then Exit Sub
RegSetValueEx Path, NameOfKey, 0, REG_DWORD, Value, Len(Value)
Exit Sub
hell:
MsgBox Err & Error(Err)
End Sub
Sub UAC()
On Error GoTo hell:
Value = 0
If RegOpenKeyEx(HKEY_LOCAL_MACHINE, REGKEY, 0, KEY_WRITE, Path) Then Exit Sub
RegSetValueEx Path, "ConsentPromptBehaviorAdmin", 0&, REG_DWORD, Value, Len(Value)
Exit Sub
hell:
MsgBox Err & Error(Err)
End Sub
I am sure it is just something very small that I am missing.
This may not solve all your issues, but it is something important to consider:
If RegOpenKeyEx(HKEY_LOCAL_MACHINE, REGKEY, 0, KEY_WRITE, Path) Then Exit Sub
You cannot write to HKEY_LOCAL_MACHINE unless you are an Administrator. In XP this will throw an error and fail, I believe. I believe that Vista and Win7 handle this differently. I think in Vista and Win7 the write is virtualized in the user's profile and no error is thrown. The entry is stored not in HKEY_LOCAL_MACHINE but in what is called the Virtual Store. These versions of Windows also can virtualized file access to protected system files through this service.
http://msdn.microsoft.com/en-us/library/windows/desktop/aa965884(v=vs.85).aspx
also #6 in this article...
http://blogs.msdn.com/b/chinmay_palei/archive/2011/01/16/windows-7-application-compatibility-issues-fix-centre.aspx
Is it possible that you have set your VB IDE to run as Administrator? This would cause your debug session to run as Admin, but when you are running the EXE on it's own it would run as user? Either way, this line will definately cause errors for your users.
I have a legacy VB6 executable that runs on Vista. This executable shells out another legacy MFC C++ executable.
In our early Vista testing, this call would display the typical UAC message to get the user's permission before running the second executable. This wasn't perfect, but acceptable. However, it now looks like this call is being completely ignored by the OS.
What can I do to make this call work?
If UAC is disabled on the machine, and the call would have required elevated privileges, then the call to CreateProcess will fail. make sure UAC is enabled.
Additionally, follow the guidelines here for adding a UAC manifest to your program.
There is also some good discussion of the issues and source examples here.
This works well for us under Vista
Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, lpProcessAttributes As Any, lpThreadAttributes As Any, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadId As Long
End Type
Private Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
Dim ProcessInformation As PROCESS_INFORMATION
Dim StartupInformation As STARTUPINFO
Dim ReturnValue As Long
Dim NullString As String
Dim AppPathString As String
StartupInformation.cb = Len(StartupInformation)
ReturnValue = CreateProcess(NullString, AppPathString, ByVal 0&, ByVal 0&, 1&, NORMAL_PRIORITY_CLASS, ByVal 0&, NullString, StartupInformation, ProcessInformation)
'
'If you need to wait for the exe to finish
'
Do While WaitForSingleObject(ProcessInformation.hProcess, 0) <> 0
DoEvents
Loop