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.
Related
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
I am not a VB programmer, let alone a VB3 programmer on a Windows NT.
Everything here is difficult and ackward.
All what I have to do is to get system milliseconds.
So from hereI know that this might be possible.
I therefore added the line:
TimeValue=Gettickcount()
but that function is unknown. So I added (in another part of the code)
Declare Function GetTickCount Lib "kernel32" () As Long
and that apparently works for it compiles. Except for the fact that at the runtime it says:
Kernel32 not found
So I change and write Kernel32 .dll but now it doesn't find the dll
I search the dll on the system, I find it (367kb in C:\WinNt\System32\ ) and copy where the .mak resides but now it shows an
Error in loading dll
Now I really don't know what else to do!
Please note that it is VB3 not VB5 as I wrote in the tag. There just wasn't a VB3 tag.
From https://www.freevbcode.com/ShowCode.asp?ID=6441
I get the solution for VB5-VB6.
Well almost the solution for it shows 1/100 of seconds not really 1/1000 but that is nearly there.
Public Function MyTime() As String
MyTime = Format(Now, "dd-MMM-yyyy HH:nn:ss") & "." & Right(Format(Timer, "#0.00"), 2)
End Function
It should work also on VB3. Give it a try!
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.
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.
For a very long time, when I have an error handler I make it report what Project, Module, and Procedure the error was thrown in. I have always accomplished this by simply storing their name via constants. I know that in a Class you get the name programmatically with TypeName(Me), but obviously that only gets me one out of three pieces of information and only when I'm not in a "Standard" module.
I don't have a really huge problem with using constants, it's just that people don't always keep them up to date, or worse they copy and paste and then you have the wrong name being reported, etc. So what I would like to do is figure out a way to get rid of the Constants shown in the example, without losing the information.
Option Compare Binary
Option Explicit
Option Base 0
Option Private Module
Private Const m_strModuleName_c As String = "MyModule"
Private Sub Example()
Const strProcedureName_c As String = "Example"
On Error GoTo Err_Hnd
Exit_Proc:
On Error Resume Next
Exit Sub
Err_Hnd:
ErrorHandler.FormattedErrorMessage strProcedureName_c, m_strModuleName_c, _
Err.Description, Err.Source, Err.Number, Erl
Resume Exit_Proc
End Sub
Does anyone know ways to for the code to tell where it is? If you can conclusively show it can't be done, that's an answer too:)
Edit:I am also aware that the project name is in Err.Source. I was hoping to be able to get it without an exception for other purposes. If you know great, if not we can define that as outside the scope of the question.
I am also aware of how to get the error line, but that information is of course only somewhat helpful without knowing Module.Procedure.
For the project name, the only way I can think of doing this is by deliberately throwing an error somewhere in Sub Main(), and in the error handling code, save the resulting Err.Source into an global variable g_sProjectName. Otherwise, I seem to remember that there was a free 3rd party DLL called TLBINF32.DLL which did COM reflection - but that seems way over the top for what you want to do, and in any case there is probably a difference between public and private classes. And finally, you could use a binary editor to search for the project name string in your EXE, and then try to read the string from the position. Whilst it is frustrating that the names of every project and code module is embedded in the EXE, there seems to be no predictable way of doing this, so it is NOT recommended.
There are several questions here.
You can get the Project Name by calling App.Name
You cannot get the name of the method you are in. I recommend using the automated procedure templates from MZ Tools, which will automatically put in all the constants you need and your headache will be over.
The last piece is possibly having to know the name of the EXE (or lib) that invoked your ActiveX DLL. To figure this out, try the following:
'API Declarations'
Private Declare Function GetModuleFileName Lib _
"kernel32" Alias "GetModuleFileNameA" (ByVal _
hModule As Long, ByVal lpFileName As String, _
ByVal nSize As Long) As Long
Private Function WhosYourDaddy() As String
Dim AppPath As String
Const MAX_PATH = 260
On Error Resume Next
'allocate space for the string'
AppPath = Space$(MAX_PATH)
If GetModuleFileName(0, AppPath, Len(AppPath)) Then
'Remove NULLs from the result'
AppPath = Left$(AppPath, InStr(AppPath, vbNullChar) - 1)
WhosYourDaddy = AppPath
Else
WhosYourDaddy = "Not Found"
End If
End Function
Unfortunately, you'll need to have individual On Error GoTo X statements for individual modules and procedures. The project is always stored in Err.Source. The VBA error handling isn't all that great in this area -- after all, how much good does the project name as the source of the error, as opposed to procedure/module, do you.
If you manually or programatically number your lines (like old-school BASIC), you can use ERL to list the line number the error occurred on. Be warned, though, that an error that occurs on a line without a number will make ERL throw its own error, instead of returning a zero. More information can be found at this blog post.
If you're using Access 2007 (not sure about other Office apps/versions), try this code snippet dug out of the help documentation:
Sub PrintOpenModuleNames()
Dim i As Integer
Dim modOpenModules As Modules
Set modOpenModules = Application.Modules
For i = 0 To modOpenModules.Count - 1
Debug.Print modOpenModules(i).Name
Next
End Sub
And Microsoft includes these remarks:
All open modules are included in the
Modules collection, whether they are
uncompiled, are compiled, are in
break mode, or contain the code
that's running.
To determine whether an individual
Module object represents a standard
module or a class module, check the
Module object's Type property.
The Modules collection belongs to the
Microsoft Access Application object.
Individual Module objects in the
Modules collection are indexed
beginning with zero.
So far, I haven't been able to find anything on referencing the current Project or Procedure. but this should point you in the right direction.
I suggest you take a look at CodeSMART for VB6, This VB6 addin has a customizable Error Handling Schemes Manager, with macros that will insert strings for module name, method name, etc., into your error handling code with a single context menu selection.
Has some other very nice features as well - a Find In Files search that's superior to anything I'd seen till ReSharper, a Tab Order designer, and much more.
At my previous employer, we used this tool for many years, starting with the 2005 version. Once you get used to it,it's really hard to do without it.