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

[VB6] ucShellBrowse: A modern replacement for Drive/FileList w/ extensive features

October 7, 2017, 10:29 pm
$
0
0


ucShellBrowse v1.0

About
This project started its life as an attempt to select a file right on a Property Page without having to click an additional button. There's still a lot of outstanding issues severely limiting the practicality, usability, and stability of that version, so pending further development on that I continued to make a UserControl version. This is basically having an updated, prettier version of VB's DirList/FileListBox, with further options that allow it to have the power of an actual Explorer window-- but doing it with a ComboBoxEx and ListView allow for customizations and features not possible if you were to simply host an instance of Explorer itself instead. It integrates many of the techniques my small sample projects have shown over the past few years.

Key Features
  • Full Unicode support
  • Icons, display names, and properties are identical to what a user sees in Explorer. Includes overlay icons for things like shares or links; supports custom ones like used by DropBox or Github.
  • Full navigation tree from the desktop-- virtual objects that are part of the file system, such as Computer or Libraries, are able to be used normally, and the selections real file system path is resolved and returned.
  • Support for several different view modes: Large icon, small icon, list, details, tiles, and thumbnails.
  • Thumbnail View uses the code from my ThumbsEx project, which goes beyond what Explorer can do by using GDI+ to center and frame images smaller than the thumbnail size. The thumbnail size can be set to any value.
  • Optional setting to enable extended thumbnails, like video files showing the first frame.
  • Images and all types with a registered preview handler can be previewed in an optional preview pane.
  • 'Group by' is fully implemented; can group for extended properties
  • Right click brings up the standard shell context menu
  • Sort is supported for all columns and uses the same API that is used by Explorer, so order is identical
  • A filter can be applied to only show files matching a certain type (PathMatchSpecW); an option specifies whether it's single-select or multi-select.
  • Supports rename-in-place with ListView LabelEdit, with blocks and warning popups to prevent disallowed characters. Renames are carried out through Explorer via IFileOperation.
  • Rename, and other functionality, is still supported even if file name extensions are hidden (the ListView uses the Explorer displayname, so if they're hidden in Explorer they're hidden here)
  • Supports 'Create new folder' where a new folder is created, with its name the next in sequence if needed, and a label edit to rename is automatically initiated.
  • Supports both dragging out and receiving dropped files, complete with the file icons you see in Explorer. Drops go through Explorer, meaning 3rd party shell extensions like WinRAR are supported.
  • All column headers found in Explorer are available to be added/removed/sorted by/grouped by, directly interfacing with the Windows Property System and each files Property Store.
  • Default column headers are loaded for each folder from Explorer; so when you browse to your Music library you get Artist, Album, Title, and Track as the columns (this behavior can be disabled)
  • Optional status bar that shows the number of files, their total size, and menu item help. A custom message can also be set.
  • The Back/Up/View control box can be shown or hidden; this combined with option to limit or turn off columns allows for compacting down to the same size as the original VB file browsing controls. ListView icons can even be hidden.
  • There's substantial interaction with the host form, informing your program of selection change, clicks, double clicks/enter press, directory change, renames, and file drops. These events provide both full paths and references to the file(s) IShellItem(Array) interfaces
  • The startup path can be customized and is remembered. The current path can be manually changed through a .BrowserPath property.
  • Custom draw is used to show encrypted files in green and compressed files in blue to be consistent with Explorer (this can also be forced on or forced off)

There's also fairly extensive debug output to the Immediate window. You can stop it from appearing by changing the 2nd line of ucShellBrowse.ctl; Private Const dbg_PrintToImmediate As Boolean = True --Change it to False to stop debug printing.

Requirements
-Windows Vista or newer
-If using this as a .ctl, your project must contain mSBSubclass.bas (from the main folder of the project), or the code from it placed in another .bas, and have a reference to oleexp.tlb v4.3 or higher (released 11 Sep 2017).

To use the control as an OCX, open ShellBrowse.vbp from the main folder, change the UserControl to 'Public', and compile. Then proceed to move, register, and use as you would any other .ocx. A project with the OCX does not require mSBSubclass.bas or oleexp.tlb. For future versions, I'll inquire with the admins about posting a pre-compiled .ocx.

The folder \Demo\ contains Project1.vbp which uses the control as an in-project .ctl.

Future Plans
There are a few advanced features, that aren't critical, that are going to take me a few weeks to finish. But I wanted to put out an initial release in the mean time and see how things go. These include:
-A details bar like the bottom of Explorer windows. This is more complex than one would think since it needs to detect if there's a registered property handler, and if so, load the PreviewDetails, figure out how many can fit in the current bar size, align them, and provide the ability to edit them. There's some debug code commented out that shows some of the techniques involved if you're interested in exploring that on your own before I finish it, in LVDoubleClick.
-Providing dynamic dragover highlighting. So when a user drag a file over from another app, if it's dragged over a folder or a zip file that's displayed in the ListView, that item is highlighted and can be dropped on. I've developed code to do this already, but it's not portable at all so will take a while to add to a new project.
-Registering with SHChangeNotifyRegister to monitor for file/folder changes and update accordingly. Much more complicated than you'd think, especially to keep the folder tree updated as well. There's a Refresh call and a RefreshTree call to manually update things in the mean time.

If there's another feature you'd like to see don't hesitate to suggest it :wave:

This project is complicated and still under development
And I'm doing it for fun in my spare time, so don't expect commercial production grade code. I know basic functionality is working right now, and every feature was working when it was added, but there's almost certainly going to be a few bugs here and there in the 10,000 lines that make up this extensive project. It's simply not possible to test every feature in every scenario it may encounter.
So if you encounter a bug, kindly let me know and I'll get it fixed for the next release.
Since it's still under active development, there's also a lot of commented out debug code left in, and definitions from common control headers that aren't used. This will be cleaned up once it's feature-complete. (It's also a principle of mine, I'm always curious and interested in seeing these kind of things in others code, so I tend to leave it in for my projects in this forum, in case anyone else shares my interest).

Edit: Just to point something out that's a little funny, it's turning out that stupid little details bar is outrageously complex, and by far the most difficult part of this entire project. Just figuring out what properties are supposed to be displayed took 5 coding marathons 6-7 hours long each lol.. Needless to say, this wasn't well documented, and some of the documentation outright contradicted Explorer's actual behavior.
Now that I know which properties to display, all I have to do is generated an array of API-drawn (because unicode) of textboxes, labels aligned to them, in a number of rows/columns that varies during runtime, linked to the properties, and allow editing the ones that can be edited, and save that back to the file. Simple lol :confused:
Attached Files
↧
Search

[vb6]Treeview - Prevent from indenting when no icon is used

October 10, 2017, 3:32 pm
$
0
0
Just a neat option. It has its limitations. It works for both versions 5 & 6 of the common controls TreeView.

In the screenshot below, you'll notice that the left image has indentation, or reserved white space for icons, when icons (ImageList) are used and no icon is assigned. Looks kinda ugly. But we can avoid this with a little API help.

Name: treeIcons.png Views: 131 Size: 7.2 KB

Limitations:
1. You cannot use any treeview style that includes icons, i.e., not tvwTreeLinesPictureText
2. You cannot use the checkbox style (image above uses icons vs checkbox style)
3. The number of different icons you can use is limited to 15 maximum
4. You must add a bogus icon in the ImageList. This bogus icon is always the 1st one

The reason for 15 max icons is that this API option only allows 4 bits to identify an icon index. With only 4 bits, we have a maximum range of 0 to 15. The value 0 is used to clear the icon, values 1 thru 15 are the possible icons in your image list, starting with the 2nd icon in the list. So, consider the icons in the imagelist as zero-bound even though you can reference them directly as one-bound. Because they are considered zero-bound, and zero index is used to clear the icon, the 1st icon in the image list is simply not used.

Here are the APIs used
Code:
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Private Const TV_FIRST As Long = &H1100
Private Const TVM_GETITEMA As Long = (TV_FIRST + 12)
Private Const TVM_SETITEMA As Long = (TV_FIRST + 13)
Private Const TVM_GETNEXTITEM As Long = (TV_FIRST + 10)
Private Const TVM_GETITEMRECT As Long = (TV_FIRST + 4)
Private Const TVM_SETIMAGELIST As Long = (TV_FIRST + 9)
Private Const TVSIL_STATE As Long = 2
Private Const TVIF_STATE As Long = &H8
Private Const TVGN_ROOT As Long = &H0
Private Const TVGN_CHILD As Long = &H4
Private Const TVGN_NEXT As Long = &H1
Private Const TVGN_CARET As Long = &H9
The image list must be assigned via this call. Should be added in Form_Load.
Note that you still associate the ImageList via the Treeview property page, as normal.
Code:
' change Treeview1 & ImageList1 as needed
    SendMessage TreeView1.hWnd, TVM_SETIMAGELIST, TVSIL_STATE, ByVal ImageList1.hImageList
This helper function is used by the other 3 public functions. Purpose is to retrieve the node ID (assigned by the window) not the index/key assigned by the control. It does this by reverse navigating from the target node to the 1st (root) node in the tree.
Edited: See post #2 for an alternate method of retrieving the Node ID
Code:
Private Function pvGetTreeItem(tView As TreeView, Node As Node) As Long

    Dim rNode As Node, tNode As Node
    Dim cMoves As Collection
    Dim c As Long, hItem As Long
   
    If tView.SelectedItem Is Node Then ' quick access
        hItem = SendMessage(tView.hWnd, TVM_GETNEXTITEM, TVGN_CARET, ByVal 0&)
    ElseIf Node Is Node.Root Then ' quick access
        hItem = SendMessage(tView.hWnd, TVM_GETNEXTITEM, TVGN_ROOT, ByVal 0&)
    Else
        Set cMoves = New Collection
       
        Set rNode = Node.Root                  ' used for reference
        Do Until tNode.Parent Is Nothing        ' navigate up the tree from passed node
            Set rNode = tNode.Parent.Child      ' used for reference
            Do Until tNode Is rNode
                cMoves.Add TVGN_NEXT            ' inverse navigate using NEXT
                Set tNode = tNode.Previous
            Loop
            cMoves.Add TVGN_CHILD              ' inverse navigate using CHILD
            Set tNode = tNode.Parent
        Loop
        Set tNode = Node                        ' used for reference
        If Not tNode Is rNode Then              ' at leaf top level, if not root, continue
            Do Until tNode Is rNode
                cMoves.Add TVGN_NEXT            ' inverse navigate using NEXT
                Set tNode = tNode.Previous
            Loop
        End If
        ' now navigate to the desired node from the root
        hItem = SendMessage(tView.Hwnd, TVM_GETNEXTITEM, TVGN_ROOT, ByVal 0&)
        For c = cMoves.Count To 1 Step -1
            hItem = SendMessage(tView.Hwnd, TVM_GETNEXTITEM, cMoves(c), ByVal hItem)
            If hItem = 0 Then Exit For
        Next
        Set cMoves = Nothing
    End If
    pvGetTreeItem = hItem

End Function
Here are three functions that do what we'll want. Can be placed in a module or your form
1. Setting the icon from the image list
Code:
Public Sub SetNodeIcon(tView As TreeView, Node As Node, ZeroBoundIconIndex As Long)

    If Node Is Nothing Or tView Is Nothing Then Exit Sub
    If ZeroBoundIconIndex < 0 Then Exit Sub
    If ZeroBoundIconIndex > 15 Then Exit Sub

    Dim lAttr(0 To 10) As Long
   
    lAttr(1) = pvGetTreeItem(tView, Node)
    If lAttr(1) Then
        lAttr(0) = TVIF_STATE
        lAttr(3) = &HFFFF&
        SendMessage tView.hWnd, TVM_GETITEMA, 0&, lAttr(0)
        lAttr(2) = (lAttr(2) And &HFFFF0FFF) Or (&H1000& * ZeroBoundIconIndex)
        SendMessage tView.hWnd, TVM_SETITEMA, 0&, lAttr(0)
    End If
   
End Sub
2. Retrieving which icon is assigned. Edited. Can use TVM_GETITEMSTATE instead, passing result of pvGetTreeItem for wParam and ByVal &HFFFF& as the lParam in SendMessage
Code:
Public Function GetNodeIcon(tView As TreeView, Node As Node) As Long

    If Node Is Nothing Or tView Is Nothing Then Exit Function

    Dim lAttr(0 To 10) As Long
   
    lAttr(1) = pvGetTreeItem(tView, Node)
    If lAttr(1) Then
        lAttr(0) = TVIF_STATE
        lAttr(3) = &HFFFF&
        SendMessage tView.hWnd, TVM_GETITEMA, 0&, lAttr(0)
        GetNodeIcon = (lAttr(2) And &HF000&) \ &H1000&
    End If

End Function
3. This is optional. A method to determine if user is clicking on the icon. See the sample project to see how the Node_Click event uses this method.
Code:
Public Function MouseOverNodeIcon(tView As TreeView, Node As Node, x As Single) As Boolean
   
    ' X must be passed in pixels
   
    If Node Is Nothing Or tView Is Nothing Then Exit Function
   
    Dim tRect(0 To 3) As Long
   
    tRect(0) = pvGetTreeItem(tView, Node)
    If tRect(0) Then
        If SendMessage(tView.hWnd, TVM_GETITEMRECT, 1&, tRect(0)) Then
            MouseOverNodeIcon = (x < tRect(0))
        End If
    End If
End Function
In the sample project, you can click on the icons to toggle the "checkmark"
Oops. Left in some test code. Re-uploaded the zip to fix that.
Attached Images
 
Attached Files
↧
↧

Noob Question about files and date :wave:

October 12, 2017, 12:51 am
$
0
0
Thanks in advance for the replies!

I maked a folder with date as name to store daily reports about the system data in a log.txt file

Is possible to read log files using a calendar?

for example I choosed 10/10/2017 from the calendar. Then the program shows me the 10/10/2017 folder log file

And is possible to make a range of days?

For example from 8/10/2017 to todays date, then the program shows up log files from 8/10/2017 to todays date folder...

Sorry for my english.
PD: I'm a newbie coder
↧

[vb6] Patch Icon/Cursor Resource File Entries

October 15, 2017, 5:35 pm
$
0
0
The Resource Editor (ResEdit) in VB can corrupt icon/cursor group data. The corruption is minimal, except PNG-encoded related entries. This corruption should not harm anything except in rare scenarios. Typically, you can expect no harm in these scenarios:

1. The icon/cursor files you add to the resource file via ResEdit only contain one image
2. When the file contains multiple images and all images are square (width = height)

However, this 'corruption' does result in reporting icon/cursor heights and cursor bit depths incorrectly. When multiple images exist for the icon/cursor, there is a potential that Windows will select the wrong image when using resource-related APIs: LoadImage, LookupIconIdFromDirectoryEx, etc.

Examples of corruption:
1. A 32x32 icon is reported as shown. The correct values are to the right, in blue
Width 32 32
Height 64 32
2. A 128x128 icon is reported as shown. The correct values are to the right, in blue
Width 128 128
Height 0 128
3. A 32x32 cursor is reported as shown. The correct values are to the right, in blue
Width 32 32
Height 32 64
Planes 0 1
BitCount 0 4
4. A 128x128 PNG-encoded icon is reported as shown. The correct values are to the right, in blue
Width 0 128
Height 0 128
Planes 18505 1
BitCount 21060 32

Note. After scanning/comparing dozens upon dozens of Windows executables/DLLs and extracting icon/cursor information, it is clear that the ResEdit utility fails to fill the group data correctly. Not surprisingly, icon/cursor group data extracted from vb6.exe, itself, is correctly filled.

This utility will read a VB resource file (.res) and scan the icons/cursors. If any discrepancies are found, they will be displayed. You'll have the option of correcting them and rewriting the res file or saving the updates to a different res file. Might want to consider running this against your res file before you compile your app?

Point to take home. If you only use your resource file's Icons/Cursors section to store single-image icons/cursors, this tool really doesn't help you.

Name: resPatch.png Views: 52 Size: 13.3 KB

Edited: See post #2. Found two MS DLLs with 128x128 cursors. Adjusted project to write non-zero width/height values for cursors > 255x255. Also forgot to add the .vbp file ... I'm getting old.
Attached Images
 
Attached Files
↧

[VB6] WTSSendMessage

October 21, 2017, 4:46 pm
$
0
0
Here are a couple of simple demos.

One just shows how to have a "MsgBox" that times out after some number of seconds if the user does not choose a button.

The other shows how you might raise a "MsgBox" from a Service or a batch Scheduled Task.


Requires Windows 2000 or later, or NT 4.0 with Terminal Services installed.


No idea whether this works on all Editions of Windows (Home, etc.). Only tested on Pro.

You could make more sophisticated use of the API to send messages between machines as well as to the local machine.
Attached Files
↧
↧

FindResource and the IDE

October 24, 2017, 11:34 am
$
0
0
Okay, I need a function that'll just tell me whether a file is in my resources or not.

I'd prefer not to use LoadResData with error trapping because some of my resource files are somewhat large. Therefore, my first idea was to use the FindResource API call. However, this only works once the program is compiled.

So, what I'd like as a ResourceExists(sFileName As String, sResourceType As String) As Boolean function that works the same in the IDE as compiled.

I'm going to do it with error trapping (and LoadResData) for now, but I'd sure like a better solution.

Thanks In Advance,
Elroy
↧

[VB6] InkEdit with Windows SpellCheck

October 28, 2017, 9:00 pm
$
0
0
Here is an example of using an InkEdit control in "inkless mode" as a Unicode-aware RichTextBox.

But on Windows 8 and later there is more!

The program turns on the built-in Windows spellcheck capabilities of RichEdit version 8, which lives inside the InkEdit control when running on current versions of Windows.

Code:
Private Const WM_USER As Long = &H400&
Private Const EM_SETLANGOPTIONS As Long = WM_USER + 120&
Private Const IMF_SPELLCHECKING As Long = &H800&
Private Const IMF_TKBPREDICTION As Long = &H1000&
Private Const IMF_TKBAUTOCORRECTION As Long = &H2000&
Private Const EM_SETEDITSTYLE As Long = WM_USER + 204&
Private Const SES_USECTF As Long = &H10000
Private Const SES_CTFALLOWEMBED As Long = &H200000
Private Const SES_CTFALLOWSMARTTAG As Long = &H400000
Private Const SES_CTFALLOWPROOFING As Long = &H800000

Private Declare Function SendMessage Lib "user32" Alias "SendMessageW" ( _
    ByVal hWnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) As Long

Private Sub Form_Load()
    With InkEdit1
        SendMessage .hWnd, _
                    EM_SETLANGOPTIONS, _
                    0, _
                    IMF_SPELLCHECKING _
                Or IMF_TKBPREDICTION _
                Or IMF_TKBAUTOCORRECTION
        SendMessage .hWnd, _
                    EM_SETEDITSTYLE, _
                    SES_USECTF _
                Or SES_CTFALLOWEMBED _
                Or SES_CTFALLOWSMARTTAG _
                Or SES_CTFALLOWPROOFING, _
                    SES_USECTF _
                Or SES_CTFALLOWEMBED _
                Or SES_CTFALLOWSMARTTAG _
                Or SES_CTFALLOWPROOFING
    End With
End Sub
Name: sshot.png Views: 79 Size: 6.2 KB

Imagine that. Free spellcheck!


Requirements

Windows 8 or later.
Attached Images
 
Attached Files
↧

[VB6] IEnumVARIANT / For Each support without a typelib

October 30, 2017, 2:00 pm
$
0
0
In my own projects I use a typelib and a custom interface to do the same thing, (comparable to .NET and Olaf's examples) which might seem overly complex, so here's an example that gets the job done without any dependencies. It also serves as a good example of creating a Lightweight COM Object that's less complex than Curland's examples (which are always over-complicated). It should be easy enough to adapt to your own custom collections.

Code:
' Copyright © 2017 Dexter Freivald. All Rights Reserved. DEXWERX.COM
'
' MEnumerator.bas
'
' Implementation of IEnumVARIANT to support For Each in VB6
'
Option Explicit

Private Type TENUMERATOR
    VTablePtr  As Long
    References  As Long
    Enumerable  As Object
    Index      As Long
    Upper      As Long
    Lower      As Long
End Type

Private Enum API
    NULL_ = 0
    S_OK = 0
    S_FALSE = 1
    E_NOTIMPL = &H80004001
    E_NOINTERFACE = &H80004002
    E_POINTER = &H80004003
#If False Then
    Dim NULL_, S_OK, S_FALSE, E_NOTIMPL, E_NOINTERFACE, E_POINTER
#End If
End Enum

Private Declare Function FncPtr Lib "msvbvm60" Alias "VarPtr" (ByVal FunctionAddress As Long) As Long
Private Declare Function GetMem4 Lib "msvbvm60" (Src As Any, Dst As Any) As Long
Private Declare Function CopyBytesZero Lib "msvbvm60" Alias "__vbaCopyBytesZero" (ByVal Length As Long, Dst As Any, Src As Any) As Long
Private Declare Function CoTaskMemAlloc Lib "ole32" (ByVal cb As Long) As Long
Private Declare Sub CoTaskMemFree Lib "ole32" (ByVal pv As Long)
Private Declare Function IIDFromString Lib "ole32" (ByVal lpsz As Long, ByVal lpiid As Long) As Long
Private Declare Function SysAllocStringByteLen Lib "oleaut32" (ByVal psz As Long, ByVal cblen As Long) As Long
Private Declare Function VariantCopyToPtr Lib "oleaut32" Alias "VariantCopy" (ByVal pvargDest As Long, ByRef pvargSrc As Variant) As Long

Public Function NewEnumerator(ByRef Enumerable As Object, _
                              ByVal Upper As Long, _
                              Optional ByVal Lower As Long _
                              ) As IEnumVARIANT
   
    Static VTable(6) As Long
    If VTable(0) = NULL_ Then
        VTable(0) = FncPtr(AddressOf IUnknown_QueryInterface)
        VTable(1) = FncPtr(AddressOf IUnknown_AddRef)
        VTable(2) = FncPtr(AddressOf IUnknown_Release)
        VTable(3) = FncPtr(AddressOf IEnumVARIANT_Next)
        VTable(4) = FncPtr(AddressOf IEnumVARIANT_Skip)
        VTable(5) = FncPtr(AddressOf IEnumVARIANT_Reset)
        VTable(6) = FncPtr(AddressOf IEnumVARIANT_Clone)
    End If
   
    Dim This As TENUMERATOR
    With This
        .VTablePtr = VarPtr(VTable(0))
        .Lower = Lower
        .Index = Lower
        .Upper = Upper
        .References = 1
        Set .Enumerable = Enumerable
    End With
   
    Dim pThis As Long
    pThis = CoTaskMemAlloc(LenB(This))
    CopyBytesZero LenB(This), ByVal pThis, This
    GetMem4 pThis, NewEnumerator
End Function

Private Function IID$(ByVal riid As Long)
    StrRef(IID) = SysAllocStringByteLen(riid, 16&)
End Function

Private Function IID_IUnknown() As String
    Static IID As String
    If StrPtr(IID) = NULL_ Then
        IID = String$(8, vbNullChar)
        IIDFromString StrPtr("{00000000-0000-0000-C000-000000000046}"), StrPtr(IID)
    End If
    IID_IUnknown = IID
End Function

Private Function IID_IEnumVARIANT() As String
    Static IID As String
    If StrPtr(IID) = NULL_ Then
        IID = String$(8, vbNullChar)
        IIDFromString StrPtr("{00020404-0000-0000-C000-000000000046}"), StrPtr(IID)
    End If
    IID_IEnumVARIANT = IID
End Function

Private Function IUnknown_QueryInterface(ByRef This As TENUMERATOR, _
                                        ByVal riid As Long, _
                                        ByVal ppvObject As Long _
                                        ) As Long
    If ppvObject = NULL_ Then
        IUnknown_QueryInterface = E_POINTER
        Exit Function
    End If

    Dim siid As String
    siid = IID$(riid)

    If siid = IID_IUnknown Or siid = IID_IEnumVARIANT Then
        DeRef(ppvObject) = VarPtr(This)
        IUnknown_AddRef This
        IUnknown_QueryInterface = S_OK
    Else
        IUnknown_QueryInterface = E_NOINTERFACE
    End If
End Function

Private Function IUnknown_AddRef(ByRef This As TENUMERATOR) As Long
    With This
        .References = .References + 1
        IUnknown_AddRef = .References
    End With
End Function

Private Function IUnknown_Release(ByRef This As TENUMERATOR) As Long
    With This
        .References = .References - 1
        IUnknown_Release = .References
        If .References = 0 Then
            Set .Enumerable = Nothing
            CoTaskMemFree VarPtr(This)
        End If
    End With
End Function

Private Function IEnumVARIANT_Next(ByRef This As TENUMERATOR, _
                                  ByVal celt As Long, _
                                  ByVal rgVar As Long, _
                                  ByVal pceltFetched As Long _
                                  ) As Long
    If rgVar = NULL_ Then
        IEnumVARIANT_Next = E_POINTER
        Exit Function
    End If
   
    Dim Fetched As Long
    With This
        Do Until .Index > .Upper
            VariantCopyToPtr rgVar, .Enumerable(.Index)
            .Index = .Index + 1&
            Fetched = Fetched + 1&
            If Fetched = celt Then Exit Do
            rgVar = PtrAdd(rgVar, 16&)
        Loop
    End With
   
    If pceltFetched Then DLng(pceltFetched) = Fetched
    If Fetched < celt Then IEnumVARIANT_Next = S_FALSE
End Function

Private Function IEnumVARIANT_Skip(ByRef This As TENUMERATOR, ByVal celt As Long) As Long
    IEnumVARIANT_Skip = E_NOTIMPL
End Function

Private Function IEnumVARIANT_Reset(ByRef This As TENUMERATOR) As Long
    IEnumVARIANT_Reset = E_NOTIMPL
End Function

Private Function IEnumVARIANT_Clone(ByRef This As TENUMERATOR, ByVal ppEnum As Long) As Long
    IEnumVARIANT_Clone = E_NOTIMPL
End Function

Private Function PtrAdd(ByVal Pointer As Long, ByVal Offset As Long) As Long
    PtrAdd = (Pointer Xor &H80000000) + Offset Xor &H80000000
End Function

Private Property Let DeRef(ByVal Address As Long, ByVal Value As Long)
    GetMem4 Value, ByVal Address
End Property

Private Property Let DLng(ByVal Address As Long, ByVal Value As Long)
    GetMem4 Value, ByVal Address
End Property

Private Property Let StrRef(ByRef Str As String, ByVal Value As Long)
    GetMem4 Value, ByVal VarPtr(Str)
End Property
Attached Files
↧
Search

[VB6] Registry Key Virtual type checker

November 13, 2017, 11:17 am
$
0
0
Hi,

this module allows to check whether Registry Key is:
- Shared
- Redirected
- Usual
- Symlink
And to show a target of symlink.

Note: Reflected type of keys (OS Vista and older only) are not considered.

RegGetKeyVirtualType() function returns a bitmask of KEY_VIRTUAL_TYPE enum.

Example of using is inside.
For most and reliable operation results elevated privilages required.
Code:
    Dim kvt As KEY_VIRTUAL_TYPE
    ...
    kvt = RegGetKeyVirtualType(HKLM, "SOFTWARE\Classes\AppID", sSymLinkTarget)
   
    If kvt And KEY_VIRTUAL_NOT_EXIST Then sKeyType = "Not exist"
    If kvt And KEY_VIRTUAL_USUAL Then sKeyType = "Usual"
    If kvt And KEY_VIRTUAL_SHARED Then sKeyType = "Shared"
    If kvt And KEY_VIRTUAL_REDIRECTED Then sKeyType = "Redirected"
    If kvt And KEY_VIRTUAL_SYMLINK Then sKeyType = sKeyType & " (Symlink)" & " -> " & sSymLinkTarget
    ...
References:
There is also a short article in Russian about such keys I wrote a long time ago, available here.

See also:
MSDN. Registry Keys Affected by WOW64
MSDN. Accessing an Alternate Registry View
MSDN. Registry Reflection
MSDN. [MS-RRP] Symbolic Links
Stefan Kuhr. Registry Symbolic Links creation tool.
Jeremy Hurren. Registry Filters and Symbolic Links
Paula Tomlinson. Understanding NT

I must warn that the table of virtual types for some keys presented on MSDN page is wrong.
Also, some information how to open and work with symlinks are incomplete. See my code on how to do it reliable.
Attached Files
↧
↧

VB6 - InkEdit and SelText

November 13, 2017, 2:41 pm
$
0
0
The InkEdit Control has many useful features, but when it comes to SelText, it does not behave like a normal TextBox. When recovering the text from a multiline InkEdit box, each line is separated by a vbCrLf (&H0D, &H0A). But the SelStart property only uses a vbCr (&H0D). So when you search for a character string, you will get an extra character for each line. This is my way around the problem, and there may be a better way.

Enter the string to search for in the upper TextBox and hit <Enter>. If the string is found, it will be highlit. To find the next instance, use <Ctrl-n>.

J.A. Coutts
Attached Images
 
Attached Files
↧

[VB6] INI file class (unicode aware)

November 16, 2017, 8:24 am
$
0
0
'Mainly intended for caching data beetween read-write operations
'Supports UTF-16 LE ini-files format
'Provides wide range of methods
'Doesn't support reading / saving commentary in ini file

Based on Scripting.Dictionary, see also:
#Const UseHashtable
#Const UseStringBuilder

Examples of using:
Code:

Option Explicit

Private Sub Form_Load()
    Dim Item

    'init
    Dim cIni As clsIniFile
    Set cIni = New clsIniFile

    'open ini file
    cIni.InitFile App.Path & "\some.ini", 1200 '1200 - UTF16-LE or 1251 (ANSI)

    'set case insensitive mode
    cIni.CompareMethod = vbTextCompare

    'write (or overwrite):
    '[Section1]
    'Param1=Data1
    'Param2=Data2
    cIni.WriteParam "Section1", "Param1", "Data1"
    cIni.WriteParam "Section1", "Param2", "Data2"

    'create empty section
    cIni.CreateSection "Section Empty1"
    cIni.CreateSection "Section Empty2"

    Debug.Print "Param1 = " & cIni.ReadParam("Section1", "Param1")
    Debug.Print "Number of parameters in Section1: " & cIni.CountParams("Section1")
    Debug.Print "Total sections: " & cIni.CountSections

    'does data 'Data1' exist in 'Section1' ?
    Debug.Print "Data2 exists? " & cIni.ExistData("Section1", "Data2")
    Debug.Print "param2 exists? " & cIni.ExistParam("Section1", "param2")

    Debug.Print "Currently loaded filename is: " & cIni.FileName

    'search for parameter name, which holds a 'Data2' in 'Section1'
    Debug.Print "Param name of 'Data2' is: " & cIni.GetParamNameByData("Section1", "Data2")

    'enum parameters' names
    For Each Item In cIni.GetParamNames("Section1")
        Debug.Print Item
    Next
    'enum data in section
    For Each Item In cIni.GetParamValues("Section1")
        Debug.Print Item
    Next
    'enum sections' names
    For Each Item In cIni.GetSections
        Debug.Print Item
    Next

    'to remove a parameter
    If cIni.RemoveParam("Section1", "Param2") Then Debug.Print "Param2 is removed successfully!"

    'to remove section
    If cIni.RemoveSection("Section Empty2") Then Debug.Print "'Section Empty2' is removed successfully!"

    'to remove all sections (erase file)
    'cIni.RemoveSectionsAll

    'populate physical file (all cached data will by written to the disk)
    cIni.Flush

    'when you finished work with the class
    Set cIni = Nothing

    Unload Me
End Sub

Result:
Quote:
Param1 = Data1
Number of parameters in Section1: 2
Total sections: 3
Data2 exists? True
param2 exists? True
Currently loaded filename is: H:\_AVZ\Íàøè ðàçðàáîòêè\_Dragokas\clsIniFile\some.ini
Param name of 'Data2' is: Param2
Param1
Param2
Data1
Data2
Section1
Section Empty1
Section Empty2
Param2 is removed successfully!
'Section Empty2' is removed successfully!
Attached Files
↧

[VB6] Always Behind / Always at the Bottom / Bottommost

November 16, 2017, 12:23 pm
$
0
0
The following code will put a Form always behind/at the bottom of all top-level windows. This is accomplished by processing the WM_WINDOWPOSCHANGING message.

Code:
Option Explicit    'In a standard .BAS module

Private Declare Function DefSubclassProc Lib "comctl32.dll" Alias "#413" (ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SetWindowSubclass Lib "comctl32.dll" Alias "#410" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long, Optional ByVal dwRefData As Long) As Long
Private Declare Function RemoveWindowSubclass Lib "comctl32.dll" Alias "#412" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long) As Long
Private Declare Sub PutMem4 Lib "msvbvm60.dll" (ByVal Ptr As Long, ByVal Value As Long)

Public Function Subclass(ByRef Frm As VB.Form) As Boolean
    Subclass = SetWindowSubclass(Frm.hWnd, AddressOf SubclassProc, ObjPtr(Frm))
End Function

Public Function UnSubclass(ByRef Frm As VB.Form) As Boolean
    UnSubclass = RemoveWindowSubclass(Frm.hWnd, AddressOf SubclassProc, ObjPtr(Frm))
End Function

Private Function SubclassProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal uIdSubclass As Long, ByVal dwRefData As Long) As Long
    Const WM_WINDOWPOSCHANGING = &H46&, HWND_BOTTOM = 1&, SIGN_BIT = &H80000000

    If uMsg <> WM_WINDOWPOSCHANGING Then
        SubclassProc = DefSubclassProc(hWnd, uMsg, wParam, lParam)
    Else
        PutMem4 (lParam Xor SIGN_BIT) + 4& Xor SIGN_BIT, HWND_BOTTOM    'WINDOWPOS.hWndInsertAfter = HWND_BOTTOM
    End If                                                              'Xor: Unsigned pointer arithmetic
End Function
Usage example:

Code:
Option Explicit    'In Form1

Private Sub Form_Load()
    Subclass Me
End Sub

Private Sub Form_Unload(Cancel As Integer)
    UnSubclass Me
End Sub
↧

VB6 - Activating Hyperlinks using InkEdit

November 16, 2017, 9:43 pm
$
0
0
I found code that activated Hyperlinks with VB6 and a RichTextBox. If was far more complex than I wanted because it used subclassing. So I converted it to use an InkEdit box without subclassing. The underlining of the hyperlinks worked quite nicely, but passing the link to the browser did not work with the InkEdit Control.

So I set out to simplify it and make the browser work. I was pleasantly surprised at how simple it turned out to be.
Code:
Option Explicit

Private Declare Function SendMessage Lib "user32" Alias "SendMessageW" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Private Sub cmdEnable_Click()
    Const EM_AUTOURLDETECT = &H45B
    SendMessage txtMessage.hWnd, EM_AUTOURLDETECT, 1, ByVal 0
    txtMessage.SetFocus
End Sub

Private Sub Form_Load()
    txtMessage.Text = "Sample text with link." & vbCrLf & vbCrLf _
        & "https://www.us-cert.gov/ncas/alerts/TA17-318A" & vbCrLf & vbCrLf _
        & "J.A.Coutts" & vbCrLf
End Sub
Private Sub Timer1_Timer()
    Timer1.Enabled = False
    Debug.Print txtMessage.SelText
    ShellExecute 0&, "open", txtMessage.SelText, 0, 0, 1
End Sub

Private Sub txtMessage_DblClick()
    Timer1.Enabled = True
End Sub
Requirements: One form with, one InkEdit Control(txtMessage), one Command button (cmdEnable), and one Timer (Timer1) set to 20 ms and disabled. The InkEdit box should be multiline, IEM_disabled, with vertical Scrollbars.

The above code comes complete with a sample hyperlink. Click the command button to underline the hyperlink with the default blue. Double Click the link to send it to your default browser. As with the Spell Check, it required a 20 ms delay to allow the hyperlink to be selected

J.A. Coutts
Attached Images
 
↧
↧

[vb6] Resource Image Viewer/Extraction

November 18, 2017, 6:21 am
$
0
0
A tool I developed to help with another project I'm working on. The tool worked well and decided to pretty it up and share it.

This is similar to your typical resource-hacker, but limited in scope to only resource images: icons, cursors, bitmaps, animated icons/cursors. You can view those that are contained in a binary (dll, exe, ocx, etc) and also contained in VB resource files (.res). Additionally, you can open a disk icon/cursor file for review.

There is an option to simulate DPI. This could be useful when you are viewing your own resource file and would like to see what your icons/cursors/bitmaps may look like if you declare your application DPI-aware.

The tool allows you to extract the viewed images to file. For icons/cursors that contain multiple images, you can individually select which are to be extracted and change the order they will appear in within the extracted file.

Also there is a filter option for image width, bit depth and whether icons/cursors include/exclude PNG-encoded images.

Tip: At top of the form, there is a m_AllowSubclassing boolean. Set this to false if you plan on walking through any code; otherwise, leave it to true. The subclassing occurs on three things:

1) The form itself to restrict minimal resizing
2,3) The picturebox and scrollbar to trap mouse wheel scrolling messages

Without the subclassing active, you can't use the mouse wheel for scrolling. The picturebox is coded for standard keyboard navigation.

Name: ss.jpg Views: 62 Size: 33.0 KB
Attached Images
 
Attached Files
↧

VB6 - Sample Tray Activation

November 21, 2017, 10:12 pm
$
0
0
Attached is a sample program that uses a Tray Icon to activate a program. It uses dilettante's "NotifyIcon" program.

http://www.vbforums.com/showthread.p...ght=notifyicon

I have left his explanations in the User Control intact. When first activated, the "Tray" program starts as a Icon in the system tray surrounded by red. A balloon will appear stating "Connecting to Server". It will normally time out, but I am using a timer to simulate establishing a connection. This causes the balloon to disappear and the red background on the Icon to also disappear. Moving the mouse over the Icon will show "Connected to Server". Ten seconds later, a second timer is used to simulate an incoming message, which will flash with instructions.

Clicking on the Tray Icon will activate a program called "Sample.exe". You will have to compile that program first before it can be activated.

To return the "Tray" program to it's normal state, or to exit the program, right click on the Tray Icon.

J.A. Coutts
Attached Files
↧
Search

[VB6] Registry Hives Enumerator

November 23, 2017, 2:56 pm
$
0
0
This is very specific, but maybe will be useful for some registry guy :)

In short:

if you need to build a ton of nested loops for:

just say, you have a task to enumerate:

1) several keys
2) in the same location of HKLM / HKCU / HKU + every SID
3) separately consider WOW6432Node (read value with KEY_WOW64_64KEY flag and without) + exclude one of 'shared' keys (keys that point to the same phisical location in both 64/32-bit modes).

you can fit all in 1 single cycle with this 'Hives Enumerator' class.

Example:

Here is your old code:
Code:

    sRegRuns(1) = "Software\Microsoft\Windows\CurrentVersion\Run"
    sDes(1) = "Run"

    sRegRuns(2) = "Software\Microsoft\Windows\CurrentVersion\RunServices"
    sDes(2) = "RunServices"

        '...

    For i = 0 To UBound(aHives) 'HKLM, HKCU, HKU()

        For Each UseWow In Array(False, True)

            If (bIsWin32 And UseWow) _
              Or bIsWin64 And UseWow And _
              (sHive = "HKCU" _
              Or StrBeginWith(sHive, "HKU\")) Then Exit For

            For K = LBound(sRegRuns) To UBound(sRegRuns)
Here is how it looks now with my class:

Code:

    Dim HE as clsHiveEnum
    Set HE = New clsHiveEnum
    '...

    sRegRuns(1) = "Software\Microsoft\Windows\CurrentVersion\Run"
    sDes(1) = "Run"

    sRegRuns(2) = "Software\Microsoft\Windows\CurrentVersion\RunServices"
    sDes(2) = "RunServices"

    '...

    HE.Init HE_HIVE_ALL, HE_SID_ALL, HE_REDIR_BOTH
    HE.AddKeys sRegRuns

    Do While HE.MoveNext

        'that's all :) Just use HE.Hive, HE.Key, HE.Redirected and many more...
    Loop
Or you can enum hives without keys. Just don't use HE.AddKeys.

Required:
Some enums to Global module: just to support quick IntelliSense tips.

Dependencies:
modRegVirtualType.bas (included)

Good luck :)
-----------------


Live example (attached as demo):

Code:

    Dim HE As clsHiveEnum
    Set HE = New clsHiveEnum

    Dim aKey(1) As String

    aKey(0) = "HKLM\Software\Classes\AppID"
    aKey(1) = "Software\Classes\CLSID"

    HE.Init HE_HIVE_HKLM Or HE_HIVE_HKU, HE_SID_ALL, HE_REDIR_BOTH

    HE.AddKeys aKey

    Do While HE.MoveNext
        Debug.Print " --------- "
        Debug.Print "Hive handle: " & HE.Hive
        Debug.Print "Hive name:  " & HE.HiveName
        Debug.Print "Hive + key:  " & HE.KeyAndHive
        Debug.Print "Key:        " & HE.Key
        Debug.Print "Redirected:  " & HE.Redirected
        Debug.Print "Array index: " & HE.KeyIndex
        Debug.Print "User name:  " & HE.UserName
    Loop

    Set HE = Nothing
Result:
Quote:
---------
Hive handle: -2147483646
Hive name: HKLM
Hive + key: HKLM\Software\Classes\AppID
Key: Software\Classes\AppID
Redirected: False
Array index: 0
User name: All users
---------
Hive handle: -2147483646
Hive name: HKLM
Hive + key: HKLM\Software\Classes\CLSID
Key: Software\Classes\CLSID
Redirected: True
Array index: 1
User name: All users
---------
Hive handle: -2147483646
Hive name: HKLM
Hive + key: HKLM\Software\Classes\CLSID
Key: Software\Classes\CLSID
Redirected: False
Array index: 1
User name: All users
---------
Hive handle: -2147483645
Hive name: HKU
Hive + key: HKU\.DEFAULT\Software\Classes\CLSID
Key: .DEFAULT\Software\Classes\CLSID
Redirected: False
Array index: 1
User name: Default user
---------
Hive handle: -2147483645
Hive name: HKU
Hive + key: HKU\S-1-5-19\Software\Classes\CLSID
Key: S-1-5-19\Software\Classes\CLSID
Redirected: True
Array index: 1
User name: Local service
---------
Hive handle: -2147483645
Hive name: HKU
Hive + key: HKU\S-1-5-19\Software\Classes\CLSID
Key: S-1-5-19\Software\Classes\CLSID
Redirected: False
Array index: 1
User name: Local service
---------
Hive handle: -2147483645
Hive name: HKU
Hive + key: HKU\S-1-5-20\Software\Classes\CLSID
Key: S-1-5-20\Software\Classes\CLSID
Redirected: True
Array index: 1
User name: Network service
---------
Hive handle: -2147483645
Hive name: HKU
Hive + key: HKU\S-1-5-20\Software\Classes\CLSID
Key: S-1-5-20\Software\Classes\CLSID
Redirected: False
Array index: 1
User name: Network service
Above, we requested:
1) for HE_HIVE_HKLM + HE_HIVE_HKU hives.
2) aKey(0) have exception: list HKLM only (see prefix "HKLM\...")
3) HE_SID_ALL
4) WOW + no WOW

We got:
1) only 1 iteration of aKey(0) -> HKLM\Software\Classes\AppID, because it is 'Shared' key. WOW mode is point to the same phisical location, so WOW iteration is skipped.
2) 2 iteration of aKey(1) of HKLM. 1 - WOW, 2 - No WOW.
3) 5 iterations of aKey(1) of HKU. 1 - .Default SID, 2 - S-1-5-19, 3 - S-1-5-20, where:
- HKU\.Default\Software\Classes\CLSID is not 'redirected' key, that's why only 1 iteration
- S-1-5-19 and S-1-5-20 ARE 'redirected' keys, that's why +2 iterations for each (WOW, no WOW)

Note: that class doesn't check and skip keys that are not exist (it is responsibility of caller).
E.g. if I'll create:
- HKEY_USERS\S-1-5-19\Software\Classes\Wow6432Node\CLSID
and remove:
- HKEY_USERS\S-1-5-19\Software\Classes\CLSID
class will produce 2 iterations (with .Redirected = 'true', and with 'false').

-----------------------------------

Detailed description of the class:

Common scheme of the cycle:
Code:
' {
'  1. Keys (if supplied)
'  {
'    2. HKLM / HKCU / HKU + every SID...
'    {
'      3. REDIR_WOW (redirected) / REDIR_NO_WOW
'    }
'  }
' }
Stages of using:

I. Required initialization:

Set global rule for iterator:
Code:
HE.Init [Hives], [opt_SIDs], [opt_WOW_Modes]
where every arg. is a sum of bits, available from Intellisense, e.g.:
Code:
HE.Init HE_HIVE_HKLM Or HE_HIVE_HKCU
[Hives]

Code:
    HE_HIVE_ALL - all
    HE_HIVE_HKLM - HKLM only
    HE_HIVE_HKCU - HKCU only
    HE_HIVE_HKU - HKU only
What properties are affected:
- .Hive
- .HiveName
- .HiveNameAndSID
- .KeyAndHive
- .UserName

[SIDs]
Code:
    HE_SID_ALL - all
    HE_SID_DEFAULT - HKU\.Default (target of HKU\S-1-5-18 symlink)
    HE_SID_SERVICE - mean HKU\S-1-5-19 (Local service) and HKU\S-1-5-20 (Network service)
    HE_SID_USER - mean other currently logged users, excepting current user (available as HKCU)
What properties are affected:
- .HiveNameAndSID
- .KeyAndHive
- .UserName
- .IsSidSystem
- .IsSidUser
- .IsSidDefault properties.

[WOW_Modes]
Code:
    HE_REDIR_BOTH - to iterate both WOW modes (checking for 'Shared' keys will be activated for this flag only)
    HE_REDIR_NO_WOW - NO_WOW only (64-bit keys)
    HE_REDIR_WOW - WOW only (32-bit keys)
    HE_REDIR_DONT_IGNORE_SHARED - ignore checking for 'Shared' type. Force iteratation of every WOW mode.
What properties are affected:
- .Redirected

2. Optional. Supply key (keys).

a) Supply array of keys:
Code:
HE.AddKeys string_array
What properties are affected:
- .Key
- .KeyAndHive
- .SharedKey
- .KeyIndex

b) Supply single key (or keys one by one with several .AddKey calls)

What properties are affected:
- .Key
- .KeyAndHive
- .SharedKey
- special excludes for hives.
Code:
HE.AddKey [Key], [opt_PostPlaceholder]
where:
[Key] is a key in any of 2 formats:
1) Key
2) Hive\Key

It's can be:
Quote:
Software\Classes\CLSID
HKLM\Software\Classes\AppID
HKEY_LOCAL_MACHINE\Software\Classes\AppID
In case, you prepended concrete "Hive" to key it will be treated as an exclude from global rule (e.g., HE.Init HE_HIVE_ALL): for such key, enumerator will return only concrete hive (HKLM in example above).

[opt_PostPlaceholder] - optional. Any text. Enumerator will append it to the .Key. You can use it in your cycle e.g., to replace with a data that was not known to you at the time of class initialization (e.g. to replace manually "{CLSID}" by real CLSID in different parts of key for different keys).


II. Beginning of enumeration.
Code:
Do while HE.MoveNext
        'use any HE property
Loop

III. Using of properties.

HE.Hive - hive handle (constant)
HE.Key - string, representing the key only, e.g. 'Software\Microsoft'
HE.Redirection - boolean, representing WOW mode (false - native key, true - 32-bit key).
HE.KeyAndHive - string, "Hive\Key"
HE.HiveName - string, short name of hive, e.g. "HKLM"
HE.HiveNameAndSID - string, e.g. "HKU\S-1-5-19"
HE.UserName - string:
- for HKLM - "All users"
- for HKCU - current user's name
- for HKU\S-1-5-19 - "Local service"
- for HKU\S-1-5-20 - "Network service"
- for HKU\.Default - "Default user"
- for HKU\S-some another SID - user's name of that SID
HE.KeyIndex - index of array passed to the class used in current iteration, e.g. need, if you track several linked arrays by its index, like array of keys + array of these keys' description and want to get description by index for current iteration (see first example above - for sDes() array it will be sDes(HE.KeyIndex) ).
HE.SharedKey - boolean. To know if this key have a 'shared' type, e.g. need, if you know that this key1 linked to another key2, so if key1 is 'Shared' and key2 is not, now you know e.g. that you need to pay attention on both WOW modes of key2.
HE.IsSidService - boolean. TRUE, if current iteration is on 'HKU\S-1-5-19' or, 'HKU\S-1-5-20'
HE.IsSidUser - boolean. TRUE, if current iteration is on 'HKU\S-Some custom logged user'
HE.IsSidDefault - boolean. TRUE, if current iteration is on 'HKU\.Default'

Methods:

PrintAll - test reason. To show in debug. window all properties of all iterations. Try play with it :)


IV. Optional steps.

Repeat enum.

If you need repeat enumeration again with the same settings:
Code:
HE.Repeat

Do While HE.MoveNext
'...

Erase / fresh enum:

Just use .Init again with the same or new settings.
It will erase all data supplied before. No need to terminate the class.
Attached Files
↧

VB6 - Very simple CoreAudio Demo (vbRichClient5)

November 24, 2017, 10:23 am
↧
↧

[RESOLVED] Why String Table

November 26, 2017, 9:28 am
$
0
0
Hi
What is the advantage of using string table resource than saving the string values in module defining Public?
↧

[VB6] Detect if process is hung

November 27, 2017, 7:55 am
$
0
0
It's a console application based on IsHungAppWindow API.

Syntax:

FreezeDetector.exe [opt_Filters]

Filters:
"IMAGENAME eq [Process name]"
"PID eq [Process ID]"

Note: All filters should be quoted

Examples:
FreezeDetector.exe without arguments - will list all processes with hung windows
FreezeDetector.exe "IMAGENAME eq my.exe" - check if my.exe process' window is hang
FreezeDetector.exe "PID eq 1234" - check if window of process with Process ID 1234 is hang.

Return exit code:
0 - was hang
1 - no hangs found.

Compatibility: Win2k+
Attached Files
↧

XML Parser (written entirely on VB6)

November 28, 2017, 4:39 pm
$
0
0
Author: Jason Thorn (Fork by Alex Dragokas)

There are 2 projects:

1) GUI
(activeX dll based)
compile vbXml-browser\Browser\Browser.vbg
Required: MSCOMCTL.OCX

2) Simple app (debug. window sample)
vbXml-simple\Project1.vbp

Some xml files samples are in 'xml-files' dir.

Classes allows to:
- read .XML files
- append nodes / attributes
- serialize back to .xml

Supported:
- all required special characters
- CDATA markup
- UTF-16 LE XML files format (however, it will be converted to ANSI)
- XML header
- reading tags' attributes

Currently not supported:
- Entities

P.S. There maybe some trouble with compilation GUI (vbg) caused by binary incompatibility. Maybe, someone help me to set project correctly.

PPS. Classes are not well tested. I'll be glag to get feedback.

Name: title.jpg Views: 101 Size: 23.7 KB

Feel free to use,
Good luck :)
Attached Images
 
Attached Files
↧
Viewing all 1517 articles
Browse latest View live
Search
<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>