Extra Info Storer User Control

August 23, 2017, 10:19 am

≫ Next: A little bit of MSDN .CHM files info

≪ Previous: Value Counter User Control

$

0

0

In-visible at run time, it can store up to 20 values per control for use in a program.

There are nothing on the form. It's not a container for other controls either.

How does it look inside the properties?


The Code:

Code:

---

'Default Property Values:
Const m_def_F1a = 0
Const m_def_F1b = 0
Const m_def_F2a = 0
Const m_def_F2b = 0
Const m_def_F3a = 0
Const m_def_F3b = 0
Const m_def_F4a = 0
Const m_def_F4b = 0
Const m_def_F5a = 0
Const m_def_F5b = 0
Const m_def_F6a = 0
Const m_def_F6b = 0
Const m_def_F7a = 0
Const m_def_F7b = 0
Const m_def_F8a = 0
Const m_def_F8b = 0
Const m_def_F9a = 0
Const m_def_F9b = 0
Const m_def_F0a = 0
Const m_def_F0b = 0
'Property Variables:
Dim m_F1a As Variant
Dim m_F1b As Variant
Dim m_F2a As Variant
Dim m_F2b As Variant
Dim m_F3a As Variant
Dim m_F3b As Variant
Dim m_F4a As Variant
Dim m_F4b As Variant
Dim m_F5a As Variant
Dim m_F5b As Variant
Dim m_F6a As Variant
Dim m_F6b As Variant
Dim m_F7a As Variant
Dim m_F7b As Variant
Dim m_F8a As Variant
Dim m_F8b As Variant
Dim m_F9a As Variant
Dim m_F9b As Variant
Dim m_F0a As Variant
Dim m_F0b As Variant

Public Property Get F1a() As Variant
  F1a = m_F1a
End Property

Public Property Let F1a(ByVal New_F1a As Variant)
  m_F1a = New_F1a
  PropertyChanged "F1a"
End Property

Public Property Get F1b() As Variant
  F1b = m_F1b
End Property

Public Property Let F1b(ByVal New_F1b As Variant)
  m_F1b = New_F1b
  PropertyChanged "F1b"
End Property

Public Property Get F2a() As Variant
  F2a = m_F2a
End Property

Public Property Let F2a(ByVal New_F2a As Variant)
  m_F2a = New_F2a
  PropertyChanged "F2a"
End Property

Public Property Get F2b() As Variant
  F2b = m_F2b
End Property

Public Property Let F2b(ByVal New_F2b As Variant)
  m_F2b = New_F2b
  PropertyChanged "F2b"
End Property

Public Property Get F3a() As Variant
  F3a = m_F3a
End Property

Public Property Let F3a(ByVal New_F3a As Variant)
  m_F3a = New_F3a
  PropertyChanged "F3a"
End Property

Public Property Get F3b() As Variant
  F3b = m_F3b
End Property

Public Property Let F3b(ByVal New_F3b As Variant)
  m_F3b = New_F3b
  PropertyChanged "F3b"
End Property

Public Property Get F4a() As Variant
  F4a = m_F4a
End Property

Public Property Let F4a(ByVal New_F4a As Variant)
  m_F4a = New_F4a
  PropertyChanged "F4a"
End Property

Public Property Get F4b() As Variant
  F4b = m_F4b
End Property

Public Property Let F4b(ByVal New_F4b As Variant)
  m_F4b = New_F4b
  PropertyChanged "F4b"
End Property

Public Property Get F5a() As Variant
  F5a = m_F5a
End Property

Public Property Let F5a(ByVal New_F5a As Variant)
  m_F5a = New_F5a
  PropertyChanged "F5a"
End Property

Public Property Get F5b() As Variant
  F5b = m_F5b
End Property

Public Property Let F5b(ByVal New_F5b As Variant)
  m_F5b = New_F5b
  PropertyChanged "F5b"
End Property

Public Property Get F6a() As Variant
  F6a = m_F6a
End Property

Public Property Let F6a(ByVal New_F6a As Variant)
  m_F6a = New_F6a
  PropertyChanged "F6a"
End Property

Public Property Get F6b() As Variant
  F6b = m_F6b
End Property

Public Property Let F6b(ByVal New_F6b As Variant)
  m_F6b = New_F6b
  PropertyChanged "F6b"
End Property

Public Property Get F7a() As Variant
  F7a = m_F7a
End Property

Public Property Let F7a(ByVal New_F7a As Variant)
  m_F7a = New_F7a
  PropertyChanged "F7a"
End Property

Public Property Get F7b() As Variant
  F7b = m_F7b
End Property

Public Property Let F7b(ByVal New_F7b As Variant)
  m_F7b = New_F7b
  PropertyChanged "F7b"
End Property

Public Property Get F8a() As Variant
  F8a = m_F8a
End Property

Public Property Let F8a(ByVal New_F8a As Variant)
  m_F8a = New_F8a
  PropertyChanged "F8a"
End Property

Public Property Get F8b() As Variant
  F8b = m_F8b
End Property

Public Property Let F8b(ByVal New_F8b As Variant)
  m_F8b = New_F8b
  PropertyChanged "F8b"
End Property

Public Property Get F9a() As Variant
  F9a = m_F9a
End Property

Public Property Let F9a(ByVal New_F9a As Variant)
  m_F9a = New_F9a
  PropertyChanged "F9a"
End Property

Public Property Get F9b() As Variant
  F9b = m_F9b
End Property

Public Property Let F9b(ByVal New_F9b As Variant)
  m_F9b = New_F9b
  PropertyChanged "F9b"
End Property

Public Property Get F0a() As Variant
  F0a = m_F0a
End Property

Public Property Let F0a(ByVal New_F0a As Variant)
  m_F0a = New_F0a
  PropertyChanged "F0a"
End Property

Public Property Get F0b() As Variant
  F0b = m_F0b
End Property

Public Property Let F0b(ByVal New_F0b As Variant)
  m_F0b = New_F0b
  PropertyChanged "F0b"
End Property

Private Sub UserControl_InitProperties()
  m_F1a = m_def_F1a
  m_F1b = m_def_F1b
  m_F2a = m_def_F2a
  m_F2b = m_def_F2b
  m_F3a = m_def_F3a
  m_F3b = m_def_F3b
  m_F4a = m_def_F4a
  m_F4b = m_def_F4b
  m_F5a = m_def_F5a
  m_F5b = m_def_F5b
  m_F6a = m_def_F6a
  m_F6b = m_def_F6b
  m_F7a = m_def_F7a
  m_F7b = m_def_F7b
  m_F8a = m_def_F8a
  m_F8b = m_def_F8b
  m_F9a = m_def_F9a
  m_F9b = m_def_F9b
  m_F0a = m_def_F0a
  m_F0b = m_def_F0b
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)

  m_F1a = PropBag.ReadProperty("F1a", m_def_F1a)
  m_F1b = PropBag.ReadProperty("F1b", m_def_F1b)
  m_F2a = PropBag.ReadProperty("F2a", m_def_F2a)
  m_F2b = PropBag.ReadProperty("F2b", m_def_F2b)
  m_F3a = PropBag.ReadProperty("F3a", m_def_F3a)
  m_F3b = PropBag.ReadProperty("F3b", m_def_F3b)
  m_F4a = PropBag.ReadProperty("F4a", m_def_F4a)
  m_F4b = PropBag.ReadProperty("F4b", m_def_F4b)
  m_F5a = PropBag.ReadProperty("F5a", m_def_F5a)
  m_F5b = PropBag.ReadProperty("F5b", m_def_F5b)
  m_F6a = PropBag.ReadProperty("F6a", m_def_F6a)
  m_F6b = PropBag.ReadProperty("F6b", m_def_F6b)
  m_F7a = PropBag.ReadProperty("F7a", m_def_F7a)
  m_F7b = PropBag.ReadProperty("F7b", m_def_F7b)
  m_F8a = PropBag.ReadProperty("F8a", m_def_F8a)
  m_F8b = PropBag.ReadProperty("F8b", m_def_F8b)
  m_F9a = PropBag.ReadProperty("F9a", m_def_F9a)
  m_F9b = PropBag.ReadProperty("F9b", m_def_F9b)
  m_F0a = PropBag.ReadProperty("F0a", m_def_F0a)
  m_F0b = PropBag.ReadProperty("F0b", m_def_F0b)
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)

  Call PropBag.WriteProperty("F1a", m_F1a, m_def_F1a)
  Call PropBag.WriteProperty("F1b", m_F1b, m_def_F1b)
  Call PropBag.WriteProperty("F2a", m_F2a, m_def_F2a)
  Call PropBag.WriteProperty("F2b", m_F2b, m_def_F2b)
  Call PropBag.WriteProperty("F3a", m_F3a, m_def_F3a)
  Call PropBag.WriteProperty("F3b", m_F3b, m_def_F3b)
  Call PropBag.WriteProperty("F4a", m_F4a, m_def_F4a)
  Call PropBag.WriteProperty("F4b", m_F4b, m_def_F4b)
  Call PropBag.WriteProperty("F5a", m_F5a, m_def_F5a)
  Call PropBag.WriteProperty("F5b", m_F5b, m_def_F5b)
  Call PropBag.WriteProperty("F6a", m_F6a, m_def_F6a)
  Call PropBag.WriteProperty("F6b", m_F6b, m_def_F6b)
  Call PropBag.WriteProperty("F7a", m_F7a, m_def_F7a)
  Call PropBag.WriteProperty("F7b", m_F7b, m_def_F7b)
  Call PropBag.WriteProperty("F8a", m_F8a, m_def_F8a)
  Call PropBag.WriteProperty("F8b", m_F8b, m_def_F8b)
  Call PropBag.WriteProperty("F9a", m_F9a, m_def_F9a)
  Call PropBag.WriteProperty("F9b", m_F9b, m_def_F9b)
  Call PropBag.WriteProperty("F0a", m_F0a, m_def_F0a)
  Call PropBag.WriteProperty("F0b", m_F0b, m_def_F0b)
End Sub

---

No extra coding to dimension fields or declaring of values etc.
Plain and simple.

Attached Images

 

---

A little bit of MSDN .CHM files info

August 24, 2017, 9:14 am

≫ Next: Home Budget-Slip System

≪ Previous: Extra Info Storer User Control

$

0

0

I did this this afternoon, for myself and others. Just an idea - nothing fancy:



The form (only one), with the .frx with pictures and icon: Project MSDN.zip

The main code to load the .chm file was not mine, but was taken from this site. I see the code here posted in 2004 by someone (http://www.vbforums.com/showthread.p...t=shellexecute #2, by RobDog888).

...which was then changed by Shaitan00 #3, which I took and inserted into my program:

Code:

---

By RobDog888
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 Const SW_SHOWNORMAL As Long = 1
Private Const SW_SHOWMAXIMIZED As Long = 3
Private Const SW_SHOWMINIMIZED As Long = 2

& by: Shaitan00

Dim lRet As Long
lRet = ShellExecute(Me.hwnd, vbNullString, "Help.pdf", vbNullString, "C:\", SW_SHOWNORMAL)

---

The rest was just magic - on the outside :D

Attached Images

 

Attached Files

• Project MSDN.zip (8.5 KB)

Home Budget-Slip System

August 26, 2017, 4:02 am

≫ Next: [VB6] Speech Recognition via SAPI

≪ Previous: A little bit of MSDN .CHM files info

$

0

0

My first successful home budget program written was back in QuickBasic 7, in the late 1980's and Early 1990's.

The name "Law" stick from the first time till now.

I upgraded (actually, re-written) to VB3 in the old Win 3.11 system and when Win98 came along, I upgraded it to VB5 and later change a bit here-and-there to VB6.

The face did not changed a lot over these years, but currently have changed (still busy) it completely, re-building everything in some of the forms.

Some people who (try) to use it says it's too difficult, but a recent acquaintance who is in business for more than 30 years feels this is exactly what he need.

There's a smaller, quicker version I wrote for my wife, in a similar layout but with only a few pages (forms), but that will be discussed later.

So, before I change everything and forget what I have done, let me give this one for you.

There are still some errors (after all this time :) ), as can been seen in the Accumulative and Report form...

(( Uncle Sam Brown (and many others) will hate this code... :D :D ))

LAW8: (Yes, the .vbp says LAW9)


Law9.zip

Attached Images

 

Attached Files

• Law9.zip (142.0 KB)

[VB6] Speech Recognition via SAPI

August 27, 2017, 3:07 pm

≫ Next: VB6 2D Physic Engine

≪ Previous: Home Budget-Slip System

$

0

0

This is a trivial demo of bare bones use of SAPI for speech recognition.

The documentation can be found at MSDN:

Automation Interfaces and Objects (SAPI 5.4)

There is much more you can do than is shown in this tiny example, which uses the first audio input source found and uses defaults for many other things (such as free dictation).

Code:

---

Option Explicit

'See "Automation Interfaces and Objects (SAPI 5.4)" at MSDN.

Private WithEvents RC As SpeechLib.SpInProcRecoContext
Private RG As SpeechLib.ISpeechRecoGrammar

Private Sub Form_Load()
    With New SpeechLib.SpInprocRecognizer
        Set RC = .CreateRecoContext()
        Set .AudioInput = .GetAudioInputs().Item(0)
    End With
    With RC
        .EventInterests = SRERecognition Or SREFalseRecognition
        Set RG = .CreateGrammar()
    End With
    RG.DictationSetState SGDSActive
End Sub

Private Sub Form_Resize()
    If WindowState <> vbMinimized Then
        Text1.Move 0, 0, ScaleWidth, ScaleHeight
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    RG.DictationSetState SGDSInactive
End Sub

Private Sub RC_FalseRecognition( _
    ByVal StreamNumber As Long, _
    ByVal StreamPosition As Variant, _
    ByVal Result As SpeechLib.ISpeechRecoResult)

    With Text1
        .SelStart = &H7FFF
        .SelText = "False Rec: "
        .SelText = Result.PhraseInfo.GetText()
        .SelText = vbNewLine
    End With
End Sub

Private Sub RC_Recognition( _
    ByVal StreamNumber As Long, _
    ByVal StreamPosition As Variant, _
    ByVal RecognitionType As SpeechLib.SpeechRecognitionType, _
    ByVal Result As SpeechLib.ISpeechRecoResult)

    With Text1
        .SelStart = &H7FFF
        .SelText = "Rec: "
        .SelText = Result.PhraseInfo.GetText()
        .SelText = vbNewLine
    End With
End Sub

---

SAPI 5.4 requires the dying Windows 7 or later. SAPI 5.3 is highly compatible on the dead Windows Vista. Those are part of Windows and preinstalled. You may limp along even on the dead Windows XP, 98, 2000, etc. if you install the SAPI 5.1 SDK. SAPI 5.2 was a special release only used on an old MS Speech Server product.

Attached Images

 

Attached Files

• Speech Recognition.zip (1.7 KB)

VB6 2D Physic Engine

August 29, 2017, 2:24 pm

≫ Next: URL Save

≪ Previous: [VB6] Speech Recognition via SAPI

$

0

0

VB6 port of 2D Impulse Engine
by Randy Gaul:
http://www.randygaul.net/projects-op...mpulse-engine/
and Philip Diffenderfer:
https://github.com/ClickerMonkey/ImpulseEngine

+ (Experimental) Joints by the Author

Author: Roberto Mior (aka reexre,miorsoft)
Contibutors: yet none.

Never found a VB6 implementation of a simple 2D physic engine. So I come to a VB6 version starting from
Randy Gaul 2D impulse engine (and Philip Diffenderfer java port).

I also added other things such as

• +Joints (Not so perfect, look for someone to suggest better implementation)
• +Collision Groups (To make some objects not collide with every objects)
• +collsions callback events
• +Polygon Chamfer

This is the old thread of this project , Since it works quite well I decided to put it in the CodeBank session.
Now instead of a number of modules I compacted them to 1 class and 1 module.

Suggestions and improvements are wellcome !


(Later I'll put the code on GitHub)


Requires:
* vbRichClient (for Render) http://vbrichclient.com/#/en/About/


LICENSE: BSD. This allows you to use its source code in any application, commercial or otherwise,
if you supply proper attribution. Proper attribution includes a notice of copyright and disclaimer
of warranty. (https://opensource.org/licenses/BSD-2-Clause)


Copyright © 2017 by Roberto Mior (Aka reexre,miorsoft)

Attached Files

• VB6-2DPhysicEngine.zip (29.4 KB)

URL Save

September 3, 2017, 9:29 pm

≫ Next: W10 Accounts

≪ Previous: VB6 2D Physic Engine

$

0

0

A program I written a while back, which can save all the important (and not :) ) URL's.

Especially needed to have these URL's at hand when re-installing windows, moving to a new pc or for whatever reason.

Simple code. Straight forward. Nothing special. It's all about the idea.

Included RTF help.



The Program:
URL Save.zip

Attached Images

 

Attached Files

• URL Save.zip (67.3 KB)

W10 Accounts

September 3, 2017, 10:04 pm

≫ Next: [VB6, Vista] List the Recycle Bin location(s) on a drive

≪ Previous: URL Save

$

0

0

When we grow older we tend to forget passwords and user names etc.

Not entirely true. In this day and age, when roaming the internet and became part and participate within the w.w.w. , we create so many different accounts, passwords etc. we WILL forget some of the less-used passwords and/or accounts.

Some users use programs that store these info for them, but are you sure some info is not send when on-line with such so-and-so-password-storer program?

This was the solution to my own security problems.
A program originally written for "Need for speed world" accounts (which I have a lot of :) ), and later it become part of my everyday internet life:

W10 Accounts:


The program:
W10 Accounts.zip

Attached Images

 

Attached Files

• W10 Accounts.zip (9.3 KB)

[VB6, Vista] List the Recycle Bin location(s) on a drive

September 4, 2017, 8:52 am

≫ Next: VB6 - JACMail V3

≪ Previous: W10 Accounts

$

0

0

Hard coded paths aren't the best system, since they change from Windows version to version. So AAraya was asking about how to do this, and after seeing a StackOverflow and OldNewThing post about using IPersist to get the class ID of a folder, I wrote this in response. The code guarantees that the locations returned are the current, official system bin locations. Note that, especially on non-system drives, a Recycle Bin location may only exist when there are files in it, so if you don't get any results it doesn't mean that there won't be the next time you delete a file on that drive.

Main Code

This project wraps a single main function, FindRecycleBinsOnDrive:

Code:

---

Private Declare Function ILCreateFromPathW Lib "shell32" (ByVal pwszPath As Long) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal PV As Long) ' Frees memory allocated by the shell
Private Declare Function SysReAllocString Lib "oleaut32.dll" (ByVal pBSTR As Long, Optional ByVal pszStrPtr As Long) As Long
Private Declare Function SHCreateItemFromParsingName Lib "shell32" (ByVal pszPath As Long, pbc As Any, riid As UUID, ppv As Any) As Long

Private Function FindRecycleBinsOnDrive(sDrive As String) As String()
Dim pItem As IShellItem
Dim penum1 As IEnumShellItems, penum2 As IEnumShellItems
Dim pChild As IShellItem, pChild2 As IShellItem
Dim lpPath As Long, sPath As String
Dim sParent As String
Dim n As Long
Dim pcl As Long, pcl2 As Long
Dim gid As oleexp.UUID
Dim pPersist As oleexp.IPersist
Dim lAtr As SFGAO_Flags
Dim sOut() As String
ReDim sOut(0)

Call SHCreateItemFromParsingName(StrPtr(sDrive), ByVal 0&, IID_IShellItem, pItem)

If (pItem Is Nothing) = False Then
  pItem.BindToHandler ByVal 0&, BHID_EnumItems, IID_IEnumShellItems, penum1
  Do While penum1.Next(1&, pChild, pcl) = S_OK
        pChild.GetAttributes SFGAO_FOLDER Or SFGAO_HIDDEN Or SFGAO_SYSTEM, lAtr
        If ((lAtr And SFGAO_FOLDER) = SFGAO_FOLDER) And ((lAtr And SFGAO_HIDDEN) = SFGAO_HIDDEN) And ((lAtr And SFGAO_SYSTEM) = SFGAO_SYSTEM) Then
            pChild.BindToHandler ByVal 0&, BHID_EnumItems, IID_IEnumShellItems, penum2
            Do While penum2.Next(1&, pChild2, pcl2) = S_OK
                pChild2.BindToHandler ByVal 0&, BHID_SFObject, IID_IPersist, pPersist
                If (pPersist Is Nothing) = False Then
                  pPersist.GetClassID gid
                  pChild2.GetDisplayName SIGDN_DESKTOPABSOLUTEPARSING, lpPath
                  If IsEqualGUID(gid, CLSID_RecycleBin) Then
                      pChild2.GetDisplayName SIGDN_FILESYSPATH, lpPath
                      ReDim Preserve sOut(n)
                      sOut(n) = LPWSTRtoStr(lpPath)
                      n = n + 1
                  End If
                End If
            Loop
        End If
    Loop
Else
    Debug.Print "Failed to get drive object"
End If

FindRecycleBinsOnDrive = sOut
End Function

Private Function CLSID_RecycleBin() As UUID
'{645ff040-5081-101b-9f08-00aa002f954e}
Static iid As UUID
 If (iid.Data1 = 0) Then Call DEFINE_UUID(iid, &H645FF040, CInt(&H5081), CInt(&H101B), &H9F, &H8, &H0, &HAA, &H0, &H2F, &H95, &H4E)
 CLSID_RecycleBin = iid
End Function

Private Function LPWSTRtoStr(lPtr As Long, Optional ByVal fFree As Boolean = True) As String
SysReAllocString VarPtr(LPWSTRtoStr), lPtr
If fFree Then
    Call CoTaskMemFree(lPtr)
End If
End Function

---

The code increases efficiency by only examining folders that have the properties of the Recycle Bin, a folder with the Hidden and System attributes.

Alternative Method

I had also written a different method to get the top level bin names. This method uses the KnownFolderManager class to enumerate (just the first level of) files in the Recycle Bin virtual object (which includes all the physical locations on different drives), and then get the top level bin folders of all drives at once:

Code:

---

Private Sub EnumRecycleBinPaths(sBinPaths() As String)
Dim kfm As New KnownFolderManager
Dim pk As IKnownFolder
Dim pItem As IShellItem
Dim penum1 As IEnumShellItems
Dim pChild As IShellItem
Dim lpPath As Long, sPath As String
Dim sParent As String
Dim n As Long
Dim pcl As Long

ReDim sBinPaths(0)
kfm.GetFolder FOLDERID_RecycleBinFolder, pk
If (pk Is Nothing) = False Then
  pk.GetShellItem KF_FLAG_DEFAULT, IID_IShellItem, pItem
  pItem.BindToHandler ByVal 0&, BHID_EnumItems, IID_IEnumShellItems, penum1
  Do While penum1.Next(1&, pChild, pcl) = S_OK
        pChild.GetDisplayName SIGDN_FILESYSPATH, lpPath
        sPath = LPWSTRtoStr(lpPath)
        sParent = Left$(sPath, 3)
        sPath = Mid$(sPath, 4)
        sParent = sParent & Left$(sPath, InStr(sPath, "\"))
        arr_add_dedupe sBinPaths, sParent
    Loop
End If

End Sub
Private Sub arr_add_dedupe(sAr() As String, sNew As String)
Dim i As Long
For i = 0 To UBound(sAr)
    If sAr(i) = sNew Then Exit Sub
Next
Debug.Print "New entry=" & sNew
If (UBound(sAr) = 0) And (sAr(0) = "") Then
    sAr(0) = sNew
Else
    ReDim Preserve sAr(UBound(sAr) + 1)
    sAr(UBound(sAr)) = sNew
End If
End Sub

---

This method is simpler, but might be slower if you have tens of thousands of items in the root of your recycle bin (like Plex does).

Requirements
-Windows Vista or newer (you can get to IPersist while enumerating with IShellFolder, if you really needed to do this on XP)
-oleexp.tlb v4.0 or higher
-oleexp AddOn mIID.bas (included in oleexp download)

Attached Files

• EnumRecycleBin.zip (2.7 KB)

---

VB6 - JACMail V3

September 5, 2017, 9:29 pm

≫ Next: [VB6, Vista+] Enumerate, explore, and change all file associations

≪ Previous: [VB6, Vista] List the Recycle Bin location(s) on a drive

$

0

0

JACMail Version 3.0 is very similar to previous Versions. I have abandoned attempts to add encryption to Email service, as TLS 1.0/1.1 is no longer supported on many servers. TLS 1.2 supports ECC (Elliptical Curve Cryptography), which is what I want to use because it avoids having to store keys. Unfortunately I have not yet found a way to recover the Raw Agreed Secret to support TLS 1.2 using CNG. The current Email standards are ancient and difficult to work with. It does not easily support encryption or non-latin character sets, and the lack of authentication allows the proliferation of unsolicited email and malware. Because of the large installed base of MTAs, previous attempts to upgrade it have failed. Therefore, I have removed encryption from JACMail, and I am currently concentrating on a private email service using ECC and authentication. JACMail V3 uses SimpleSock, which makes it faster.

JACMail is an Email Client Program designed to allow fast and efficient recovery of email from a POP3 server, and the sending of email through an SMTP server. It is primarily oriented towards text based messaging with attachments, and does not directly support highly formatted HTML based email or embedded objects. It receives and stores both text/plain and text/html messages, and Web based emails (HTML) can be sent to your default browser for viewing. It also supports Plain Authentication based POP3 and multiple mailboxes. The mailboxes are stored in an Access database utilizing ODBC.

The code uses IP Version independent system calls, so it will only work on Windows systems that actively support both IPv4 and IPv6. That more or less restricts it to Windows Vista or later. It has been tested on Windows Vista, Win 7, Win 8.1, and Win 10, and utilizes the following standard components and references:
RICHED32.DLL
RICHTX32.OCX
COMDLG32.OCX
MSSTDFMT.DLL
MSBIND.DLL
MSADODC.OCX
MSDATGRD.OCX
which the user must have available in order to compile the program.

J.A. Coutts

Attached Images

 

Attached Files

• JACMail3.zip (74.1 KB)

[VB6, Vista+] Enumerate, explore, and change all file associations

September 11, 2017, 6:16 pm

≫ Next: VB6 - Program Communication

≪ Previous: VB6 - JACMail V3

$

0

0

File Associations

This program is similar to the Default Programs control panel applet. It scans the registry for all registered file extensions, then uses the AssocCreate API and IQueryAssociations interface to get further information. The icons are then loaded through SHGetFileInfo and added to the ListView. There's several methods to change the associations-- through the IAssocHandler interface, that lists the recommended programs you see in the Open With dialog; just click a program on the menu and it becomes the new default, updating Windows, next there's the Open With dialog, SHOpenWithDialog, which you can call passing only a file extension to change the default for all files of that type. However, this functionality is no longer available on Windows 10, because MS just loves taking away user control of the OS: you *have* to use the Control Panel to do it on Windows 10, so using the IOpenControlPanel interface we can at least send the user straight to the correct page. Note that this works on Vista/7/8 too; it's just that on Win10 it's the only way, but you can open that control panel page on earlier systems too.

AssocCreate

This function requires quite a bit of effort to be called through VB. It was declared in the original olelib, but that declare will not work (I'll fix it in a future version, but for now it has to be declared in a module). The CLSID parameter *must* be ByVal, but you can't send a user type ByVal. This even though the RIID parameter, which uses the same type (a GUID), *can* be passed ByRef. Passing VarPtr is not accepted, so the natural alternative is to pass each member of the struct ByVal. However, that still doesn't work, you get a "Bad DLL Calling Convention" error. The only way to do this is to rearrange a GUID, Long-Int-Int-Byte x8, into 4 Longs. Doing it this way works, and the interface is created:

Code:

---

Public Declare Function AssocCreate Lib "shlwapi" (ByVal CLSIDd1 As Long, ByVal CLSIDd23 As Long, _
                                                ByVal CLSIDd40123 As Long, ByVal CLSIDd44567 As Long, riid As UUID, ppv As Any) As Long


Dim pQA As IQueryAssociations
Dim lData1 As Long
Dim lData23 As Long
Dim lData40123 As Long
Dim lData44567 As Long
Dim ab() As Byte
ReDim ab(15)
Dim tCLSID As UUID
tCLSID = CLSID_QueryAssociations
CopyMemory ab(0), tCLSID, 16&
CopyMemory lData1, ab(0), 4& '0 1 2 3
CopyMemory lData23, ab(4), 4& '4 5 6 7
CopyMemory lData40123, ab(8), 4& '8 9 10 11
CopyMemory lData44567, ab(12), 4& '12 13 14 15
AssocCreate lData1, lData23, lData40123, lData44567, IID_IQueryAssociations, pQA

---

From there we can proceed to call whatever we need.

Code:

---

    pQA.Init 0&, sExt, 0&, Me.hwnd
    pQA.GetString 0&, ASSOCSTR_FRIENDLYDOCNAME, sVerb, sBuf, lp

---

and so on.

Some types appear in the registry but actually don't have handlers, so an error is thrown and it won't appear in the list. Another issue is with certain media files that have 'Play' as their default verb. Even Windows itself doesn't handle this properly, so we do the best we can. It will show the icon and the description, but like the control panel will say 'Unknown application' for opening it, even though the Play verb is being used and it works when you double click it.

The menu with the other default program choices you might recognize as mostly the code from my first project about file associations, [VB6] List/Execute File Handlers: IAssocHandler and IAssocHandlerInvoker (Vista+). Generating that menu adds quite a bit of code, but it's all just from that first project, and can be easily cut out by simply removing the GenerateOpenWithMenu submenu.

Finally, as a bonus, this project includes a new modular definitions BAS, for menus. I got tired of having to sift through which declares were needed, so like other controls menus now have a drop-in module that covers it all. The ListView/Header and ImageList modular definitions are also used.

Requirements
-Windows Vista or newer
-oleexp.tlb v4.0 or higher (only needed for the IDE, it gets compiled into your exe)
-oleexp addon mIID.bas (included in the oleexp download)

Attached Files

• AssocList.zip (35.5 KB)

VB6 - Program Communication

September 11, 2017, 9:56 pm

≫ Next: Open files in vb5

≪ Previous: [VB6, Vista+] Enumerate, explore, and change all file associations

$

0

0

There are numerous examples of SendMessage useage, and this is my version of communication between 2 programs. The basics came from "www.TheScarms.com", and were adapted to provide a way to issue instructions from one program to another, and pass the results back. The use of a data structure

Code:

---

Private Type COPYDATASTRUCT
    dwData As Long  ' Use this to identify your message
    cbData As Long  ' Number of bytes to be transferred
    lpData As Long  ' Address of data
End Type

---

provides the ability to identify different types of messages. In this example, I have used the type identifier to distinguish between integer, long, and string variables, but it could be used to identify anything.

J.A. Coutts

Attached Files

• Pcomm.zip (5.5 KB)

Open files in vb5

September 13, 2017, 8:09 pm

≫ Next: Add a little Pizazz to Your Menus & Toolbar Dropdowns

≪ Previous: VB6 - Program Communication

$

0

0

Hi
I have multiple word and excel 2007 files on desktop in a folder and would like to view them in a list box and subsequently open any of the file through button after selected.
Two problems are coming up:
1----- Doc and xls files are not coming in List box together; only doc files are visible?
2----- After selecting file in List box and pressing button an error message pop up Run time error 424 and beneath it "Object Required".
below link

https://1drv.ms/f/s!ApB75VvFFQtogTE9mIiVnpcql4Li

is for the files to view coding.

regards

AM

Add a little Pizazz to Your Menus & Toolbar Dropdowns

August 23, 2017, 6:57 am

≫ Next: VB6 - Heart Beat

≪ Previous: Open files in vb5

$

0

0

Here's a project to add Menu Bitmaps and Toolbar Dropdown bitmaps.
I have included a companion project to create menu bitmaps (14x14) from
other graphic file types and icons (24 bit & lower)

Enjoy.

Attached Images

 

Attached Files

• Popup.zip (21.0 KB)

VB6 - Heart Beat

September 23, 2017, 9:08 pm

≫ Next: VB6 Flickr API - Open To Everyone

≪ Previous: Add a little Pizazz to Your Menus & Toolbar Dropdowns

$

0

0

There are many reasons that a TCP connection can be lost, not the least of which is the NAT router that it might sit behind. In my ongoing efforts to develop a private mail system, I needed to know if a client was still connected to the server. There was also a need to provide for a Client to connect to the server when it becomes available. So I developed a Heart Beat system.

This is a dual purpose system. In the examples I have provided, the Client includes a timer that is set to activate every 5 time slots. Normally the time slot would be 60 seconds (1 minute), but for testing I reduced it to 10 seconds. If the client is not currently connected to the server, it will attempt to connect. If it is already connected to the server, then it sends a Heart Beat packet to signal to the server that it is still alive and connected.

The server in essence ignores the packet, except that it increments a counter. The server also contains a timer, but this one activates every 10 time slots. If the Client has not sent any traffic in the last 10 time slots, the counter is zero and it is disconnected.

J.A. Coutts

Attached Files

• HeartBeat.zip (30.1 KB)

VB6 Flickr API - Open To Everyone

September 27, 2017, 1:21 pm

≫ Next: [vb6] Overcoming LoadResPicture (ICON/CURSOR) Limitations in IDE

≪ Previous: VB6 - Heart Beat

$

0

0

Hi all dear fellows VB6 Programmers,

A bit of introduction:
Sometime ago, I ventured to develop a module to my Document Management System.
With this module I could manage my own photographs, by indexing my own data fields, storing (in a structured local folders), adding Keywords(Tags) from about 1M ISO standardized keywords tree, adding geolocation (Google Maps Integration), saving IPCT/Exif (exiftool) Copyright and Data into image file, uploading the image to Flickr, keeping track of views, faves, comments and my photos chosen to be featured in the Flickr Explorer and/or galleries, and lastly keeping a backup of it all locally and in the cloud. Also, I wanted to manage my Flickr contacts’ photos updates, photos I’ve viewed, skipped or faved/commented.
At that point in time, I did a strenuous research into flickr’s API but ended up without any reference material for VB6, the only one reference I found was a Flickr’s group which seemed to be dead since 2008 (I think), apart from that I could not find anything to start from, and my last resource was using the browser-control to collect/process the data I required for doing all this stuff. A couple of weeks ago I started a thread in this forum asking for help to solve an issue, what leaded me to another thread from another user; When user Olaf Schmidt came up with one solution that would open the possibility to me to use the proper Flickr’s API rather than using “Tricks” to collect data. Anyway, the only one bad side, Olaf was proposing to use his proprietary Library, what I did not like.

Since then, I’m working in this class module that allows me to use Flickr’s API without any external 3rd party libraries. So, my idea is to share with who might be interested. This thread is open to anyone who want to participate sharing and helping in this little task.
The following code is free to you use as you will, but I hope that if you learn something new you come back and share with us.

This is the version 0 and cover only 3 flickr’s methods, but soon, I hope, we will cover all Flickr’s API methods.

Is there any VB6 developer who also love photography and has it as a hobby (or alternative business?)?

So, here we go,

Thanks to all you guys who replied to my threads, posted positive comments and helped me to take this step.

Thanks for any feedbacks, critiques and suggestions.
MBS.

 

Code:

---

'*******************************
'PROJECT REFERENCES: MICROSOFT XML 6.0 (msxml6.dll)
'*******************************

'*******************************
' DECLARATIONS
Public c_FlickrAPI As New Flickr_API_Class
Public flickr_APIkey As String

Public xXML As New MSXML2.DOMDocument
Public xXML_Parsed As New MSXML2.DOMDocument
Public xml_Nodes As MSXML2.IXMLDOMNodeList
Public xml_Node As MSXML2.IXMLDOMNode

Private Sub Form_Load()

    flickr_APIkey = "6a669c22eae9c3cc0c4bc67a26f2b1ce"
    ' YOU WILL NEED YOUR OWN APIKEY
    ' OR USE A TEMPORAY KEY LIKE THE ONE ABOVE, THESE TEST APIKEY ONLY WORKS UNTIL 23:59h OF THE DAY YOU ACQUIRED IT
    ' TO GET A TEMPORAY APIKEY
    ' 1 - GO TO: https://www.flickr.com/services/api/explore/flickr.test.echo
    ' 2 - CHECK THE OPTION: [Sign call with no user token?]
    ' 3 - HIT [CALL METHOD]
    ' 4 - RETRIEVE THE APIKEY FROM THE RESPONSE
    '<api_key>6a669c22eae9c3cc0c4bc67a26f2b1ce</api_key>

    FlickerExplorer
   
End Sub

Private Sub FlickerExplorer()

    ' BASICLY CALLING THE FLICKR API FUNCTIONS / METHODS ARE ALL THE SAME, FIND NEXT HOW TO
   
    ' CALLING THE flickr_Explorer_GetPhotos from FLICKR APIs

    xXML.loadXML c_FlickrAPI.flickr_Explorer_GetPhotos()
    Set xml_Nodes = xXML.SelectNodes("/methodResponse/params/param/value/string")
   
    If xml_Nodes Is Nothing Then Stop ' DID NOT GET THE NODES PROPERLY
    If InStr(1, xXML.Text, "faultCode") <> 0 Then Stop ' SOMETHING ELSE WENT WRONG
   
    ' THE XML-RPC STORE THE XML DATA INTO A [escaped-xml-payload] WITHIN THE [string] NODE
    ' SO WE GET THE FULL XML TO PARSE THE ROOT NODES AND THEN LOADXML FROM THE XML.TEXT,
    ' TO GET THE PARSED XML WITH PHOTOS NODES.
    '
    ' OF COURSE YOU CAN CODE A FUNCTION/SUB TO DO IT, I DID NOT DO IT YET, BECAUSE I'M TOO LAZY LOL
    ' THE XML-RPC STRUCTURE CAN BE FOUND HERE: https://www.flickr.com/services/api/response.xmlrpc.html

    xXML_Parsed.loadXML xml_Nodes.Item(0).Text
    Set xml_Nodes = xXML_Parsed.SelectNodes("/photos/photo")
   
    If xml_Nodes Is Nothing Then Stop ' DID NOT GET THE NODES PROPERLY
    If InStr(1, xXML.Text, "faultCode") <> 0 Then Stop ' SOMETHING ELSE WENT WRONG
   
    For Each xml_Node In xml_Nodes
       
        ' TO GET ITEMS DATA JUST CALL xml_Node.SelectSingleNode AS FOLLOW
       
        vm_PHOTOID = xml_Node.SelectSingleNode("@id").Text ' PHOTO/ITEM ID
        If Not IsNumeric(vm_PHOTOID) Then Stop 'SOMETHING WENT WRONG
       
        vm_UserID = xml_Node.SelectSingleNode("@owner").Text ' ITEM USER OWNER
        If InStr(1, vm_UserID, "@") = 0 Then Stop  'SOMETHING WENT WRONG
       
        vm_URLtIMG = xml_Node.SelectSingleNode("@url_t").Text 'ITEM THUMBNAIL URL

        vm_TITIMG = xml_Node.SelectSingleNode("@title").Text 'ITEM TITLE
       
    Next
End Sub

---

Code:

---

'*************************************************
' FLICKR API LIBRARY: NAME: Flickr_API_Class
' BY: MBS - ON: 27/09/2017
' LICENSE: DO WHATEVER YOU WANT TO IT, AT YOUR OWN RISK ;-)
'
' THANKS TO: OLAF SCHMIDT
'*************************************************
' V.0 - 27/09/2017
' THREE FUNCTIONS AKA FLICKR METHODS:
' flickr_People_GetPhotos          =  .people.getPhotos                  = Return photos from the given user's photostream
' flickr_Explorer_GetPhotos        =  .interestingness.getList            = Returns the list of interesting photos (AKA EXPLORER) for the most recent day or a user-specified date
' flickr_GetListRecentlyUploaded    =  .contacts.getListRecentlyUploaded  = Return a list of contacts for a user who have recently uploaded photos
'
' AND I'M WORKING ON THE NEW OAUTH AUTHENTICATION METHODS (A SERIE OF OTHER API METHODS REQUIRE AUTHENTICATION)
' IF YOU HAVE ALREADY WALKED ON THIS LANDS, YOU ARE MOST WELCOME TO JOIN AND SHARE
' FLICKR/OATH AUTHENTICATION DOCUMENTATION: https://www.flickr.com/services/api/auth.oauth.html

Option Explicit

Public flickr_APIkey As String 'I WOULD SUGGEST YOU TO DECLARE flickr_APIkey IN YOUR GENERAL DECLARATIONS MODULE "MODULE1.BAS"

Public Function flickr_People_GetPhotos(p_UserNSID, Optional p_per_page As Long = 500, Optional p_page As Long = 1, Optional p_extras As String = "url_o,url_k,url_h,url_b,url_c,url_z,url_m,url_t") As String
  ' I WILL COMMENT ONLY THIS FUNCTION, EVERY OTHER HAS BASICLY THE SAME PARAMETERS AND FUNCTIONALITY
  ' FOR MORE DETAILS ON EACH METHOD GO TO: https://www.flickr.com/services/api/
  '
  ' p_UserNSID = REQUIRED, FLICKR USER NSID TO GET ITEMS (TO FIND DOCUMENTATION FOR USERNSID: https://www.flickr.com/services/api)
  ' p_per_page = OPTIONAL, NUMBER OF ITEMS (PHOTOS,VIDEOS ETC) RETURNED IN ONE PAGE, THE DEFAULT IS 500 ITEMS AND ALSO IT'S THE MAXIMUM VALUE PER PAGE
  ' p_page = OPTIONAL, PAGE NUMBER TO GET ITEMS (IF USER HAS 500+ ITEMS, IT WILL BREAK IN TWO OR MORE PAGES (500 ITEM PER PAGE) / DEFAULT = 1
  ' p_extras = OPTIONAL, RETURN THE URL FOR THE MOST COMMON IMAGES SIZES, THE DEFAULT IS WHAT I USE MOST, BUT YOU CAN CHANGE IT AT YOUR WILL.
  ' I SUPRESSED A FEW PARAMENTERS IN THIS FUNCTION, PARAMETER THAT I NEVER USE, BUT IF YOU WAT TO ADD ANY OTHER JUST FIND FULL DOCMENTATION IN
  ' FLICKR METHOD AND ARGUMENTS PAGE: https://www.flickr.com/services/api/...getPhotos.html
 
  ' THE FOLLOWING CALL USES THE NATIVE WinHttpRequest object TO EXECUTE FLICKR API METHOD
  '
  ' THE RESPONSE FORMAT format=xmlrpc - CAN BE CHANGED: FLICKR AVAILABLE RESPONSE FORMATS ARE: REST, XML-RPC, SOAP, JASON and PHP
  ' I'VE CHOOSE XML BECAUSE I CAN USE NATIVE (MICROSOFT) XML OBJECTS/PARSER NOT REQUIRING ANY EXTERNAL PARSER
  ' IF YOU WANT YOU CAN CHANGE THE RESPONSE FORMAT AND WORK AS YOU WILL, FOR DOCMENTATION FOR RESPONSE FORMATS: https://www.flickr.com/services/api/
 
  With CreateObject("WinHttp.WinHttpRequest.5.1")
      .Open "GET", "https://api.flickr.com/services/rest/?format=xmlrpc&method=flickr.people.getPhotos" & _
            "&api_key=" & flickr_APIkey & _
            "&user_id=" & p_UserNSID & _
            "&extras=" & p_extras & _
            "&per_page=" & p_per_page & _
            "&page=" & p_page, False
      .send
      If .Status = 200 Then flickr_People_GetPhotos = .responseText: Exit Function
      ' IF STATUS = 200 = HTTP_STATUS_OK = THEN RETURN FULL XML
     
      flickr_People_GetPhotos = "Fail: " & .StatusText
      ' IF STATUS = ANYTHING ELSE, SOMETHING WENT WRONG, YOU CAN CRITIQUE THE FAIL ERRORS CODE IF YOU WANT.
      ' FIND STATUS CODE HERE: https://msdn.microsoft.com/en-us/lib...(v=vs.85).aspx
     
  End With
 
End Function

Public Function flickr_Explorer_GetPhotos(Optional p_per_page As Long = 500, Optional p_page As Long = 1, Optional p_extras As String = "url_o,url_k,url_h,url_b,url_c,url_z,url_m,url_t") As String
 
  With CreateObject("WinHttp.WinHttpRequest.5.1")
      .Open "GET", "https://api.flickr.com/services/rest/?format=xmlrpc&method=flickr.interestingness.getList" & _
            "&api_key=" & flickr_APIkey & _
            "&extras=" & p_extras & _
            "&per_page=" & p_per_page & _
            "&page=" & p_page, False
      .send
      If .Status = 200 Then flickr_Explorer_GetPhotos = .responseText: Exit Function
      flickr_Explorer_GetPhotos = "Fail: " & .StatusText
  End With
 
End Function

Public Function flickr_GetListRecentlyUploaded(p_date_lastupload As Long, Optional p_filter As String = "all") As String
 
  With CreateObject("WinHttp.WinHttpRequest.5.1")
      .Open "GET", "https://api.flickr.com/services/rest/?format=xmlrpc&method=flickr.contacts.getListRecentlyUploaded" & _
            "&api_key=" & flickr_APIkey & _
            "&date_lastupload=" & p_date_lastupload & _
            "&filter=" & p_filter & "&auth_token=72157687241136323-f465a033e87d8d0f", False
                                    'YOU HAVE TO GET A NEW auth_token ON EVERY SINGLE CALL
      .send
      If .Status = 200 Then flickr_GetListRecentlyUploaded = .responseText: Exit Function
      flickr_GetListRecentlyUploaded = "Fail: " & .StatusText
  End With

End Function

---

PS: I DON'T KNOW WHY MY CODE FORMAT DOESN'T GET COLOURS AS I'VE SEEN IN ANOTHER POSTS?

---

[vb6] Overcoming LoadResPicture (ICON/CURSOR) Limitations in IDE

September 27, 2017, 4:50 pm

≫ Next: ID a MSChart Piechart slice with MouseMove

≪ Previous: VB6 Flickr API - Open To Everyone

$

0

0

I doubt many are unaware, but some probably are. So let me start by stating the limitations of using LoadResPicture with the vbResIcon and vbResCursor options while in the IDE.

1. Cannot specify the size of the loaded icon. Always loaded as default (32x32 in 100% DPI)
2. Icons/cursors having color depths other than the screen will not be used. Assumes more than one bit depth is provided in the icon resource.
3. Cursors are always loaded/scaled to a default size
4. Cursors are loaded black and white in IDE, but color when compiled.

By using a couple of APIs to find and load a specified icon/cursor, we can force VB to use the size we want. Problem numbers 1, 2 and 4 above are overcome by this method. Problem number 3 remains but, typically, is expected behavior. When compiled, LoadImage() API can be used to retrieve desired icon sizes as an HICON which can be wrapped in a stdPicture. When compiled, that API solves problem number 1. Problem number 4 doesn't exist once compiled.

Here are a couple scenarios regarding icons.

Scenario 1: You have an icon file containing only a 128x128 image. If you set that icon, in design, to a VB picture property, you get a 128x128 icon. But if you add it to your resource file then use something like Me.Picture = LoadResPicture(##, vbResIcon), what you get is a scaled-down 32x32 icon.

Scenario 2: You have an icon file with multiple images of varying sizes and color/bit depths. If you set that icon to a VB picture property, you get the first image in the file and cannot choose a size or color depth. If you add the icon file to a resource file, LoadResPictre returns a 32x32 icon if it exists, else function selects an icon and scales it to 32x32.

By using a couple of APIs, we can ask Windows to select the icon size we want when the icon file, added to a resource file, contains multiple sized images. Even if we wanted a size not in the file, we can ask that it be scaled for us. This method works whether compiled or not.

Caveats...
1. Though the code will load a 32bpp icon (XP+) and those containing PNG compression (Vista+), VB still may not display it correctly. These types of icons may fail to be loaded via the resource editor. Adding these types of icons may require alternate tools like the Microsoft RC.exe application. Icons larger than 255x255 may also require such tools.

2. If you have an icon resource that contains multiple images of varying sizes and depths, it is assumed that for each size, you have the same number of icons per depth. For example, if having icon sizes of 16, 32, 48 and depths of 8 and 32 bits, it is expected you have 6 icons, an 8 and 32 bit version for each size. This assumption is a requirement if you use the code's option to select an icon of a specific color depth. After all, this is your project and you dictate what gets added to the resource file and what doesn't. Therefore, you shouldn't be asking for a color depth that doesn't exist.

3. This method is capable of properly finding/loading PNG-encoded icons (Vista+), but the VB Resource Editor breaks that. The Resource Editor doesn't know how to deal with these (editor code is too old and not updated). It assumes the bitcount and planes attributes of the image is at a fixed offset from where the icon data starts. That assumption fails for PNG encoding as those offsets point to the PNG IHDR chunk. Therefore, the bitcount is always reported 21060 and planes as 18505 which is part of that chunk. No API that looks at this invalid icon directory structure is going to be able to process it correctly -- it is in-effect corrupted. Use another tool to add PNG-encoded icons to the resource file. However, if the PNG image is the only one in the resource, it will be selected.

Above being said, even if the directory structure isn't corrupted, if you have icons of sizes 256x256 and 512x512, they are likely PNG compressed. However, when asking for one of those, the 1st one in the icon file will be used and scaled as needed. This is because the APIs being used cannot distinguish between icon sizes larger than 255x255. Reason is that width/height are each defined by a single byte. Max value of a single byte is 255. The value of zero basically means: larger than 255. This can be worked around and will consider it if wanted. The Vista API mentioned below may not have that problem but not tested it and it is not compatible with uncompiled projects. I'd suspect that API checks the icon's actual size vs. relying on the size provided in the icon directory structure -- that's the way I'd do it ;)

FYI... LoadIconWithScaleDown is a newer API function that requires at least Vista and also cannot be used unless project is compiled. That function allows you to do what this code does but, again, not while uncompiled. That API also works with icon files on disc.

Post# 2 has the code. The zip below has a sample project with methods included.
The included resource file has one icon with just a 128x128 image, another icon with 9 images ranging from 16x16 to 128x128 and a cursor with 2 images: 32x32, 48x48. All icons and cursors are 8 bit.

Attached Files

• frmResIco.zip (12.3 KB)

ID a MSChart Piechart slice with MouseMove

September 28, 2017, 7:19 am

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

≪ Previous: [vb6] Overcoming LoadResPicture (ICON/CURSOR) Limitations in IDE

$

0

0

Have you ever wanted to ID a "slice"of a MSChart PieChart by simply moving the mouse over it?

Well, here is a possible way to do so using a ToolTip.

Code:

---

Dim sX()

Private Sub Command1_Click()
    '
    With Command1
        .Top = 800
        .Left = 500
    End With
    With MSChart1
        .Top = 500
        .Left = 2000
        .Height = 3500
        .Width = 3000
        .Visible = True
        '
        ReDim sX(1 To 4)
        sX(1) = 1.25
        sX(2) = 2.25
        sX(3) = 3.25
        sX(4) = 5.25
        '
        .ChartData = sX
        .ChartType = VtChChartType2dPie
        .Title = "Totals Split by Acct"
        '
        .Column = 1
        .ColumnLabel = "Acct 1"
        .Column = 2
        .ColumnLabel = "Acct 2"
        .Column = 3
        .ColumnLabel = "Acct 3"
        .Column = 4
        .ColumnLabel = "Acct 4"
    End With
    '
End Sub

Private Sub MSChart1_Mousemove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    '
    Dim Part As Integer
    Dim Series As Integer
    Dim DataPoint As Integer
    Dim Index3 As Integer
    Dim Index4 As Integer
    '
    '
    With MSChart1
        .TwipsToChartPart X, Y, Part, Series, DataPoint, Index3, Index4
        If Series > 0 Then
            .Column = Series
            txt = .ColumnLabel
            .ToolTipText = txt & " ... " & sX(Series)
        End If
    End With
    '
End Sub

---

Here is a screenshot



Unfortunately, my use of Paint did not grab the mouse pointer.
However, it is in the blue slice.

Comments

1. Truth be told, I had not used a PieChart, let alone a MSChart before encountering this thread
2. Credit is due to starscrea2 for the basics
3. Credit is due to chosk for pointing out the TwipsToChartPart Method
4. Credit is due to DEXWERX for suggesting the CodeBank location.

HTH

EDIT-1

I noticed that if the mouse is over the control (within the border but not on a slice)

• I got a Tooltip for Series 0
• so I added the test If Series > 0 Then

Spoo

Attached Images

 

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

October 7, 2017, 10:29 pm

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

≪ Previous: ID a MSChart Piechart slice with MouseMove

$

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).

Attached Files

• ucShellBrowse.zip (93.4 KB)

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

October 10, 2017, 3:32 pm

≫ Next: Noob Question about files and date :wave:

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

$

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 when icons (ImageList) is used and no icon is assigned. Looks kinda ugly. But we can avoid this with a little API help.



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 icon #2 in the list, is #1 when using the APIs. Because first icon is really the second in the image list, an unused icon is needed as the first icon in the image list

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.

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 Node Is Node.Root Then
        hItem = SendMessage(tView.hWnd, TVM_GETNEXTITEM, TVGN_ROOT, ByVal 0&)
    ElseIf tView.SelectedItem Is Node Then
        hItem = SendMessage(tView.hWnd, TVM_GETNEXTITEM, TVGN_CARET, ByVal 0&)
    Else
        Set cMoves = New Collection
       
        Set rNode = Node.Root
        Set tNode = Node
        Do Until tNode.Parent Is Nothing
            Do Until tNode.Previous Is Nothing
                cMoves.Add TVGN_NEXT ' "next sibling"
                Set tNode = tNode.Previous
            Loop
            cMoves.Add TVGN_CHILD ' "first child"
            Set tNode = tNode.Parent
        Loop
        If Not tNode Is rNode Then
            cMoves.Add TVGN_NEXT ' "next sibling"
            Do Until tNode.Previous Is rNode
                cMoves.Add TVGN_NEXT ' "next sibling"
                Set tNode = tNode.Previous
            Loop
        End If
        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

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

• TViewIcons.zip (3.1 KB)

Noob Question about files and date :wave:

October 12, 2017, 12:51 am

≫ Next: [vb6] Patch Icon/Cursor Resource File Entries

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

$

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