Quantcast
Channel: VBForums - CodeBank - Visual Basic 6 and earlier
Viewing all 1484 articles
Browse latest View live
↧

Array Information

March 17, 2022, 6:24 pm
$
0
0
Below is a follow-up for a discussion here on vbForums.

Every array in VB is managed by VB through the use of a SFAEARRAY as defined here by Microsoft as part of Windows. Each array is assigned a SAFEARRAY structure when it is created. The SAFEARRAY contains information on the array itself, not the contents of the array. This structure contains everything needed for VB manage the array including the number of dimensions, byte size of the elements in the array, how many references have been made to the array, the lower bound of each dimension and the number of elements in the dimension and the location in memory of the data in the array.


Once an array has been dimensioned with DIM, this SAFEARRAY also contains a flag that says it cannot be ReDim'd. On the other hand, if the array is declared in the DIM statement without array dimension and bounds, it can be ReDim'd as often as needed during the program’s life. An array with its bounds set by Dim statement are called static arrays and those that have their bounds set via ReDim are called dynamic arrays.

Other than the flag telling VB that it is a static array and can’t be re-dimensioned, these types of arrays use the same SAFEARRAYs.

Many types of arrays are possible: Byte, Integer, Long, Single, Double, Date, Currency, Boolean, String and Object. In VBA for office 2010+ there can also be LongLong arrays when running in a 64-bit host like Excel. In Office 2010+ arrays can be declared as LongPtr but during run-time those are set to 32-bit if the host is 32-bit or LongLong if the host is 64-bit.

Other than Variants, all arrays are of fixed element size (a Variant can re-used as a single value or a different type of array or even arrays within arrays). An array can contain a large number of Longs, for example, but it cannot have Longs and Strings in the same array.

A Variant doesn’t have to be an array but it can be. Strangely, any member of a Variant array itself can be an array of any type, including more Variants.

VB provides almost all of the tools required to work with arrays in its native language so we normally don’t have to be concerned with the SAFEARRAY structure. You can access individual elements of an array by specifying the subscripts. You can make an array virtually any size you want and you can set the lower bound to start with anything you want (doesn’t have to be 0).

However, there are a few limitations that are problematic. A dynamic array might have one or more dimensions assigned to it or it might be uninitialized (occurs initially during a run and after an Erase statement). There are no VB methods to find out this information. The standard way of dealing with this is to just try to use it and if it is uninitialized it will raise an error that you can catch and deal with.

Also, you can’t determine at any point in time how many dimensions the dynamic array has, if any. Once you know the number of dimensions you can use LBound and UBound to determine the bounds of each array. Again, the only way to find out is to attempt to use it and catch the error VB raises.

So for many years most of us have used a function that returns the number of dimensions. Under the hood, this function finds the location of the SAFEARRAY and it reads the first 2 bytes which contain the number of dimensions for the array (0 if uninitialized). So you are probably accessing the SAFEARRAYs of some of your arrays without even knowing it.

There is a problem with the routines I have seen and used for this. They all use a passed parameter that is a Variant. Strangely enough, VB allows you to basically use any variable for the Variant parameter to a procedure and if it is not a Variant, VB makes a copy of it (such as a Long array) and wraps it up in a Variant structure for that procedure. So you can be wasting a lot of memory and time to make a copy of the non-Variant array just so VB can pass a Variant to the function you use to get the number of dimensions. So I wrote a set of functions that you can use for any type of VB array to find out how many dimensions it has and optionally, all of the rest of the information contained in its SAFEARRAY. It is much faster and efficient that the variant type (I have a function for Variants too) because it uses a reference to the array and does not have to copy it into a Variant.

You would think that it would be possible to pass the name of any kind of array to a function and have it figure out all of the array parameters. But no, in every VB procedure you have to declare the Type of each parameter passed to/from the procedure. So if I have an array called “anArray” that is an array of Longs, I can send it only to a Sub or Function that has “xxx() as Long” as a parameter. That makes things somewhat more complex. All I really need to know about the array is the internal location of the array (a pointer, I know, VB doesn’t do pointers…). Even worse, although VB has functions for pointers to Strings, regular variables and objects, it does not have a function for the address of an array. So we play a game and re-use the VarPtr function (a function that returns the address of a regular variable) and I Alias it to something I call “VarPtrArray” and have that tell us the address of the array, not a regular variable.

So each of the Functions I am providing just calls another routine I wrote that does the actual getting of the array information and passes the address of the array to it. So if you want to skip all of the individual type functions (one for a Byte array, one for a Long array, etc.) you can just call the main function (“GetArrayDims” and pass it the address of your array such as “VarPtrArray(anArray)”. Since that’s not normal VB language, I provided all of those other functions for you that use the more conventional name and type of the array. Either way works.

The same set of functions work in VB6, 32-bit VBA and 64-bit VBA. Note that the function LongPtrNumDims is not available if you are running VB6 or Office pre-2010 because the LongPtr type did not exist in those. Also, LongLongNumDims is only available if you’re running 64-bit Office for the same reason.

There is a function (VarNumDims) that determines if a variant is an array and if so, returns the exact same information as the other array info routines. Note that it is possible that the Variant doesn’t contain an array in which case it returns -1 instead of 0 or more dimensions.

I wrote these for 2 reasons: 1) I wanted a more efficient way of getting the number of dimensions than using the one with passing a copy of my array through a Variant, and 2) I am working on a set of routines that lets you move whole variables and UDT’s between programs or to/from files and I needed to transfer a whole array at one time so I needed to know the memory address of the data block so I can copy it in one move. More on this later.

Functions
VarNumDims – for Variants
ByteNumDims – for Byte arrays
IntNumDims – for integer arrays
LongNumDims –for Long arrays
SingleNumDims – for Single arrays
DoubleNumDims – for Double arrays
DateNumDims – for Date arrays
CurrNumDims – for Currency arrays
BoolNumDims – for Boolean arrays
StringNumDims – for String arrays
LongPtrNumDims – for LongPtr arrays (only on VBA7, i.e., Office 2010+)
LongLongNumDims – for LongLong arrays (only on VBA7 and running 64-bit)
ObjNumDims – for Object arrays
GetArrayDims - All of the above functions except StringNumDims call this one. It can also be called directly by all except Variants and String arrays. Instead of calling this with an array type you call it with VarPtrArray(array) which is what the above functions do anyway. Be careful not to give VarPtrArray a non-array variable; it will return the pointer (address) of any variable it is given). Also, do not send a Variant directly to this function since a Variant is laid out in memory differently than other variables including arrays. Use VarNumDims for Variants. There is a third parameter for this function which you should not set yourself. It is set False for all arrays except for a special Variant array (they call it a ByRef Variant array but it is not the same ByRef as in a procedure call).

Return - The number of dimensions in the array.
0 The array has no dimensions. It is uninitialized (start of run or Erase’d).
>0 The number of dimensions in the array.
-1 Only for a Variant. The Variant is not an array.

Caution – The functions give a snapshot of the array at the time you execute the function. It isn’t dealing with the data in the array but only the structure of the array. This structure information is accurate until the variable goes out of scope and is deleted or the array is Redim’d or Erase’d. As the programmer, you are in charge of ReDim’s so you can re-run any of the functions as needed. Just know the data are not live but are a snapshot in time.

Optional parameter “GetExtraInfo” – Defaults to False but if set True, generates more info about he specified array. There is a Public User Defined Type (UDT) called tArrayInfo and a Public variable called “ArrayInfo” of this type that is discussed below. Some data can always be found in this variable after one of these function calls (taken from the array’s SAFEARRAY) and there are a few more things you can obtain by calling one fo the functins with GetExtraInfo = True.

Public Type tArrayInfo - see variable ArrayInfo just below this that uses this Type
Size As Long ' Extra info, size of data ni the array
NumElements As Long ' Extra Info, Number of elements in all array dimenstions
Bounds() As Long – Extra Info, pairs of Lower/Upper bounds, # pairs = # Dims
Example- Dim a(1 to 2, 0 to 4, 99 to 100) is put in pairs in this order 99,100,0,4,1,2
cDims As Integer - The number of dimensions
Features As Integer – Combination of the following possibilities
0x0001 Array is allocated on the stack.
0x0002 Array is statically allocated.
0x0004 Array is embedded in a structure.
0x0010 Array may not be resized or reallocated.
0x0020 The SAFEARRAY MUST contain elements of a UDT.
0x0040 The SAFEARRAY MUST contain MInterfacePointers elements.
0x0080 An array that has a variant type.
0x0100 An array of BSTRs.
0x0200 An array of IUnknown*.
0x0400 An array of IDispatch*.
0x0800 An array of VARIANTs.
0xF0E8 Bits reserved for future use.
ElementSize As Long - The size of a single element
cLocks As Long - Number of locks on the array
pvData As Long/LongLong - Pointer to the array data.

The Public variable ArrayInfo is of the above type. Obviously, the values in the variable only mean something if it’s an array (variant might not be) and the array has dimensions. It made more sense to me to re-use this public variable for each of the functions rather than having a bunch of variables of this type. If for some reason you need more than one of these at the same time you can easily declare another variable of the same type and copy ArrayInfo as needed.

None of the code provided needs to be modified for your use. I have a master library of procedures I use all the time and I have incorporated this code into my library. You can do the same or you can leave it in its own .bas module as it is now.

I have included sample programs for VB6 program as well as Excel file. Hopefully everything is clear. If not, please let me know.

Update to v1.1.0 - See posts #5 and #6 below. Apparently VB handles String arrays differently so I modified my routine for getting array info for strings. Note that the old way works for static string arrays (one where the number of arrays and lower/upper bounds are set with a Dim statement instead of a ReDim statement).
Attached Files
↧
Search

delete this post

March 23, 2022, 11:24 am
↧
↧

VB6 nestable UDT-based Node-Class with fast teardown

March 23, 2022, 2:51 pm
$
0
0
Not much to it, just a Demo for an UDT-based cNode-Class,
which can be extended (by adding Fields to the Class-internal UDT).

This Node-Class is "self-contained" (no extra-modules are needed).

Performance is quite good... adding 1,001,000 Nodes total as 1000ChildNodes on 1000ChildNodes takes:
- about 0.33sec in the IDE
- about 0.22sec native compiled (all Options)

cNode will hand out "dynamically created wrapper instances of itself -
(using internal Indexes which point into the Root-UDT-Array)", on all cNode-returning Properties, which are:
- Root() As cNode
- Parent() As cNode
- NodeById(ByVal ID As Long) As cNode
- Child(ByVal IdxZeroBased As Long) As cNode
- FirstChild() As cNode
- NextSibling() As cNode
- PrevSibling() As cNode
- LastChild() As cNode


cNode
Code:
Option Explicit

Private Declare Sub AssignArrTo Lib "kernel32" Alias "RtlMoveMemory" (pDst() As Any, pSrc() As Any, Optional ByVal CB& = 4)

Private Type tNode
  PIdx As Long
  ChCount As Long
  ChIdxs() As Long
  'define UserData-NodeProps from here onwards...
  Text As String
  '... a.s.o. (see the Prop-Mapping-Section at the end of this Class)
End Type

'we need only 3 Private Vars to present a Node-instance
Private mIdx As Long, mNodes() As tNode, mInternalInstance As Boolean

Private Sub Class_Initialize()
  ReDim mNodes(0)
End Sub
Private Sub Class_Terminate() 'cleanup the fake arr-reference...
  Dim aNull(): If mInternalInstance Then AssignArrTo mNodes, aNull '...but only when created internally here
End Sub

Public Sub AddNode(Text As String) 'for best add-performance, include all the (UDT-)Prop-Values as Params here
  Dim UB As Long, CC As Long
      UB = UBound(mNodes)
 
  CC = -mNodes(0).PIdx + 1: mNodes(0).PIdx = -CC '<- mNodes(0).PIdx holds the negative, total ChildNode-Count
  If CC >= UB Then ReDim Preserve mNodes(32 + CC * 1.6)
 
 
  With mNodes(CC) 'set the direct UDT-entries of our new ChildNode
    .PIdx = mIdx  '... starting with the ParentIndex (which is the Index of *this* (Parent)Node-instance)
    .Text = Text
    '... a.s.o. for more UDT-Values (see the UDT-def at the top of this Class)
  End With
 
  With mNodes(mIdx) 'also put the right Index-entry into the Child-Array of the UDT for this (Parent)Node-Instance
    If .ChCount = 0 Then ReDim .ChIdxs(4)
    If .ChCount >= UBound(.ChIdxs) Then ReDim Preserve .ChIdxs(.ChCount * 1.6)
    .ChIdxs(.ChCount) = CC 'set the Index of the new Child (CC is equivalent with that)
    .ChCount = .ChCount + 1
  End With
End Sub
 
Friend Sub Init(ByVal Idx As Long, Nodes() As tNode) 'do not call this method from the outside
  mIdx = Idx: mInternalInstance = True 'set the Idx + flag this instance as "internally created"
  Erase mNodes: AssignArrTo mNodes, Nodes 'make a "fake" Array-copy
End Sub

Public Property Get ID() As Long 'to provide a unique Identifier within the Tree for this Node
  ID = mIdx 'on the outside, this is only useful to compare Nodes for identity
End Property

Public Property Get TotalNodeCount() As Long
  TotalNodeCount = -mNodes(0).PIdx
End Property

Public Property Get Level() As Long 'determines the "Hierarchy-Depth" of the current Node
  Dim i As Long: i = mIdx
  Do While i: i = mNodes(i).PIdx: Level = Level + 1: Loop
End Property

Public Property Get Root() As cNode
  Set Root = New cNode: Parent.Init 0, mNodes
End Property
Public Property Get Parent() As cNode
  If mIdx Then Set Parent = New cNode: Parent.Init mNodes(mIdx).PIdx, mNodes
End Property
Public Property Get NodeById(ByVal ID As Long) As cNode
  Set NodeById = New cNode: NodeById.Init ID, mNodes
End Property
Public Property Get Child(ByVal IdxZeroBased As Long) As cNode
  Set Child = New cNode: Child.Init mNodes(mIdx).ChIdxs(IdxZeroBased), mNodes
End Property
Public Property Get ChildCount() As Long
  ChildCount = mNodes(mIdx).ChCount
End Property

Public Property Get FirstChild() As cNode
  If mNodes(mIdx).ChCount = 0 Then Exit Property 'no first Child available here (return Nothing)
  Set FirstChild = New cNode: FirstChild.Init mNodes(mIdx).ChIdxs(0), mNodes
End Property
Public Property Get NextSibling() As cNode
  If mIdx = 0 Then Exit Property 'the Root-Node has no siblings
  With mNodes(mNodes(mIdx).PIdx)
    If .ChCount <= 1 Then Exit Property 'with a ChildCount <=1 there's no next Sibling
    If .ChIdxs(.ChCount - 1) = mIdx Then Exit Property 'the last Child has no next Sibling
    Dim i As Long
    For i = 0 To .ChCount - 2
      If .ChIdxs(i) = mIdx Then Set NextSibling = New cNode: NextSibling.Init .ChIdxs(i + 1), mNodes: Exit For
    Next
  End With
End Property
Public Property Get PrevSibling() As cNode
  If mIdx = 0 Then Exit Property 'the Root-Node has no siblings
  With mNodes(mNodes(mIdx).PIdx)
    If .ChCount <= 1 Then Exit Property 'with a ChildCount <=1 there's no previous Sibling
    If .ChIdxs(0) = mIdx Then Exit Property 'the first Child has no previous Sibling
    Dim i As Long
    For i = 1 To .ChCount - 1
      If .ChIdxs(i) = mIdx Then Set PrevSibling = New cNode: PrevSibling.Init .ChIdxs(i - 1), mNodes: Exit For
    Next
  End With
End Property
Public Property Get LastChild() As cNode
  If mNodes(mIdx).ChCount = 0 Then Exit Property 'no last Child available here (return Nothing)
  Set LastChild = New cNode: LastChild.Init mNodes(mIdx).ChIdxs(mNodes(mIdx).ChCount - 1), mNodes
End Property

'Ok, finally the mapping of (non-navigation-related) UDT-Props to and from the outside
Public Property Get Text() As String
  Text = mNodes(mIdx).Text
End Property
Public Property Let Text(RHS As String)
  mNodes(mIdx).Text = RHS
End Property
Into a Test-Form:
Code:
Option Explicit

Private Root As cNode

Private Sub Form_Click()
  AutoRedraw = True: FontName = "Tahoma": Cls: Tag = Timer
 
  If Root Is Nothing Then
    Set Root = New cNode 'only Root-Nodes are created with the New-Operator (on the outside of cNode)
        Root.Text = "RootNode"
       
    AddChildNodesTo Root, 1000, "ChildLevel1_"
   
    Dim i As Long
    For i = 0 To Root.ChildCount - 1
        AddChildNodesTo Root.Child(i), 1000, "ChildLevel2_"
    Next
   
    Print "Construction-Time:", Format(Timer - Tag, " 0.00sec")
    Print "Total-NodeCount:", Root.TotalNodeCount
    Print "Root-ChildCount:", Root.ChildCount
    Print "ChildCount of a Level1-Child:  "; Root.FirstChild.ChildCount
    Print "ChildCount of a Level2-Child:  "; Root.FirstChild.FirstChild.ChildCount
    Print "Level-PrintOut:", Root.Level; Root.LastChild.Level; Root.LastChild.LastChild.Level
    With Root.LastChild.LastChild
        Print vbLf; "Infos for the Last ChildNode:"; vbLf; "  " & .Text
        Print "      IsChildOf: "; .Parent.Text
        Print "        IsChildOf: "; .Parent.Parent.Text
    End With
   
  Else
    Set Root = Nothing
    Print "Destruction-Time:", Format(Timer - Tag, " 0.00sec")
  End If
End Sub

Sub AddChildNodesTo(N As cNode, ByVal ChildCount As Long, TextPrefix As String)
  Dim i As Long
  For i = 0 To ChildCount - 1: N.AddNode TextPrefix & i: Next
End Sub
Have fun,

Olaf
↧

[VB6] Event Tracing for Windows - Monitoring File Activity with ETW

March 30, 2022, 12:42 am
$
0
0

VBEventTrace v1.0
Using Event Tracing for Windows in VB6

Event Tracing for Windows (ETW) is a notoriously complex and unfriendly API, but it's extremely powerful. It allows access to messages from the NT Kernel Logger, which provides a profound level of detail about activity on the system. It provides details about many types of activity, but this first project will focus on File Activity. I also plan to follow this up with a monitor for TcpIp and Udp connections.

Given the complexity and unfriendliness that's given it the reputation of the world's worst API, why use it? You can find many projects that monitor file activity, using methods like SHChangeNotify, FindFirstChangeNotification, and monitoring open handles. But the reality is these are all high level methods that don't cover quite a bit of activity. The kernel logger shows activity coming from low level disk and file system drivers. This project started with me wanting to know what was causing idle hard drives to spin up, and none of the higher levels methods offered a clue. Programs like ProcessHacker and FileActivityView use the NT Kernel Logger as well, but I wanted two things: Better control over the process, and doing it in VB6. Why? Well, if you've seen my other projects, you know I'm excessively fond of going way beyond what VB6 was meant for both in terms of low level stuff and modern stuff.

Intro

This project tracks most of the FileIo events, providing a great deal of control over what events you watch and filtering them to find what you're looking for. It also looks up name and icon of the process that generated the activity (not always available). With no filtering or only light filtering, a tremendous amount of data is generated. The VB TextBox and ListView simply could not keep up with the rapid input, and all sorts of memory and display issues ensued where text and List Items disappeared. So while the project was already complicated to begin with, the only way to cope with this was to use an API-created Virtual ListView (created via API and using the LVS_OWNERDATA style so it only includes the data currently being displayed).

How It Works
Have a read here for an introduction to setting up a Kernel Logger with ETW, and then realize it's even *more* complicated than that article suggests, because of some VB6 specific issues, and the hell on earth involved in interpreting the data.

Just starting the tracing session has 3 steps. You start with the EVENT_TRACE_PROPERTIES structure. Now, it's daunting enough on it's own. But when you read the article linked, you realize you have to have open bytes appended *after* the structure for Windows to copy the name into. Then the article doesn't touch on a recurring theme that was the source of a massive headache implementing it... in other languages, structures get automatically aligned along 8 byte intervals (a Byte is 1 byte, an Integer 2 bytes, a Long 4 bytes... alignment is making each Type a multiple of a certain number of bytes). Not so in VB. It took quite a bit of crashing and failures to realize this, then properly pad the structures. The code uses it's own structure for the StartTrace function that looks like this:

Code:
Public Type EtpKernelTrace
    tProp As EVENT_TRACE_PROPERTIES
    padding(0 To 3) As Byte
    LoggerName(0 To 31) As Byte 'LenB(KERNEL_LOGGER_NAMEW)
    padding2(0 To 3) As Byte
End Type
Needed to include 4 bytes of padding after the structure, then add room for the name, then make sure it's all aligned to 8 byte intervals. Now we're ready to go, with tStruct being a module-level EtpKernelTrace var:

Code:
With tStruct.tProp
    .Wnode.Flags = WNODE_FLAG_TRACED_GUID
    .Wnode.ClientContext = 1&
    .Wnode.tGUID = SelectedGuid
    .Wnode.BufferSize = LenB(tStruct)
    .LogFileMode = EVENT_TRACE_REAL_TIME_MODE 'We're interested in doing real time monitoring, as opposed to processing a .etl file.
    If bUseNewLogMode Then
        .LogFileMode = .LogFileMode Or EVENT_TRACE_SYSTEM_LOGGER_MODE
    End If
    'The enable flags tell the system which classes of events we want to receive data for.
    .EnableFlags = EVENT_TRACE_FLAG_DISK_IO Or EVENT_TRACE_FLAG_DISK_FILE_IO Or EVENT_TRACE_FLAG_FILE_IO_INIT Or _
                    EVENT_TRACE_FLAG_DISK_IO_INIT Or EVENT_TRACE_FLAG_FILE_IO Or EVENT_TRACE_FLAG_NO_SYSCONFIG
    .FlushTimer = 1&
    .LogFileNameOffset = 0&
    .LoggerNameOffset = LenB(tStruct.tProp) + 4 'The logger name gets appended after the structure; but the system looks in 8 byte alignments,
                                                'so because of our padding, we tell it to start after an additional 4 bytes.
End With

'We're now ready to *begin* to start the trace. StartTrace is only 1/3rd of the way there...
hr = StartTraceW(gTraceHandle, StrPtr(SelectedName & vbNullChar), tStruct)
This begins to start a trace session. There's SelectedGuid and SelectedName because there's two options here. In Windows 7 and earlier, the name has to be "NT Kernel Logger", and the Guid has to be SystemTraceControlGuid. If you use that method, there can only be 1 such logger running. You have to stop other apps to run yours, and other apps will stop yours when you start them. On Windows 8 and newer, there can be several such loggers, and you supply a custom name and GUID, and inform it you want a kernel logger with the flag added with bUseNewLogMode. This project supports both methods. The EnableFlags are the event providers you want enabled. This project wants the disk and file io ones, but there's many others. Onto step 2...

Code:
Dim tLogfile As EVENT_TRACE_LOGFILEW
ZeroMemory tLogfile, LenB(tLogfile)
tLogfile.LoggerName = StrPtr(SelectedName & vbNullChar)
tLogfile.Mode = PROCESS_TRACE_MODE_REAL_TIME Or PROCESS_TRACE_MODE_EVENT_RECORD 'Prior to Windows Vista, EventRecordCallback wasn't available.
tLogfile.EventCallback = FARPROC(AddressOf EventRecordCallback) 'Further down, you can see the prototype for EventCallback for the older version.
gSessionHandle = OpenTraceW(tLogfile)
We have to tell it *again* we want to use real time mode, not a .etl log file, and at this point we supply a pointer to a callback that receives events. This project uses a newer type of callback available in Vista+, but has prototypes for the older one. Like a WndProc for subclassing, this has to be in a standard module (.bas); to put it in a class module/form/usercontrol, you'd need the kind of self-subclassing code like you find on the main form (but be careful copying/pasting that, it's been slightly modified and only works with Forms).

The final step is a single call: To ProcessTrace. Only then will you begin receiving events. But of course, this simple call couldn't be simple. ProcessTrace doesn't return until all messages have been processed, which in a real-time trace means indefinitely until you shut it off. So if you call it, execution stops. In that thread. In other languages, spinning off a new thread to call ProcessTrace is easy. In VB, it's painful. This project makes use of The trick's VbTrickThreading project to launch a new thread for the ProcessTrace call. The downside here is that means event tracing is only possible in a compiled exe, making debugging difficult.

Once you've called ProcessTrace, your callback begins receiving messages. We need to match them up with their provider, and then check the OpCode...

Code:
Public Sub EventRecordCallback(EventRecord As EVENT_RECORD)
'...
If IsEqualIID(EventRecord.EventHeader.ProviderId, DiskIoGuid) Then
    iCode = CLng(EventRecord.EventHeader.EventDescriptor.OpCode)
   
    'Some events use the same MOF structure and are processed similarly, so we group them together and separate
    'the codes for filtering and logging later.
    If (iCode = EVENT_TRACE_TYPE_IO_READ) Or (iCode = EVENT_TRACE_TYPE_IO_WRITE) Then
The EVENT_RECORD structure is also a nightmare. Many different parts of it had to having alignment padding added, and it tripped me up for a good long while. Extra thanks to The trick for helping me figure out the right alignment on this part.

From here, we're ready to process the data. The raw data is returned in MOF structures, e.g. this one for one of the Open/Create messages. There's ways to automate the processing of them, but that makes everything so far seem simple, and is the domain for a future project. For now, we manually process the raw data, which we copy from the pointer in .UserData in the event record. The documentation doesn't mention *at all* that even if you're running a 32bit application, these structures have 64bit sizes. The official documentation doesn't note which "uint32" types are pointers, and thus are 8 bytes instead of 4, so I had to go digging in some deep system files. The original 32bit structures are all included, but currently this project only works on 64bit Windows. It's possible to tell automatically via flags in the event record... perhaps in the future.

Here what the File Open/Create structure looks like, and how we set it up:

Code:
Public Type FileIo_Create64 'Event IDs: 64
    IrpPtr As Currency
    FileObject As Currency
    ttid As Long
    CreateOptions As CreateOpts
    FileAttributes As FILE_ATTRIBUTES
    ShareAccess As Long
    OpenPath(MAX_PATH) As Integer
End Type
Fortunately VB has the Currency data type, which we also used for our event trace handles, which is 8 bytes. We can use this because there's no point where we have to interact a numeric representation of the value... it's just all raw bytes behind the scenes. Unfortunately, FileAttributes is only what's passed to the NtOpenFile API and not an actual query of the file's attributes, so is almost always 0 or FILE_ATTRIBUTES_NORMAL. We pick MAX_PATH for the size of the array, because using a fixed-size array avoids VB's internal SAFEARRAY type, which would make copying a structure from a language without it much more complicated. Converting a string of integer's to a normal string is trivial, but the real problems comes when you see what it is: files names look like \Device\HarddiskVolume1\folder\file.exe. To convert those into normal Win32 paths the project creates a map by querying each possible drive letter in the QueryDosDevice API, which returns a path like that for each drive.

Not all events contain a file name, so the project stores a record with the FileObject, which allows us to match other operations on the same file, and get the name. The documentation says we're supposed to receive event code 0 for names... but I've never seen that message come in. Perhaps on earlier Windows versions.

Perhaps the biggest problem in processing the data is that while there's an ProcessID and ThreadID in the event record's header, the process id is very often -1. Sometimes that information is returned in other events. This project goes through incredible lengths to correlate every with every other event in order to track down the process whenever possible. So many events will display -1 at first, and get updated later.

There's still a lot of work to be done in process attribution, and getting info about files already open before the trace starts. I attempted to copy ProcessHacker's use of a KernelRundownLogger, but so far have not been successful. I'll be look at other methods, but if I didn't put out a Version 1, who knows how long it would be.

Once we've captured the events, we store it in a the ActivityLog structure, which is the master data store for what's displayed on the ListView.

Options

You can see in the screenshot a number of options. There's the main controls for the trace; you don't really need to worry about 'Flush', it's there for completeness and shouldn't be needed. Stop is always enabled because in the event of crashes, you can stop previous sessions. You can save the trace; it saves what you see in the ListView, tab separated. There's options for which events you want to capture, whether to use the new logger method described earlier (Win8+), and the refresh interval for the ListView. The items aren't added to the ListView; they're stored in the ActivityLog structure, and the ListView is in virtual mode, so it only asks for what it's currently displaying. The refresh interval is how often it checks for new events and sets the last one as visible, creating a view that is always scrolled to the bottom but without the invisible items stored in the ListView itself, dramatically improving speed. (The greyed out option is for future work, not currently implemented)

Very important is the filtering system, if you're looking for certain activity. Each field allows multiple entries separated with a | (bar, it also accepts broken bars found on some keyboards). There's a button that displays a message explaining the syntax and the flow... the first thing checked is whether it's from a process we're interested in based on the process options. You can use DOS wildcards in the Process name field and File name fields, but not the paths at this point... for now the paths are strictly checked on a 'Starts with...' basis. After checking the process, then it checks 'Path must match', then 'Exclude paths', then 'File name must match', finally 'Exclude file name'.

Finally on the right there's a message log, which displays information about starting/stopping the trace, when a different function has correlated a previously unidentified process id, and any errors that arise.

Not shown: If you right click the ListView, there's a popup menu with options to open the selected items, show the selected items in Explorer, copy selected file names, copy all file names, copy the selected lines (tab separated), copy all lines, show properties of the process, and show the process in Explorer.

Requirements
PLEASE TAKE NOTE. This program has atypical requirements.

-Windows Vista or newer 64bit. Although like all VB6 apps the app itself is 32bit, it handles data structures generated by the system, and is currently only coded to handle 64bit structures. To run on 32bit Windows, use the regular MOF structures instead of the x64 ones (and change the size checks at the start of each processing routine).

-This program can only start event tracing when compiled, due to the need for multithreading that cannot be done in a single thread.

-You must Run As Administrator to have permission to access the NT Kernel Logger, which this app uses.

-There are no external dependencies. However, the demo uses a manifest for Common Controls 6.0 styles, and it's advised you also use them in any other project.

-Unicode is supported in the ListView for displaying files etc, but the filter TextBoxes are just regular VB ones, so you'd need to replace those to use Unicode in filtering.

Windows 10 is strongly recommended. I have not had the opportunity to test this on other OSs.

This API is *extremely* complicated and finicky, so there's bound to be bugs. Especially on other Windows versions. Let me know, I'll see what I can do.
Attached Files
↧

Work with paths longer than MAX_PATH

April 5, 2022, 11:58 am
$
0
0
Windows 10 allows to have paths > MAX_PATH (260 characters), but you'll have problems with VB and APIs.

Here is a workaround:

Code:
Private Declare Function GetShortPathNameW Lib "kernel32" (ByVal lpszLongPath As Long, ByVal lpszShortPath As Long, ByVal cchBuffer As Long) As Long
Code:
Public Sub ShortenPath(nPath As String)
    Const MAX_PATH = 260
    Dim iRet As Long
    Dim iBuff As String
   
    If Len(nPath) > MAX_PATH Then
        iRet = GetShortPathNameW(StrPtr("\\?\" & nPath), 0, 0)
        If iRet Then
            iBuff = Space$(iRet - 1)
            If GetShortPathNameW(StrPtr("\\?\" & nPath), StrPtr(iBuff), iRet) Then
                If Left$(iBuff, 4) = "\\?\" Then iBuff = Mid(iBuff, 5)
                nPath = iBuff
            End If
        End If
    End If
End Sub
Prepending "\\?" to the path allows the GetShortPathNameW API to handle it and return a short path that the program can use.

PS: I passed the argument ByRef to make it work faster.
↧
↧

TextBox SpellCheck

April 6, 2022, 12:11 pm
$
0
0
It is a class module to apply a spell checker to a TextBox or RichTextBox, it does it through the SpellCheckerFactorys interface, it is available from Windows 8 and later.

Although with some controls like the InkEdit and the RichTextbox (Richedit50W), with just a couple of lines of code you can already apply the spell checker, but in the case of the TextBox (Edit) you have to do a complete job like the one shown it was made in the class module to work the same way. It is worth clarifying that in the case of the RichTextBox when it is formatted, the behavior may not be the desired one, since the red error lines may be slightly out of phase if the font changes.

As you can see in the image, in the contextual menu it applies the correction options and other functionalities such as: skip, delete words, add to the dictionary and autocorrect, the latter consists of automatically changing the word for another as soon as possible. is detected

It doesn't require any dependencies, just Windows 8 and later.

References:
https://www.vbforums.com/showthread....ly-a-few-lines
https://www.vbforums.com/showthread....ows-SpellCheck

Name: spellcheck.jpg Views: 42 Size: 68.5 KB


DOWNLOAD: SpellCheck.zip
Attached Images
 
Attached Files
↧

VB6 ImageCaching and -Animation (using a single Resource-File for storage)

April 7, 2022, 1:34 pm
$
0
0
Just a Demo which applies the cGDIPlusCache-Class (as intended, as a Drop-In-Module).

The original CodeBank-entry for cGDIPlusCache is here: https://www.vbforums.com/showthread....-cls-revisited

cGDIPlusCache (as included in this Demo) was enhanced about two new Methods:
  • SaveCacheToImgStore(StoreFileName As String)
  • ReadCacheFromImgStore(StoreFileName As String)


When run in IDE-Mode, the Demo will populate the GC-CacheObject directly from a \Res\-Subfolder -
(via GC-Add... Methods which in this case load PNGs, JPGs or GIFs directly from the FileSystem)

When the MainForm unloads (in IDE-Mode), then one of the new Methods is used:
  • GC.SaveCacheToImgStore App.Path & "\ImageCache.gc"


So that, when the Demo runs compiled, it will ignore the Files in the \Res\-Subfolder (so no need to deploy it) -
and instead loads the GC-Objects Cache-Content from a single File via:
  • GC.ReadCacheFromImgStore App.Path & "\ImageCache.gc"


The whole User-Code (aside from the dropped-in cGDIPlusCache.cls-File) -
sits in a single Form (with only about 25 Lines).

That's enough to ensure a Checker-BackGround and two Animations (one from a GIF, another one from a "PNG-stripe").
Name: ImageCaching.png Views: 46 Size: 15.5 KB

Ok, here is the Zip: ImageCaching.zip

Have fun,

Olaf
Attached Images
 
Attached Files
↧

[VB6] Crossword Puzzle Constructor

April 10, 2022, 11:47 am
$
0
0
This is a program i threw together to generate crosswords based on a word/clue list. You can then print out the generated puzzle on a printer or solve it from within the program.

For those that haven't followed the thread on creating the program with SamOscarBrown you can view it here:
https://www.vbforums.com/showthread....word-Generator

Name: ss8.jpg Views: 44 Size: 52.3 KB
Attached Images
 
Attached Files
↧
Search

[VB6] CSharedMemory - class for dynamic memory allocation in shared memory

April 13, 2022, 3:31 am
↧
↧

[VB6] CWaveFile - class for working with WAVE-PCM files.

April 17, 2022, 11:22 am
↧

ReDimPreserve Two dimension array

April 17, 2022, 8:25 pm
$
0
0
Code:
Public Sub ReDimPreserve(arrPreserve, ByVal end_row2&, ByVal end_col2&, Optional ByVal start_row2, Optional ByVal start_col2)
'funtion: to break the limitation that ReDim Preserve cannot handle two-dimension array
'Param1: arrPreserve, original array to be ReDim Preserve
'Param2: end_row2, superscript of 1st dimension
'Param3: end_col2, superscript of 2nd dimension
'Param4: start_row2, subscript of 1st dimension, optional, original array 1st dimension subscript by default
'Param5: start_col2，subscript of 2nd dimension, optional, original array 2nd dimension subscript by default
'Attension: please make sure end_row2 >= start_row2, and end_col2 >= start_col2
    Dim arrTemp As Variant
    Dim i As Long, j As Long
    Dim start_row1 As Long, end_row1 As Long  'original 1st dimension info
    Dim start_col1 As Long, end_col1 As Long  'original 2nd dimension info
    If Not IsArray(arrPreserve) Then Exit Sub
    start_row1 = LBound(arrPreserve, 1)
    end_row1 = UBound(arrPreserve, 1)
    start_col1 = LBound(arrPreserve, 2)
    end_col1 = UBound(arrPreserve, 2)
    If VarType(start_row2) = 10 Then start_row2 = start_row1  'if not given, set to default
    If VarType(start_col2) = 10 Then start_col2 = start_col1  'if not given, set to default
    ReDim arrTemp(start_row2 To end_row2, start_col2 To end_col2) 'dynamic redim new array
    If start_row2 > end_row1 Or _
      end_row2 < start_row1 Or _
      start_col2 > end_col1 Or _
      end_col2 < start_col1 Then  'check if new array subscript or superscript out of original range
        Err.Raise 0, "ReDimPreserve", "New array superscript or subscript out of range"
        Exit Sub
    Else  'contain part of origianl array data at least
        If start_row2 > start_row1 Then start_row1 = start_row2
        If start_col2 > start_col1 Then start_col1 = start_col2
        If end_row2 < end_row1 Then end_row1 = end_row2
        If end_col2 < end_col1 Then end_col1 = end_col2
        For i = start_row1 To end_row1      'copy data by fixed range
            For j = start_col1 To end_col1
                arrTemp(i, j) = arrPreserve(i, j)  'copy data
            Next
        Next
        arrPreserve = arrTemp  'return ByRef
    End If
End Sub
Useage:
Code:
Sub Test()
Dim arr
ReDim arr(1 To 4, 1 To 4)
Dim i&, j&
For i = 1 To 4
    For j = 1 To 4
        arr(i, j) = i & "-" & j
    Next j
Next i
ReDimPreserve arr, 3, 3
ReDimPreserve arr, 3, 3, 0, 0
ReDimPreserve arr, 3, 3, 2, 2
End Sub
↧

Shagratt's VB6 IDE AddIns collection (Latest versions)

April 19, 2022, 9:29 am
$
0
0
Hi Guys! I dont have plans to keep working on them so I'm releasing all my work on VB6 IDE Addins as a collection.
They are all stable and I use all of them daily for my projects.
AddIns included are updated (bugfixed) and unreleased versions.


Screenshots+Videos and Download: https://shagratt.github.io/VB6ideAddins/


The list include:

-Document Map (v2.2)
-Comment Display+Highlight+Hotkeys (v1.2)
-CodeFold (v1.1)
-Fix Palette Button Mod (v1.3)
-Resizer (v1.0)




↧

Create Access 97 database with VB6

April 20, 2022, 1:15 pm
$
0
0
I would like to create an Access 97 database with VB6. Have gotten my code to work one time. But VB6 shut down before code was saved, and have been unable to recreate it. I am running Windows 10 and have Access 97 but my Windows 10 wants me to reinstall Access 97 almost every time I want to use it.
↧
↧

SimpleSock Update

April 23, 2022, 3:46 pm
$
0
0
If you use SimpleSock or SimpleServer, I have found a more efficient and faster way to receive sockets when using a fixed record header. TLS 1.3 encrypted records for example use a fixed 5 byte header.
Code:
    TLSHeader(0) = RecType
    TLSHeader(1) = VERSION_MAJOR
    TLSHeader(2) = VERSION_MINOR_3
    TLSHeader(3) = Reclen (high byte)
    TLSHeader(4) = RecLen (low byte)
It uses a function that was built into these routines that allows a specific number of bytes to be recovered from the Winsock buffer. There was however a bug in SimpleSock that prevented this function from working properly. SimpleServer did not exhibit the same problem, so the SimpleSock download has been updated at:
https://www.vbforums.com/showthread....B6-Simple-Sock

The problem code was in the BuildArray Function.
Code:
    If m_Protocol = SCK_TCP Then 'TCP transfers data from m_bRecvBuffer
        BuildArray = m_bRecvBuffer  'lSize
        If Not blnPeek Then
            Call DeleteByte(m_bRecvBuffer, lSize)
        End If

was changed to:

    If m_Protocol = SCK_TCP Then 'TCP transfers data from m_bRecvBuffer
        ReDim bTmp(lSize - 1)
        CopyMemory bTmp(0), m_bRecvBuffer(0), lSize
        BuildArray = bTmp
        If Not blnPeek Then
            Call DeleteByte(m_bRecvBuffer, lSize)
        End If
Previously, the buffer was managed in the calling function using static variables and self contained buffers:
Code:
Private Sub mClient_EncrDataArrival(ByVal bytesTotal As Long)
    Dim bData() As Byte
    'This routine is re-entrant, hence the next 3 variables must be static
    Static InBuff() As Byte
    Static Header() As Byte
    Static RecLen As Long
    Call mClient.RecoverData
    bData = mClient.bInBuffer
    Call AddByte(InBuff, bData) 'Add data to buffer
GetNextRecord:
    If GetbSize(InBuff) < 5 Then Exit Sub 'If no record length yet then exit & wait
    If RecLen = 0 Then 'New record
        ReDim Header(4)
        CopyMemory Header(0), InBuff(0), 5  'Save Header
        Call DeleteByte(InBuff, 5)          'Remove Header from buffer
        RecLen = CLng(Header(3)) * 256 + Header(4) 'Calculate record length
        Select Case Header(0)
            Case 1, 2, 4, 5, 6, 8, 9, 16
                'Record type OK
            Case Else 'Ignore record
                Call DeleteByte(InBuff, RecLen)
                GoTo Done
        End Select
    End If
    If GetbSize(InBuff) >= RecLen Then  'Complete record available
        ReDim bData(RecLen - 1)      'Resize buffer to record length
        CopyMemory bData(0), InBuff(0), RecLen  'Copy record data to buffer
        Call DeleteByte(InBuff, RecLen) 'Delete record data from inbuff
        Crypt.InBuffer = bData          'Save record to encryption InBuffer
    Else
        Exit Sub 'Wait for complete record
    End If
    'record complete - Process it
....
....
....
Done:
    RecLen = 0
    ReDim Header(0)
    If GetbSize(InBuff) > 0 Then GoTo GetNextRecord
End Sub
Using the class buffer instead, we extract the header, recover the record length, and then wait for the full record to be accumulated in the class buffer. There is no danger of overflowing the class buffer because it is self regulating.
Code:
Private Sub mClient_EncrDataArrival(ByVal bytesTotal As Long)
    Dim bRecord() As Byte
    Dim Header() As Byte
    Dim RecLen As Long
GetNextRecord:
    If RecLen = 0 Then 'Remove header
        If bytesTotal < 5 Then Exit Sub 'If no record length yet then exit & wait
        mClient.RecoverData 5
        Header = mClient.bInBuffer
        Call DebugPrintByte("Header", Header)
        RecLen = CLng(Header(3)) * 256 + Header(4)
        bytesTotal = bytesTotal - 5
    End If
    If RecLen = 0 Then 'Invalid record
        'Do nothing
    ElseIf bytesTotal >= RecLen Then
        mClient.RecoverData RecLen
        bRecord = mClient.bInBuffer
        bytesTotal = bytesTotal - RecLen
        Crypt.InBuffer = bRecord
        'record complete - Process it
....
....
....
Done:
        RecLen = 0
        If bytesTotal > 0 Then GoTo GetNextRecord
    Else
        'Wait for all the data
    End If
End Sub
Using TLS, record lengths are limited, but if you are streaming large records using this technique, you should make "RecLen" static, and process bytes as they are received. This can usually be accomplished by using the SendComplete routine and comparing the total bytes received to RecLen.

J.A. Coutts
↧

Add scroll bars to VB-Forms, PictureBoxes and UserControls

May 8, 2022, 12:48 am
$
0
0
Steve McMahon (www.vbAccelerator.com) provides a Scrollbar class which can add scroll bars to VB-Forms, PictureBoxes and UserControls. But the subclass (SSUBTMR.DLL) used by this class is not IDE-Safe. To test and compare various IDE-Safe subclasses, I replaced SSUBTMR.DLL with 4 subclasses.

The four subclasses are:

(1) The trick's cTrickSubclass
(2) wqweto's MST subclass
(3) RC6.Subclass
(4) jpbro's RC6SubclassWrapper (RC5SubclassWrapper)

Hope this test code is useful to some people.
↧
Search

Environment variable dumper

May 8, 2022, 6:22 pm
$
0
0
Put this code into Form1 of your project and run it. It will put automatically save a file called EnvironmentVariables.txt and then close. This text file contains the environment variables and their values. This text file file will be in your VB6 IDE's working directory, or in the directory where the EXE file is if you already compiled it into an EXE file and ran it from that EXE file.

Code:
Private Declare Function GetEnvironmentStrings Lib "kernel32.dll" Alias "GetEnvironmentStringsA" () As Long
Private Declare Function FreeEnvironmentStrings Lib "kernel32.dll" Alias "FreeEnvironmentStringsA" (ByVal lpsz As Long) As Long
Private Declare Sub GetMem1 Lib "msvbvm60.dll" (ByRef Source As Any, ByRef Destination As Any)

Private Sub Form_Load()
    Dim CharVal As Byte
    Dim CurrentString As String
    Dim lpStringBlock As Long
    Dim n As Long
   
    lpStringBlock = GetEnvironmentStrings
   
    Open "EnvironmentVariables.txt" For Output As #1
    n = lpStringBlock
    Do
        GetMem1 ByVal n, CharVal
        If CharVal = 0 Then
            If Len(CurrentString) > 0 Then
                Print #1, CurrentString; vbCrLf
                CurrentString = ""
            Else
                Exit Do
            End If
        Else
            CurrentString = CurrentString & Chr$(CharVal)
        End If
        n = n + 1
    Loop
    Close #1
   
    FreeEnvironmentStrings lpStringBlock
   
    Unload Me
End Sub
Note that the line "Print #1, CurrentString; vbCrLf" contains a vbCrLf, even though it seems redundant (as the Print statement already will automatically put Cr and Lf characters at the end of each line), for a very good reason. It puts a blank line between lines of output text. This is to accommodate the line-wrap that Windows Notepad uses for too-long lines of text, and guaranty separation of the environment variables. In particular, the value stored for the PATH environment variable is VERY long. Notepad will automatically line-wrap at the end of long lines (even breaking words in the middle), even if you have disabled the "word wrap" option. The word wrap option breaks lines when they are longer than the width of the Notepad window, and guaranties that there won't be a break in the middle of a word, but Notepad still forces a break on lines that are too long (they go WAY PAST the width of the Notepad window) even with word wrap disabled, and that can't be disabled. To guaranty visual separation of environment variables in Windows Notepad, I've made sure that there's a blank line after every environment variable (otherwise each next environment variable will be on the next line, but there also could be a next line for the same variable if it's too long, and this leads to ambiguity).

If you are using Notepad++ (a 3rd party software, not part of Windows), it doesn't automatically break a line no matter how long it is, making the insertion of blank lines between environment variables unnecessary. If you will be viewing the text file output from my program in Notepad++, then you can change the line "Print #1, CurrentString; vbCrLf" in the above code to instead say "Print #1, CurrentString". This will keep the text file smaller, and in Notepad++ it is guarantied that each environment variable will be entirely on its own line.
↧

ucCalendar (Events calendar)

May 14, 2022, 9:03 am
$
0
0
Hi, I want to share my last user control of a calendar of events, I will not be able to upload the control here since within the example I use two dll to link the calendar to a database with SQLite, so I will put the link to download directly from my website, if any moderator considers this inappropriate you can delete this post.

Name: ucCalendar_Month.jpg Views: 119 Size: 19.4 KB

Name: ucCalendar_Week.jpg Views: 119 Size: 19.0 KB



Go to web page:
http://leandroascierto.com/blog/ucca...io-de-eventos/
Attached Images
  
↧
↧

Export/Import Variables, Properties & UDT's for VB6 & VBA

May 22, 2022, 4:36 am
$
0
0
This system enables you to bundle data from a program into a highly compact binary array that can be sent to other programs, saved to disk, re-used within a program, etc. It works in 32- and 64-bit VBA and VB6. It allows you to easily transfer data between 32 and 64-bit programs. You specify one or more variables in your program to bundle and BinaryMagic will auto-generate the code you can include in your code to bundle the variables any time you want to. There is an equivalent set of procedures that allow you use the binary array and copy those values back into variables, presumably in the import program. Below are some simple examples of its use:


  • Saving and restoring data for forms including size and position and values for the controls on the form. You can save this to file and easily restore it the next time your form loads.
  • You want to pass data between 2 programs that are running at the same time. This data can be saved to a file or it could be sent via COM, memory-mapped files, etc.
  • You have a 64-bit VBA program and you want to use a sophisticated form for Data I/O. Oops, Microsoft crippled 64-bit VBA from when it first came out in Office 2010 and it only has a bare minimum of forms available for you to use. Now that Krool, fafalone and others on VBForums have created modern Unicode-capable controls for 32-bit VB6, you might be tempted to run your VBA code, shell out to a VB6 program which will restore prior data, get user input using these new controls on VB6 Forms and transmit the user entry data back to the VBA program. It is normally not so easy to send data between a 64-bit and a 32-bit program but we will show you how easy this is a bit later.
  • You can save/restore your program settings to/from the Windows Registry with all of the data in one binary string.
  • You can easily take the binary array generated for export and make it into a String (such as for an INI file) and then easily get the binary data back from the String on the Import PC with no data loss (we do it in such a fashion that VB does not try to convert the data from Unicode to ANSI).


We can handle virtually any type of data or properties VB can generate in any order including:

  • Scalar values such as Byte, Integer, Long, Boolean, Date, Single, Double, Currency and Boolean. These include individual values and arrays of any size up to 10 dimensions.
  • Scalar values unique to 64-bit VBA- LongLong and LongPtr including arrays of up to 10 dimensions. It even handles movement of these data types to/from 64 and 32-bit programs even though 32-bit programs don’t have these data types.
  • Strings (and String arrays) - Completely copied/restored in Unicode (no ANSI conversion).
  • Variants- This is by far the most complex variable in VB. It can contain any of the scalar values; it can handle arrays of any type including more Variants; it can contain arrays of arrays; and it can contain arrays of mixed data types. We handle any of these.
  • User-Defined Types (UDT’s)- It can handle simple and array UDT's. It can handle any complexity of UDT’s including nested to any levels. For example, a UDT can contain other UDT’s within its Type definition and that UDT can be simple or array or even contain other UDT’s. If you want to save all of the variables in a UDT you can do so with one line of code.
  • Objects, individual and arrayed- Note that at present, any arriving objects are set to Nothing. This program exports a set of values and an Object is not a value but rather a link to something else. For example, if you have a variable in Excel defined as “myWorksheet As Worksheet” and you used Set to start the COM connection, sending that connection to another program makes no sense because the other program wouldn’t have the connection made so it couldn’t use the Object information. In order to not crash the data transfer I decided to include Objects but will set them to Nothing (no Object data is sent and all Objects on the incoming end are Set to Nothing). You can still have arrays of Objects, up to 10 dimensions with each member Set to Nothing.
  • Public variables in Class/Standard modules and Forms.
  • Properties in Class/Standard modules and Forms. This includes Property Get (for export) and Property Let (for import). Note that these are actually not variables but are instead stack values that may be manipulated in the Class or Form code. If you Export/Import properties, ensure that you have a Property Get in the Exporting program and a corresponding Property Let in the importing program. Note also that the Property Get/Let statements can only have the property itself in the call. No other passed parameters are allowed. That isn't as restrictive as it sounds. If you have Property Get/Let statements that take additional parameters, you can just do the calls, assign the property to a variable on the Export and use that variable. Then reverse that on the import side by making the value you exported to a variable and then use that variable plus whatever other parameters you need for the Property Let call.
  • In general, a Variant cannot contain a UDT. There is an exception for ActiveX DLL’s and EXE’s. My impression is that this is rarely used so I chose not to deal with UDT’s in Variants (let me know if you think otherwise). I believe I cover all other VB variables as well as properties but if you find I have missed one or more, please let me know and I’ll make sure it is covered.


Variable Scope- One key aspect of all of this is that your variables and properties need to be in scope wherever you make the calls in both the exporting program and the importing program. For example, suppose you have two modules, ModA and ModB and that you have a variable you declare with a Dim statement in ModB which makes that variable only available in ModB. If you put the generated code (more on that in a bit) in ModA, you can’t export the Dim’d variable in ModB because it is not visible in ModA.

This is really no different than your normal coding. If you have a statement “a = b + c” in ModA but “c” is Dim’d as a local variable in another procedure, your code won’t work because the code can’t “see” variable “c”.

Enums- We can handle values (alone or as an array) declared as an Enum but you must tell our code that it is an Enum. Any variable declared as an Enum is actually a Long so you will need to tell our code that it is an Enum so it can be dealt with as a Long. Otherwise, the code will check all of the other variables and UDT definitions and Objects for the variable Type and will not find it, generating an error. It is easy to handle this and we’ll cover this later.

Objects- Likewise, if you have a variable declared as an Object, we won’t know what to do with it (and will error like described above because we can’t find its Type). The easiest thing to do is change the declaration in your code to be a variable of Type Object instead of Workbook or whatever else you have defined it to be. This is not a big deal since our code will set it to Nothing on the import end so we really don’t need to know what Type of Object it really is.

If you need to move the binary array as a String or a Variant, this is very simple to do and I provide easy directions for how to do this (especially important for strings so you don't get the "helpful" VB technique of automatically converting the internal Unicode string to ANSI which is horrible for binary data).

There are 3 examples attached for VB6 and 3 for Excel. A detailed user's guide is attached. I believe I have handled every type of variable you can use except for UDT's inside of a Variant. If I have left out any variable or Property types, please let me know and I'll get them included.

I have focused on generating the binary array and restoring data from the binary array. There are many ways to get this data to move where you need it, much of which has been covered in VBForums. This includes reading/writing to the registry, comm between processes such as pipes, memory mapped files, sockets, disk files, Windows messages etc. so I have not specifically covered that here other than in one of the examples.
Attached Files
↧

Luhn checksum algorithm

May 22, 2022, 3:34 pm
$
0
0
This allows you to calculate the Luhn checksum for a string of decimal digits, as well as to validate that checksum. Here's the code.
Code:
Public Function Luhn(ByVal DecimalString As String) As Byte
    Dim x As Long
    Dim y As Long
    Dim temp As String
    Dim n As Long
   
    If InStr(1, DecimalString, "-") Then
        DecimalString = Replace("DecimalString", "-", "")
    ElseIf InStr(1, DecimalString, " ") Then
        DecimalString = Replace("DecimalString", " ", "")
    End If
   
   
    n = 1
    For x = Len(DecimalString) To 1 Step -1
        temp = CLng(Mid$(DecimalString, x, 1)) * ((n And 1) + 1)
        If Len(temp) = 2 Then
            y = y + CLng(Mid$(temp, 1, 1)) + CLng(Mid$(temp, 2, 1))
        Else
            y = y + CLng(temp)
        End If
        n = n + 1
    Next x
    Luhn = (10 - (y Mod 10)) Mod 10
End Function

Public Function LuhnAppend(ByVal DecimalString As String) As String
    LuhnAppend = DecimalString & CStr(Luhn(DecimalString))
End Function

Public Function LuhnValidate(ByVal DecimalString As String) As Boolean
    LuhnValidate = (Luhn(Left$(DecimalString, Len(DecimalString) - 1)) = CByte(Right$(DecimalString, 1)))
End Function

Public Function LuhnValidateSeparate(ByVal DecimalString As String, ByVal Checksum As Byte) As Boolean
    LuhnValidateSeparate = (Luhn(DecimalString) = Checksum)
End Function
Just paste that code in a module and the functions will be accessible from anywhere else in your code. The functions are used as follows.
Luhn() calculates the Luhn checksum from a string of decimal digits, and outputs that checksum as a byte.
LuhnAppend() calculates the Luhn checksum from a string of decimal digits, and outputs a string that contains the original string with the checksum digit appended to it.
LuhnValidate() takes a complete decimal string including the checksum digit, and validates it. The output is boolean (True or False)
LuhnValidateSeparate() takes a decimal string without the checksum digit, and validates it against a separately provided byte that contains the checksum digit. The output is Boolean.

The Luhn calculation function ignores common separators found in decimal digit strings that typically use the Luhn checksum (such as those on credit cards). These separators are spaces and dashes.
↧

Visual Basic IDE dependencies

May 26, 2022, 9:43 am
$
0
0
Good afternoon guys

I happen to be playing with Visual Basic and I have several third party applications written in this language that I think have downgraded the versions of some system files.

When I'm creating a project and I checked the components and their versions, I realised that I'm not using the latest DLLs in the system. So I downloaded a DLL and OCX updater for an Argentinian game. And there it turns out that I found more outdated versions.

Too bad the updater didn't give any log. So I can't tell which file versions I had and which ones I have now. But I found it all very strange.
Is there something similar but more reliable?

I would like to know what system DLLs I may be using Visual Basic6 I have out of date please, manually is a headache.

These are the files that the updater comes with, how do I know these are the latest versions?, some are not from Microsoft, as this was meant to update a game:

[
{
"filename": "MSVBVM60.DLL",
"type_lib": "{000204EF-0000-0000-C000-000000000046}\\6.0\\9\\win32",
"version": "6.0.98.48",
"checksum": "898288bd3b21d0e7d5f406df2e0b69a5bbfa4f241baf29a2cdf8a3cf4d4619f2",
"filesize": 1436032
},
{
"filename": "MSVBVM50.DLL",
"type_lib": "{000204EF-0000-0000-C000-000000000046}\\5.0\\9\\win32",
"version": "5.1.43.19",
"checksum": "4aef0066e8e4bad65018ec85d46b902303155ec2d8f049f3803e571005a90ff0",
"filesize": 1347344
},
{
"filename": "MSINET.OCX",
"type_lib": "{48E59290-9880-11CF-9754-00AA00C00908}\\1.0\\0\\win32",
"version": "6.1.98.16",
"checksum": "b1212253d0c2b96dbdc6985b93338be288b0c8d827481f9c607dde5bdfdbfc6b",
"filesize": 136008
},
{
"filename": "RICHTX32.OCX",
"type_lib": "{3B7C8863-D78F-101B-B9B5-04021C009402}\\1.2\\0\\win32",
"version": "6.1.98.16",
"checksum": "e777685f35a3c84e996d8090173a1df9b97c9be194ba3660d20d62b7cbe9cf12",
"filesize": 218432
},
{
"filename": "CSWSK32.OCX",
"type_lib": "{33101C00-75C3-11CF-A8A0-444553540000}\\1.0\\0\\win32",
"version": "3.60.0.3650",
"checksum": "cfde61101ce134feade5d75608bd30264b9ef5472e6937fce0627d58d4c16c43",
"filesize": 107560
},
{
"filename": "MSWINSCK.OCX",
"type_lib": "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}\\1.0\\0\\win32",
"version": "6.1.98.17",
"checksum": "abe67b995d2c3f3898a84fe877ea1913658eaacf9841774204353edf5945674c",
"filesize": 126800
},
{
"filename": "MSCOMCTL.OCX",
"type_lib": "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}\\2.1\\0\\win32",
"version": "6.1.98.34",
"checksum": "45b6eef5bbf223cf8ff78f5014b68a72f0bc2cceaed030dece0a1abacf88f1f8",
"filesize": 1070152
},
{
"filename": "COMCTL32.OCX",
"type_lib": "{6B7E6392-850A-101B-AFC0-4210102A8DA7}\\1.3\\0\\win32",
"version": "6.0.98.16",
"checksum": "4f97aa44d3f5ecab907908d44a2cccd73ad67193fc10084ee1ba01577d9ad384",
"filesize": 614992
},
{
"filename": "COMDLG32.OCX",
"type_lib": "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}\\1.2\\0\\win32",
"version": "6.1.98.16",
"checksum": "00b5af20504fa3440ef3f9670a49963622d1a3557090e349f465746213761cef",
"filesize": 155984
},
{
"filename": "CAPTURA.OCX",
"version": "1.0.0.0",
"checksum": "420ade9b75d3f7e7e76d65ac1abff7d6c92881727edcd0f5fda31172808c8add",
"filesize": 18944
},
{
"filename": "MSADODC.OCX",
"type_lib": "{67397AA1-7FB1-11D0-B148-00A0C922E820}\\6.0\\0\\win32",
"version": "6.1.98.16",
"checksum": "bcab3a5650bafc096a97479f3eca26f1a4a153a9bf4cff080b9146e2bfab5cd3",
"filesize": 134976
},
{
"filename": "VBALPROGBAR6.OCX",
"type_lib": "{55473EAC-7715-4257-B5EF-6E14EBD6A5DD}\\1.0\\0\\win32",
"version": "1.0.0.6",
"checksum": "dd8cbb91f9a355e9f7511c47df404b8b53612ff65341e68eff555541cbd20c95",
"filesize": 65536
},
{
"filename": "MCI32.OCX",
"type_lib": "{C1A8AF28-1257-101B-8FB0-0020AF039CA3}\\1.1\\0\\win32",
"version": "6.0.81.69",
"checksum": "07bf28692ac79fd7e7de7cff2291ea945bb5a60d427ae2fd7a19dde738b67438",
"filesize": 198456
},
{
"filename": "DX7VB.DLL",
"type_lib": "{E1211242-8E94-11D1-8808-00C04FC2C602}\\1.0\\0\\win32",
"version": "5.3.2600.5512",
"checksum": "10a75e490fd192533c6907cd8159c4911258cffdfc557dc35d3dd49c0b813f17",
"filesize": 619008
},
{
"filename": "DX8VB.DLL",
"type_lib": "{E1211242-8E94-11D1-8808-00C04FC2C603}\\1.0\\0\\win32",
"version": "5.3.2600.5512",
"checksum": "74ac3a4c95510ad7b9c885edb8630cb2c132128d71b43b3f56567a18a5026747",
"filesize": 1227264
},
{
"filename": "QUARTZ.DLL",
"clsid": "{05589FAF-C356-11CE-BF01-00AA0055595A}\\InprocServer32",
"version": "6.6.7601.18526",
"checksum": "7dba5d646583d8b4170ed7ec204c17e71b8162b72c0a32f2bd9e8d899a692c5a",
"filesize": 1329664
},
{
"filename": "SHDOCVW.DLL",
"clsid": "{EF4D1E1A-1C87-4AA8-8934-E68E4367468D}\\InprocServer32",
"version": "10.0.19041.746",
"checksum": "c2514c508bb6fc1054b51f77d08d2100cd3820ef2862bdf31b2d953de088e419",
"filesize": 245760
},
{
"filename": "OLEAUT32.DLL",
"clsid": "{0000002F-0000-0000-C000-000000000046}\\InprocServer32",
"version": "10.0.19041.804",
"checksum": "035615f58e6adeae27edbc4cc7eb6a9f6ca6133288af9ec4e0e54f5e81b24741",
"filesize": 831024
},
{
"filename": "OLEPRO32.DLL",
"version": "6.1.7601.17514",
"checksum": "c09909b89183b89ba87cac8c5bebd0e995c5cb08cc9b9d1e88352103ee958857",
"filesize": 90112
},
{
"filename": "MSSTDFMT.DLL",
"type_lib": "{6B263850-900B-11D0-9484-00A0C91110ED}\\1.0\\0\\win32",
"version": "6.1.98.39",
"checksum": "74ef23860b9ed15587eae06670e83abac1928b502dad244875713d127d83a1df",
"filesize": 130712
},
{
"filename": "MPR.DLL",
"version": "5.1.2600.2180",
"checksum": "e9205e45cbcbe9e355d497a16a1769cf651cb8cb96a7e4ddb5d0ac0a9bee4689",
"filesize": 59904
},
{
"filename": "MSCOMCTL.DLL",
"version": "10.0.4504.0",
"checksum": "be2885e897470da3778a661158dc21f32a4aada769996abda082cc4bb6030086",
"filesize": 229376
},
{
"filename": "SCRRUN.DLL",
"clsid": "{0CF774D0-F077-11D1-B1BC-00C04F86C324}\\InprocServer32",
"version": "5.812.10586.0",
"checksum": "7852e688f17ed0598ceb00e2d525241e6a2e8d0c035617ff04b3b1c52abd75aa",
"filesize": 165888
},
{
"filename": "UNZIP32.DLL",
"version": "1.1.0.0",
"checksum": "6343b6c89d9dce1dd0c320d68a650ed053e31d3eecea75d376947c4cec222ff6",
"filesize": 143360
}
]
↧
Viewing all 1484 articles
Browse latest View live
Search
<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>