Error when reading registry with Visual Basic 6 running on Win7 - vba

I have inherited a VB6 application from a friend of a family member, who wants to have some enhancements done to it.
I haven’t developed in VB for more than 3 years (I’m currently developing in MS Dynamics Ax).
I’ve recently upgraded my hardware and am now running Win7. The last time I worked with the app (about a year and a half ago) was on a WinXP platform, and everything worked fine. Now when I run the app (through code) on Win7, I get an error when trying to read from the registry.
Yes, I am running VB as administrator.
The code to read from the registry is:
Public Function sReadRegistry(ByVal hKeyRoot As Long, _
ByVal sSubKey As String, _
ByVal sValueName As String) As String
Dim r As Long
Dim sData As String * 255
Dim lDataSize As Long
Dim sTempVal As String
Dim readValue As String
lDataSize = 255
'Get the Value Requested
lDataSize = 255
r = VRegReadString(hKeyRoot, sSubKey, sValueName, sData, lDataSize)
If r Then
sTempVal = ""
Else
sTempVal = Left$(sData, lDataSize - 1)
End If
sReadRegistry = sTempVal
End Function
The “VRegReadString “ is declared within a module; and is declared as follows:
Declare Function VRegReadString Lib "VREG" (ByVal hKeyRoot As Long, ByVal sSubKey As String, ByVal sValueName As String, ByVal sData As String, ByRef lDataSize As Long) As Long
It complains about the “VREG” library…
The error I get is: “File not found: VREG”.
Is there a reference or component that I forgot to select? Can somebody please help with a solution?
Thanks in advance.

Seeing that the function declaration is an import from an external library called "VREG", you are probably missing the actual library itself, i.e. VREG.DLL. Unfortunately, this doesn't seem to be a common library, so you'd have to come up with it yourself.
Good news is, though, accessing the registry is not really hard and can be done with just the bare Windows API, especially seeing that VREG.DLL does not really seem to add a good deal of abstraction to the regular API. Take a look at these functions:
Registry Functions
...which you can use to easily re-write registry access, provided you fail to procure the needed DLL from somewhere.

Related

What is the reason that FTD2XX functions do not work in VB.NET after Visual Studio update(?), is there possible fix?

I am developing an app in VB.NET (for a customer with hardware using FTDI USB serial chip. Communication uses FTD2XX library and the respective Nuget package (FTD2XX.Net v1.2.1). After some update of Visual Studio (probably update to 17.1, but I am not sure) all functions except a few stopped working. Current VS version is 17.1.1.
For instance, it is possible to obtain number of devices attached by the FTDI driver:
Friend Declare Function FT_CreateDeviceInfoList Lib "FTD2XX.DLL" (ByRef lngNumDevs As Integer) As Integer
...
Dim ftStatus As Integer
Dim numDevices As Integer
ftStatus = FT_CreateDeviceInfoList(numDevices)
In the above snippet ftStatus result = 0 (i.e. OK) and numDevices is set to 1 (correct).
Problem starts when I want to do something serious:
Friend Declare Function FT_GetComPortNumber Lib "FTD2XX.DLL" (ByVal lnghandle As Integer, ByRef lplComPortNumber As Integer) As Integer
Friend Declare Function FT_Open Lib "FTD2XX.DLL" (ByVal iDevice As Integer, ByRef lnghandle As Integer) As Integer
Friend Declare Function FT_Close Lib "FTD2XX.DLL" (ByVal lnghandle As Integer) As Integer
Dim portHandle as Integer
Dim cpNumber as Long
For i% = 0 To 255
ftStatus = FT_Open(i, portHandle)
If ftStatus = FT_OK Then
ftStatus = FT_GetComPortNumber(portHandle, cpNumber)
ftStatus = FT_Close(portHandle)
' here is some non-essential code registering that port at index i% exists...
End If
Next
In the above code, FT_Open returns ftStatus = 0 (FT_OK) and sets a value for portHandle.
However, the next call, FT_GetComPortNumber, returns ftStatus = 1 (FT_INVALID_HANDLE) and the value passed to cpNumber is 0xFFFF (shows as positive, but in fact should be -1, I guess...). What is worse, FT_Close() also returns FT_INVALID_HANDLE and the port remains open. I verified it by trying to open the port from another app - access denied.
Sometimes it seems that FT_Write and FT_Read functions work despite this mess, but in my last try I could not any communication with the hardware at all.
I tried to use System.IO.Ports.SerialPort as possible workaround but that does not work at all. On top of that, I need to use bit-bang on RTS, because it controls supply voltage and reset of the hardware connected to the other side of the FTDI chip. Without possibility to bring RTS down for hundreds of milliseconds and then hold it up all the time I cannot control the hardware. AFAIK System.IO.Ports.SerialPort provides no possibility to do that.
What could be the solution?
After much trial and error, it appears to be a problem in compile configuration.
Open Solution properties Window and click on the Compile tab.
Then click on "Advanced Compile Options"
If the "Remove integer overflow checks" checkbox is not checked, check it!
I have no idea how an integer overflow check can garble a 32-bit number not involved in any arithmetic operation whatsoever, but this is what really happened. I consider this a bug in Visual Basic compiler used in Visual Studio 17.1.6 (and a number of previous versions), but I did not dig deeper in this topic.
#HansPassant writes:
The declarations are wrong, it must be lnghandle As IntPtr. The difference between Integer and IntPtr matter when you run the app in 64-bit mode. Prone to happen when targeting .NETCore, as likely in VS2022.
-- Hans Passant

Winmove() not working with citrix app

I'm back for more help please.
I'm still on the same project as my question a few weeks ago but stuck on another bit.
I have a multiscreen (win 7) set up and am trying to write an application that will start a number of applications and move/resize them in to the correct positions. I'm doing this as a console app in vb.net.
Following the help I received with my last question I can now start up , move , resize, close all the apps I need bar a couple.
Unfortunately I need to run two applications through Citrix.
One is an Excel sheet.
I can find the windows handle for these windows and select them and or close them but MoveWin() or SetWindowPos() doesn't seem to do anything though the title bar of the window I want to move turns blue so I know it is selecting it..
Any assistance would be greatly appreciated.
A section of the code is pasted below. I'm testing this in excel at the moment and I'll port it across to my console app once working...
Thanks...
Public Declare Function SetWindowPos Lib "user32.dll" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Public Const SWP_FRAMECHANGED = &H20 'Fully redraw the window in its new position.
Sub MoveWin()
Dim retval As Long
Dim hwnd As Long
Dim RetWhnd As Long
hwnd = '123456'
retval = SetWindowPos(hwnd, RetWhnd, 0, 0, 600, 400, SWP_FRAMECHANGED) ' Application.hwnd
End Sub
I am not at my home machine, so I cannot confirm this, but I am fairly certain that VB 6 has a tab on the compile dialog (last one perhaps) that has a citrix-related option checkbox. If it's not there, it might be in the project properties.
Just in case this helps someone else. I've contacted the Citrix people and they basically don't know the answer. I at least wanted to know if it was possible. Anyway as far as I can ascertain, the move command doesn't seem to be possible across the Citrix divide. The solution I've come up with is to leave the actual move part of the code in the remotely run app. That is build code in to the apps run through Citrix to look at an ini file on the local machine and receive instructions from it.
This now works great but will only work for apps that either have ability to run a container language or can be wrapped up somehow..

ESSEXCLN.XXL file not found

I am trying to create a macro that connects me to Essbase at the push of a button and am using the syntax found here https://docs.oracle.com/cd/E12825_01/epm.111/esb_client.pdf
I keep getting the error message that Essexcln.xll is not found. Is there any way around this error? I have done a file search on my computer and the file is no where to be found.
This is the full code I am using.
Declare PtrSafe Function EssVConnect Lib "ESSEXCLN.XLL" (ByVal sheetName As Variant, ByVal username As Variant, ByVal password As Variant, ByVal server As Variant, ByVal application As Variant, ByVal database As Variant) As Long
Sub Conn()
X = EssVConnect(Null, "email#email.com", "password", "http:", "h", "hg6")
End Sub
I'm guessing you have Smart View installed, but not the classic Excel add-in, which was the predecessor to Smart View. In order to find that .XLL file, you'll need to install the old add-in. Do note that it is not officially supported anymore. That are equivalent functions in the Smart View plugin that you can use instead. There is at least one alternative to the classic Excel add-in if you are looking for full VBA compatibility: the Dodeca Excel Add-in, although it is not free.

Unable get 600,000 deletion stubs ro purge from database

Update: I have issued a: show database mycleandb.nsf and I can see there are still 835,000 deletion stubs. I can't seem to remove them.
Summary:
We have a large database that we are now ready to start trimming down to a more manageable size.
I deleted the documents, but I am left with a database it appears I can't copy or replicate, receiving error: Unable to extend an ID table - insufficient memory.
Detail:
Current live database has roughly 1,400,000 docs in it, we can immediately reduce it to 650,000. With some further design\ architectural work we can reduce this to 300,000. This web application is clustered on 5 servers, 1 being the application "hub", with 3 HTTP\SSO servers behind a reverse proxy and the 5th server is the access point for external services. The HUB initiates a PUSH\PULL replication (with no document restrictions) every 30mins, logs show no replication errors. Transaction logging is set for Run Time performance on servers, back up is performed on another back server not in cluster. We run daily archiving that archives roughly 1,500 docs a day.
So far, nearly 2 years on, application has run fine...apart from a few nightmares here and there :-). But, we are finally at point we can trim the databases down.
Prior to any work I OS backed up the live DB, and copied it to a test server. On a test server I did a: CL copy mylivedb.nsf mycleandb.nsf
In mycleandb.nsf I then deleted docs to reduce the DB to 650,000 documents.
All I'm after is a new copy, not a replica, see replica issue below, so I issued another command...to give me a new copy without deletion stubs, it's my understanding that a COPY does not copy del' stubs.:
CL copy mycleandb.nsf mycleandbNEW.nsf
...this also ensures that if any rogue replica is out on the network, we don't get allt he docs back in (not all our servers are 8.5.3, so we can't use the Database Property to set a cut off date for deletion stubs)
But I got a: Unable to extend an ID table - insufficient memory.
Tried this:
CL copy mycleandb.nsf mycleandbNEW.nsf REPLICA
...same thing.
Tried steps found here to my mycleandb.nsf:
http://www-01.ibm.com/support/docview.wss?uid=swg21220384
...same thing.
Changed purge interval to 0 days as described here, also set purge date into future:
http://www-01.ibm.com/support/docview.wss?uid=swg21095683
...same thing.
Then ran a:
load compact mycleandb.nsf -B
...same thing.
I have seen this thread here, which is a similar situation, except, we don't have any issues with clustering\ replication...yet!
http://www-10.lotus.com/ldd/nd85forum.nsf/DateAllFlatWeb/74d3e0f5467f843885257aaf0081abe5?OpenDocument
So, I have a DB I have deleted docs from, I can open it, it appears to function, but I can't copy\ replicate it.
Replication\ Cluster Issue:
I have seen this error before: Unable to extend an ID table - insufficient memory...and what I have done, is drop one of our primary servers, OS copy the DB to server with issue, restart.
I have always created new replicas using Admin Client\ Dom console, but in this case, whenever I do it floods the database with documents, but purge intervals are correct on all servers. The new replicas have been created from the HUB server, which initiates PUSH\PULL replication with all the cluster mates every 30mins, so if this was a deletion stub issue, it would manifest itself all the time?
I will NotesPeek it tomorrow to see if any deletion stubs are still there, but I am not sure how to proceed.
Any comments or suggestions gratefully received.
In my experience, the code in Domino that actually purges deletion stubs cannot work when the total number of modified docs + stubs is too high. I think it's probably a limitation that's pretty deep in the Notes API internals, combined with the algorithm that has to be used -- which is to look at all notes modified before the purge interval date -- a potentially very large number.
Your best option may be to make a local non-replica copy and re-deploy.
I researched this a while back. I found some LotusScript code that uses Notes C API calls to purge deletion stubs posted on various blogs. (I think the original code may have come from Rod Whitely, but I'm not sure.) My version code is below.
When run on a database where the total of docs + stubs is somewhere between 2 and 3 million, it gets the "Unable to extend an ID table - insufficient memory". I never did contact IBM support about this, as it was really just a side project for me. I ended up just making non-replica copies of the production databases and then setting the purge interval low enough so that the number of stubs never got too high again.
Declare Private Sub IDDestroyTable Lib wAPIModule Alias "IDDestroyTable" _
( ByVal hT As Long)
Declare Private Function IDScan Lib wAPIModule Alias "IDScan" _
( ByVal hT As Long, ByVal F As Integer, ID As Long) As Integer
Declare Private Function NSFDbOpen Lib wAPIModule Alias "NSFDbOpen" _
( ByVal P As String, hDB As Long) As Integer
Declare Private Function NSFDbClose Lib wAPIModule Alias "NSFDbClose" _
( ByVal hDB As Long) As Integer
Declare Private Function NSFDbGetModifiedNoteTable Lib wAPIModule Alias "NSFDbGetModifiedNoteTable" _
( ByVal hDB As Long, ByVal C As Integer, ByVal S As Currency, U As Currency, hT As Long) As Integer
Declare Private Function NSFNoteDelete Lib wAPIModule Alias "NSFNoteDelete" _
( ByVal hDB As Long, ByVal N As Long, ByVal F As Integer) As Integer
Declare Private Function OSPathNetConstruct Lib wAPIModule Alias "OSPathNetConstruct" _
( ByVal NullPort As Long, ByVal Server As String, ByVal FIle As String, ByVal PathNet As String) As Integer
Declare Private Sub TimeConstant Lib wAPIModule Alias "TimeConstant" _
( ByVal C As Integer, T As Currency)
Function countAndDeleteStubsByOpenDatabase(db As NotesDatabase, deleteFlag As boolean) As Long
If db Is Nothing GoTo bail
Dim forever As Currency
Dim last As Currency
Dim hT As Long
Dim RRV As Long
Dim hDB As Long
Dim path As String
Dim nStubs As Long
Dim ret As integer
On Error GoTo bail
path = Space(1024)
Call OSPathNetConstruct(0, db.Server, db.FilePath, path)
Call NSFDbOpen(path, hDB)
Call TimeConstant(2, forever)
Call NSFDbGetModifiedNoteTable(hDB, &H7FFF, forever, last, hT)
nStubs = 0
ret = IDScan(hT, True, RRV)
While Not (ret = 0)
If RRV < 0 Then
If (deleteFlag = true) Then
NSFNoteDelete hDB, RRV And &H7FFFFFFF, &H0201
End If
nStubs = nStubs + 1
End If
ret = IDScan(hT, False, RRV)
Wend
IDDestroyTable hT
NSFDbClose hDB
If deleteFlag = True Then
Print "Deleted " + CStr(nStubs) + " stubs for " + db.Filepath + " on " + db.Server
Else
Print "Counted " + CStr(nStubs) + " stubs for " + db.Filepath + " on " + db.Server
End If
countAndDeleteStubsByOpenDatabase = nStubs
On Error GoTo 0
Exit Function
bail:
Print "Unexpected error in countAndDeleteStubsByOpenDatabase. Line " + CStr(Erl) + " " + CStr(Err()) + " " + Error(Err())
countAndDeleteStubsByOpenDatabase = 0
End Function
I never tried it, but it also occurred to me that it might be possible to modify this code to just search for the most recent one day's worth of stubs, delete them, then go back one more day and get the most recent stubs, delete those, etc. It might not be all that easy to do in LotusScript, though, given that you have to deal with the C TIMEDATE struc as a Currency field. You might have to do it in C. Of course, deleting the newest stubs first is the exact reverse of what you want to do in practice, but this strategy might work around the limitation on idtables.
http://www.ytria.com/ has a tool ScanEZ that has a function to delete deletion stubs comfortably. I'm not sure if it would help if you're hitting against internal Notes limits as Richard suggested, but it might be worth a try.

VB.NET - Problems with SHQueryRecycleBin

I'm currently working on an application for my personal use. The idea is that you can open it up and reach all kind of stats of your computer (Recycle bin, Drives, Network and much more). Now I was working with the SHQueryRecycleBin from Win API.
Though I have some problems. And I've tried to look over outdated solutions for VB6 or VB.NET solutions that simply didn't work. I used the code reference from this source and to retrieve the size and count of files I used this source.
I put it in an timer, and after those 100 ticks (as I set it) were ran, I got this error:
File I/O of a structure with field 'cbSize' of type 'UInt32' is not valid.
The type of cbSize is UInteger which (apparently) automatic changes to an UInt32 - I think it's based on the system.
You should note that I'm on an Windows 7 x86 (64-bit). If have an solution for this or another piece of code that is easier than use Win API, let me know.
I have looked at the System.Management but wanted an bullet proof code that could interact with most systems.
I don't have vb.net handy to test, but the following code works perfectly well in vb6:
In a module:
Public Type SHRECYCLEBININFO
cbSize As Long
i64Size As Currency
i64NumItems As Currency
End Type
Public Declare Function SHQueryRecycleBin Lib "shell32.dll" Alias "SHQueryRecycleBinA" (ByVal pszRootPath As String, pSHQueryRBInfo As SHRECYCLEBININFO) As Long
And in a form:
Private Sub Command1_Click()
Dim info As SHRECYCLEBININFO
Dim res As Long
info.cbSize = Len(info)
res = SHQueryRecycleBin("C:\", info)
MsgBox "size: " & (info.i64Size * 10000) & " bytes" & vbCrLf & "items: " & (info.i64NumItems * 10000)
End Sub
Note the use of type "currency" - this is because vb6 doesn't have a normal data type for 64-bit integers. Type Currency is using 8 bytes, but keeps 4 decimal places, hence the multiplication by 10000 to get the results.