Windows applications in Visual Basic 5

Introduction

Best Practices

Deployment

Since VB applications all have dependencies, at the very minimum the VB run-time, here's how to deploy a VB app with reasonable chances of success:

  1. At work, on your development hosts, do not mix versions of VB and Service Packs (SP), as each version of VB and SP installs new versions of ActiveX controls

    VB: "Update ActiveX controls" : Used to allow/forbid updating of Object lines in VBP/FRM if a newer version of an OCX is available?
     
  2. Service Packs can be downloaded from http://msdn.microsoft.com/vstudio/downloads/, and, mainly, contain updated version of OCX's and their DEP counterparts, ie. a text file that lists the files a given OCX depends on to work. A SP can be extracted by running eg. /C T:C:\TEMP (run /? to check which switch to use.) Do take a look at the DEP files to get a feel for how VB uses COM components. Note that a SP may have some dependencies, eg. VB6SP5 requires MDAC, IE and NTSP4
  3. Take a look at VB's Packaging and Deployment Wizard (PDW), but keep in mind that it is pretty feature-poor (doesn't generate a single EXE, can't download files from the Net, etc.) and may occasionally miss some dependencies. If you wish to use other installers, PDW is still valuable because it generates a SETUP.LST which lists all the files that need to be installed. Your mission, next, is to translate this into something similar in whatever packager you fancy
  4. To install the VB runtime, don't bother extracting the files, checking whether a file is already installed, and registering the newer version if need be: The EXE can be run silently and do all this for you. Depending on the RT package, the switch is either /S or /Q . Any self-respecting installer (NSIS, etc.) can run an EXE as part of the install procedure
  5. Some components like the WebBrowser or RichEdit are difficult to install (the former because it's actually part of Internet Explorer; the latter because riched20.dll is actually available in two versions.) Do perform step-by-step install tests on different bare versions of Windows to check that such and such component installs correctly. Take advantage of "snapshot takers" like InCtrl to check what changes are made to the host by each install
  6. Since a Form will crash your application if it contains a control that is either missing or has been replaced (usually errors 339, 429, 50003), you should start your project with a call to a Main() procedure in a module (Project | Properties), and write some code that checks dependencies there. You could iterate through either all the forms that your project contains, or just the controls:

    Sub Main()
        Dim o As YourObject
        
        On Error Resume Next
        
        Set o = New YourObject
        If Err.Number <> 0 Then
            MsgBox "Can't create the object"
        Else
            Form1.Show
        End If
    End Sub
     
  7. As part of your initial install, keep a copy of all your dependencies in the local directory where your app lives, including all the Microsoft OCX's and DLL's. If your app stops running, start by reregistering those from Main() and see if it solves the issue (after all, some other app did break yours, didn't it? ;-))
  8. Starting with W2K, Microsoft provided a work-around to the so-called "DLL Hell": If the application directory contains a file with the filename of the EXE and .local appended to it (eg. myapp.exe.local), Windows will first look in the current directory for OCX's instead of starting with the Registry like it normaly does
  9. Do make use of the free DependencyWalker utility, and consider buying Squealer and Desaware's VersionStamper
  10. If you can no longer load a VB project, it might be because an OCX on which it depends was replaced with a newer version, but was subsequently removed without restoring the Registry. More infos here

Since most computers since Windows98 have the VB runtime (98 has the VB5 runtime; Check when Windows came with the VB6 runtime preinstalled), you might want to avoid including this 1-meg part in your install program, and just make it available on your web site for the rare user who runs into this error (the absence of the VB runtime usually triggers error 50003.)

Apart from running a VB application and catch an error, there's no reliable way to check that the whole runtime is up and running, but if MSVBVM50.DLL (MSVBVM60.DLL for the VB6 runtime) can be found in the $SYSTEM$ directory, there's a pretty good chance that the rest of the runtime is installed.

Files that make up msvbvm50.exe

The version number that is returned when right-clicking on this EXE downloaded from MS' site says 6.0.2600.0, but I don't know if this is a reliable way to check its version. Anyhow, here are the files it contains and their versions, as given when extracting its contents through "/C /T:C:\TEMP":

I assume REGTLIB.EXE is required to register the type library STDOLE2.TLB, and that W95INF16.DLL and W95INF32.DLL are required to have a VB5 program run correctly under the various flavors of Windows95. Since there doesn't seem to be any simple way to check whether the VB runtime is installed through an API call, you can check for the presence of $SYSTEM$\MSVBVM50.DLL and assume that if it's there, there's a 99% chance that the rest is there too and running.

OCX -ActiveX

What's the difference?

Before checking OCX/ActiveX, remember that you can already create objects through class modules (.cls). Working with class modules obviously means that you must include the source code in any project in which you wish to use this object, but it could be good enough for what you want to do. You can use the Collection data type to create an array of objects.

An OCX is a richer DLL, as it offers an interface that turns it into an OLE server and makes it usable by languages other than C. ActiveX is a sub-set of OCX (OLE Controls), which is itself a subset of OLE. ActiveX do not support as much as OCX, making them suitable for use in web pages, since those controls are downloaded if they are not available on the user's client host. Note that an OCX/ActiveX can contain more than one object, so don't generate multiple OCXs when one could suffice.

The difference between an ActiveX EXE and an ActiveX DLL is that the former runs in its own process (out-of-process), while the latter lives in the same process as the program that called the DLL (in-process). An ActiveX Component (as proposed in VB5 when starting a new project) is meant to be an object with a visual interface that you can add on a form, while an EXE/DLL is meant to be an abstract object, with pure code. I think that an "ActiveX EXE/DLL Document" (files are .DOB, and the compiled output is .VBD) was Microsoft's first shot at creating web applications with VB, ie. a proof of concept for VB.Net.

An ActiveX control can be called from a program through either its CLSID (which probably changes everytime it is recompiled...), or its human-readable ProgID (eg. Word.Application.) ProgIDs are located in the Registry under the HKEY_CLASSES_ROOT folder, and CLSIDs are located in the same part of the Registry, in the (you guessed it) the CLSID sub-folder. Each ProgID contains a reference to its CLSID.

An Active/OCX component must be registered in the Registry before being accessible. This can be done manually by running the command-line regsvr32.exe or programmatically through the DllRegisterServer() API. regsvr32 provides some switches such as /s ("silent" to remove the confirmation dialog box) and /u ("uninstall".)

A database of Microsoft DLLs/OCXs is available here.

REGOCX32.EXE vs. REGSVR32.EXE?  DllInstall() vs. DllRegisterServer()?

Just like VB applications, an ActiveX can be compiled in either native code (bigger but faster) or p-code (smaller but slower); for bigger controls, you should prefer p-code when building ActiveX controls to be used in web pages.

Unused controls in projects

To prevent unnecessary dependencies from showing up for your ActiveX control, check the "Remove information about unused ActiveX Controls" option.

Licensing a control

If you wish to build and sell an ActiveX, in the project properties, check the "Require License Key" option: This will make compulsory to have a license to use the control in development mode while making it freely available in compiled programs. This option will create a ".VBL" file in the application's directory when you compile it (which is simply a ".REG" file with a different extension).  If you change the extension to ".REG" and run it, it will install the license key required and allow developers on that computer to use your ActiveX control to develop other applications with.  You can also programmatically insert the registry key contained within the ".VBL" file if you want to keep the registration process more secure.

Version numbers

Here's a list of two- and four-digit version numbers of the main Microsoft ActiveX controls available in VB, depending on the version of VB and SP installed (OCX version/TypeLib version). Note that those standard MS components can be either already present in Windows (eg. XP, etc.) or be updated by other packages than VB (eg. MS Office):

comdlg32.ocx

  • 5.0.37.14/1.0?
  • 5.1.43.19/1.1
  • 6.0.81.69/1.2
  • 6.0.84.18/?
  • 6.0.88.77/1.2 CommonDialogControl 6.0 SP3

comct232.ocx

  • 5.0.37.14/1.0
  • 5.1.43.19/1.0 CommonControls2 5.0 SP2
  • 6.0.80.22/1.1

comct332.ocx

  • 6.0.0.8169/1.1 CommonControls3 6.0 (VB6)
  • 6.0.0.8450/1.1 (VB6SP3)
  • 6.6.0.8341/1.1
  • 6.7.0.8862 (VB6SP4)
  • 6.7.0.8988 (VB6SP5)

comctl32.ocx

  • 5.0.37.14/1.0? VB5
  • 5.0.38.28 SP1
  • 5.1.43.19/1.2 SP2, SP3, VB6
  • 6.0.80.22/1.3 VB6SP3
  • 6.0.81.5 CommonControls VB6 SP4/SP5

dbgrid32.ocx

dblist32.ocx

mscomct2.ocx

  • 6.0.81.40/2.0 .Net
  • 6.0.88.77/2.0 CommonCtrls2 6.0 SP4
  • 6.0.84.18/2.0 VB6 SP3
  • 6.0.88.4/2.0 VB5 SP4/SP5

mscomctl.ocx

  • 6.0.81.77/2.0 VB6
  • 6.0.84.50/2.0
  • 6.0.84.98/2.0 VB6SP3
  • 6.0.88.62 VB6 SP4/SP5
  • 6.1.83.36
  • 6.1.95.45 CommonCtrls 6.0 SP6

msflxgrd.ocx

  • 5.0.37.14 VB5
  • 5.1.43.19/1.0 VB5 SP2/SP3, VB6
  • 6.0.81.69 VB6
  • 6.0.84.18/1.0 VB6 SP3/SP4/SP5

msinet.ocx

  • 5.0.37.14 VB5
  • 5.1.43.19/1.0 VB5 SP2
  • 5.1.45.11/1.0 VB5 SP3
  • 6.0.81.69/1.0 VB6
  • 6.0.88.62 VB6 SP4/SP5

mswinsck.ocx

  • 5.0.37.14 VB5
  • 5.1.43.19 WinsockCtrl 6.0 SP5??? VB5 SP2/SP3
  • 6.0.81.69/1.0 VB6
  • 6.0.88.4 VB6 SP4
  • 6.0.89.88 VB6 SP5

richtx32.ocx

  • 5.0.37.14 VB5
  • 5.1.43.19/1.1 VB5 SP2/SP3
  • 6.0.81.69/1.2 VB6
  • 6.0.84.18/1.2 VB6 SP3
  • 6.0.88.4 VB6 SP4/SP5
  • 6.0.88.77/1.2

tabctl32.ocx

  • 5.0.37.14/1.1 VB5
  • 5.1.43.19/1.1 VB5 SP2/SP3, VB6
  • 6.0.81.69/1.1 VB6
  • 6.0.84.18 VB6 SP3
  • 6.0.88.4 VB6 SP4
  • 6.0.90.43 VB6 SP5

threed32.ocx

  • 1.0.41.0/1.0 VB5 VB

TO CHECK

COMCT232 5.1.43.19 = animations

COMCT232 6.0.81.77 = animations + month calendar + date picker + flat scroll

COMCT332 = dockable toolbar

MSCOMCTL = COMCT32 + image combo

MSCOMCT2 = ?

Building an ActiveX DLL

  1. Launch VB5, and choose "Active X DLL" as the project type
  2. Rename the project name as the name you wish the OCX file to use, eg. myocx
  3. Rename the default class file as the object name you wish to use, eg. myobject. Add a subroutine called MySub() that does something like MsgBox "Hello World"
  4. Ensure that binary compatibility is effective (Project | Properties | Component : Binary Compatibility); otherwise, you'll also have to recompile all the applications that make use of this DLL. You don't need to register this new ActiveX control, since the VB IDE does it for you after compiling
  5. Create a new Standard EXE project in VB, add this new OCX in the project (Project > Reference : If it is not listed, hit "Browse..." and select myocx.ocx)
  6. In the project, call the object with eg.

    Dim mygreatObject as New myobject

    Call mygreatObject.MySub
  7. Done! :-)

An object's ProgID in an ActiveX DLL consists in the project's name (myocx, here) combined with the object's name (myobject, here), ie. myocx.myobject.

Handling dependencies

If your program depends on standard (ie. non-COM) DLL's, just keep a copy in the local directory where your EXE lives, since this is where Windows will start looking for those.

If you also need COM DLL/OCXs, however, things are more tricky, as Windows first looks up this component's CLSID in the Registry, and will load it up by following its path key; If another application replaced this OCX with an older version (or newer, without handling backwards compatibility) with no further ado... your application will crash.

If the OCX cannot be found in the Registry, Windows will look for it in the local directory, followed by the system directories (ie. \WINDOWS, \WINDOWS\SYTEM, etc.), and all the directories listed in the PATH, register this component, and load it; If all else fails, you'll get an Err 369 or 429.

MS introduced a kludge in W2K to force Windows to first look for an OCX in the local directory if you keep an empty file with ".local" added to the name of the EXE, eg. myapp.exe -> myapp.exe.local. Read Implementing Side-by-Side Component Sharing in Applications for more information.

There are two ways to handle dependencies: By providing a setup program for the initial install, and by calling code each time the application is ran.

Using a setup program

Unlike InnoSetup, NSIS offers a scripting language, which could be more practical to perform some kung-fu tricks during install (eg. downloading OCX's from your web site, etc.)

Make sure the user is logged on with administrative rights, and be aware of the Windows File Protection (a.k.a. System File Checker, SFC) available on Windows 2000 and XP, which prevent system files from being replaced, which could keep your installer from successfully installing or updating system files. Read Disabling Windows File Protection in Windows 2000 and Windows XP or Dispelling WFP myths by By Jeremy Collake.

At runtime

As explained in the help file of DependencyWalker, there's no sure-fire way to get a list of depencies that a VB program needs. Ideally, you call a routine in Main() recursively so as to get a list, check that all is well, provide a way to silently download and reinstall if not.

Unfortunately, apart maybe from using Desaware's VersionStamper ($700) which I haven't tried, I don't know of a good way.

A kludge could be to call a batch file before compiling the EXE to generate a list of dependencies from the VBP, FRM, and BAS files (looking for Object, Reference, and Declare's), have the VB IDE call a second batch file to stick this list in the EXE using eg. PEBundle, and parse this file in Main() every time your program starts.

Another idea is to load/unload in Main() all the forms that make up the EXE, catch any error, and either launch the user's browser to direct them to your site's download area, run the installer that you copied in the application's directory silently, or, if they have a permanent connection to the Net, silently download and reinstall the components that have been hosed.

FYI, you can bundle your dependencies with the EXE using eg. PEBundle or EXE Bundle.

Something else to check, is using LoadLibrary() to load an ActiveX control directly instead of relying on the Registry. See Matthew Curland's Advanced Visual Basic 6 book in which he describes how to load and instantiate objects from ActiveX DLLs. You don't need to register any DLLs in the registry.

Essentially, the registry information is there so that any executeable on your PC can locate a particular COM class and instantiate it without having to know where on the hard disk it is kept. If you know where your COM DLL file is kept, you can load it with LoadLibraryEx(), and retrieve its class factory. Subsequently, you use this object to instantiate the class you want.

Here's some code, but I don't know how easy it could be to access methods after loading a COM object manually this way:

Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function LoadLibraryEx Lib "kernel32" Alias "LoadLibraryExA" (ByVal lpLibFileName As String, ByVal hFile As Long, ByVal dwFlags As Long) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
 
' Missing from VB API declarations:
Private Const DONT_RESOLVE_DLL_REFERENCES = &H1&
Private Const LOAD_LIBRARY_AS_DATAFILE = &H2&
Private Const LOAD_WITH_ALTERED_SEARCH_PATH = &H8&
Private m_hMod As Long
 
m_hMod = LoadLibraryEx(m_sFileName, 0, 0)
If (m_hMod = 0) Then
   Err.Raise vbObjectError + 1048 + 1, App.EXEName & ".cLibrary", WinError(Err.LastDllError)
End If
      
FreeLibrary m_hMod

Managing multiple versions of an OCX

DLL/COM redirection

DLL/COM redirection is activated on an application-by-application basis by the presence of a ".local" file. The ".local" file is an empty file in the same directory as the application's .exe file, with the same name as the application's .exe file with ".local" appended to the end of the name. For example, to activate DLL/COM redirection for an application called "myapp.exe," create an empty file called "myapp.exe.local" in the same directory where myapp.exe is installed. Once DLL/COM redirection is activated, whenever the application loads a DLL or an OCX, Windows looks first for the DLL or OCX in the directory where the application's .exe file is installed.

Up to now, however, executing different versions of components side by side has not typically been a design consideration. Whilst components can easily be installed side by side (installed in a shared location and isolated to one or more applications), they may not run side by side. This happens because some components use global state (such as settings stored in the registry), assuming that there will be only one version of the component on the computer at any time. Additionally, the component may make assumptions about the specific directory in which it is installed when locating other resources that it needs.

For this reason it is imperative to test an application that uses isolated components both installed on their own and installed in the context of the other applications from which the components are isolated. Microsoft's experience has indicated that in most scenarios commonly shared components can run side by side, but in some cases it may be necessary to close one application before running the next.

Do not attempt to isolate any of the files protected by System File Protection that ship with Windows 2000, including most .sys, .dll, .exe, and .ocx files.

You must test all applications to ensure side-by-side validity, especially in areas where sharing can occur, since there is no side-by-side enforcement by current operating systems.

In Visual Basic there is currently no easy way for developers to write inherently side-by-side ActiveX controls. This is because the registration of Visual Basic-authored ActiveX controls writes the fully qualified path to the OCX file into the registry when the control is registered.

How should I update an OCX?

  1. Unregister the current OCX, and rename it instead of overwriting it (just in case...)
  2. Copy your newer version in $SYSTEM, as they might depend on non-COM DLL's located in this standard location
  3. Register your new control

Note that under NT, moving an OCX using Windows Explorer apparently updates its location in the Registry.

Registering an ActiveX control programmatically

Here's the code to register a control at compile-time, ie. you know the name of the OCX:

Private Declare Function DllRegisterServer Lib "MyControl.dll" () As Long
Result = DllRegisterServer

The return value is zero for success.

Registering an OCX at run-time, however, ie. without knowing the name of the file beforehand, might be tricky in VB. Here's a project that uses a C DLL to do this.

Here's code to register/unregister a control:

Private Declare Function LoadLibrary Lib "KERNEL32" Alias "LoadLibraryA" (ByVal strFileName As String) As Long
Private Declare Function GetProcAddress Lib "KERNEL32" (ByVal hLibrary As Long, ByVal strFunctionName As String) As Long
Private Declare Function CallWindowProc Lib "USER32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function FreeLibrary Lib "KERNEL32" (ByVal hLibrary As Long) As Long
  
Public Function RegisterCom(ByVal strFileName As String) As Boolean
  
  Dim hLibrary As Long
  Dim hFunction As Long
  
  ' Validate parameters
  strFileName = Trim(strFileName)
  If Dir(strFileName, vbArchive Or vbHidden Or vbNormal Or vbReadOnly Or vbSystem) = "" Then
    Exit Function
  End If
  If Right(strFileName, 1) <> Chr(0) Then strFileName = strFileName & Chr(0)
  
  ' Load the COM object using the LoadLibrary function
  hLibrary = LoadLibrary(strFileName)
  If hLibrary = 0 Then Exit Function
  
  ' Get the handle to the function to call
  hFunction = GetProcAddress(hLibrary, "DllRegisterServer" & Chr(0))
  If hFunction = 0 Then GoTo CleanUp
  
  ' Call the function
  If CallWindowProc(hFunction, 0, 0, 0, 0) = 0 Then RegisterCom= True
  
CleanUp:
  
  If hLibrary <> 0 Then FreeLibrary hLibrary
  
End Function
   
Public Function UnregisterCom(ByVal strFileName As String) As Boolean
  
  Dim hLibrary As Long
  Dim hFunction As Long
  
  ' Validate parameters
  strFileName = Trim(strFileName)
  If Dir(strFileName, vbArchive Or vbHidden Or vbNormal Or vbReadOnly Or vbSystem) = "" Then
    Exit Function
  End If
  If Right(strFileName, 1) <> Chr(0) Then strFileName = strFileName & Chr(0)
  
  ' Load the COM object using the LoadLibrary function
  hLibrary = LoadLibrary(strFileName)
  If hLibrary = 0 Then Exit Function
  
  ' Get the handle to the function to call
  hFunction = GetProcAddress(hLibrary, "DllUnregisterServer" & Chr(0))
  If hFunction = 0 Then GoTo CleanUp
  
  ' Call the function
  If CallWindowProc(hFunction, 0, 0, 0, 0) = 0 Then UnregisterCom = True
  
CleanUp:
  
  If hLibrary <> 0 Then FreeLibrary hLibrary
  
End Function

Here's yet another way to unregister a control (on Win9x, you might need to fully-qualify regsvr32, or Windows will fail locating this EXE):

Shell "regsvr32 " & GetShortName(GetPath(App.Path) & "\myctl.ocx /u /s"

Is this component registered?

http://users.skynet.be/wvdd2/General_techniques/Is_component_registred__/is_component_registred__.html

Checking that an ActiveX is installed

I don't know if there's a cleaner way to do this, but here goes...

Public Function IsOcxAvailable(sKey As String) As Boolean
    Dim hKeyOpen As Long
    Dim lKeyResult As Long
    Dim lKeyQueryLen As Long
   
    'Let's check that HKEY_CLASSES_ROOT\vbXML.XMLAttribute\Clsid lives
    lKeyResult = RegOpenKeyEx(HKEY_CLASSES_ROOT, _
        sKey & "\Clsid" & Chr$(0), _
        &H0, KEY_ALL_ACCESS, hKeyOpen)
    
    lKeyResult = RegQueryValueEx(hKeyOpen, "", 0&, 0&, 0&, _
                 lKeyQueryLen)
    
    If lKeyQueryLen > 0 Then
        IsOcxAvailable = True
    Else
        IsOcxAvailable = False
    End If
    RegCloseKey hKeyOpen
   
End Function

To Check if an ActiveX is installed, you must look in the registry under HKEY_CLASS_ROOT\CLSID, for a sub-key corresponding to the ActiveX Class ID (eg. "{881BEB74-F9D5-4ACB-A3DF-F6752473ABE0}"). To get the path of the DLL implementing the ActiveX, look up its CLSID, and read its subkey "InprocServer32", which gives you the fully-qualified path to the file.

Catching ActiveX-related errors

If an OCX control is either missing or can't be loaded due to incompatible version or missing dependencies, add a module, set the project's properties to get the EXE so start with a subroutine named Main(), and add the following code:

Public Sub Main()
    On Error GoTo ErrHandler
    
    Form1.Show
    Exit Sub
 
    ErrHandler:
        Select Case Err.Number
            Case 339, 429, 50003
                MsgBox Err.Description, vbCritical, "Error #" & Err.Number
                End 'Probably not needed, as this is a critical error, so VB dies
        End Select
End Sub

You should add code to remedy the issue if you can (eg. silently located the missing OCX, or download it from the Net.)

My application fails loading an OCX

Here's what I seem to have understood about the way Windows handles OCXs :

From: "Jeff Johnson [MVP: VB]"

There are basically two ways a program can access an OCX: by CLSID and by ProgID. A ProgID is a human-readable text string which can be used in calls to CreateObject(). "ADODB.Connection" is an example of a  ProgID. Windows will look up this ProgID in the registry and get a CLSID. It will then look up this CLSID to find the physical location of the OCX. You cannot have two active versions of an OCX on your system that supply the same ProgID; whichever one was installed latest will be the one that Windows looks up.

What is "Unexpected error" or "Error 50003"?

Usually the result of a different version of an OCX on which your application depends being registered since you installed it, ie. if your app uses Acme's OCX release 2, and the user installs another app that replaces this OCX with release 1 (on Windows won't stop them), your application will stop working, and problably complain with Err 50003. This usually occurs with Microsoft's common controls (the enhanced widgets that came with Win9x, the standard dialog boxes like OpenFile, etc.) FYI, Microsoft have issued different, sometimes incompatible, versions of comctl32.ocx, comdlg32.ocx, comct232.ocx, and comct332.ocx, without changing their GUID.

Note that some OCXs themselves require other components to work, so simply copying a given OCX from your \system32 onto another computer won't do much good. Also, not all OCX providers enforce binary compatibility, effectively breaking any app that were compiled to work with a previous version of said OCX. If you want to investigate, Squealer looks interesting.

Another utility is Regmon from System Internals which is a tool for monitoring accesses to the registry. Use Regmon to capture all registry access when the application is run, up to the point where the error is produced. Look for where an ‘OpenKey’ request fails. Experience has indicated that the following are significant:

HKCR\CLSID\NN..NN\InprocServer32

HKCR\TypeLib\NN..NN

For each of these ‘NN..NN’ indicates the class sid of a missing COM object. On a machine where this COM object is available (possibly contact the original developer of the COM object) locate this class sid in the registry, this will reveal the full pathname of the missing item. Obtain a copy and use regsvr32 to register it.

Yet another way to check which OCX is causing this issue is to build a dummy project that only contains references to all the OCX you need, and use this kind of code to see if you can recreate the error:

Set myVar=New ActiveXType
Or
Set myVar=CreateObject(ActiveXType)

"Error 429: OLE Automation server cannot create object"?

Your EXE makes use of an OCX, which either is self-registering but cannot be located (I guess Windows works just like with DLLs: Look in the same directory where the EXE lives, then \system[32], \Windows, and $PATH), or it can be located in the previous directories but is not self-registering and you didn't register it beforehand. Also, make sure it's not due to access rights (eg. works OK when logged on as Admin, but fails when logged on as Fred).

Why does VB say "Component cannot be loaded" in the Components dialog?

It could be that an OCX on which your application depends was replaced by a different version but with the same filename, without removing any OCA type library cache pertaining to the previous version. Delete the OCA file, and give it another go.

Delete all the OCA files and preferably clean up the registry using RegClean from Microsoft or better still COMclean. VB will regenerate the OCA files as needed.

Trouble when using COMDLG32, COMCTL32, or COMCT232

More infos about those controls here. VB6 introduced a completely new common control file called MSCOMCTL.OCX. This does not cause any problems because the GUID was changed along with the file name. We are concerned here with the modified versions of the VB5 controls which VB6 also installs.

If the VB IDE still complains, play with the version number in the VBP file, eg. Object={CLSID here}#1.3#0; COMCTL32.OCX (change this to eg. 1.0)

Also, the VB compiler allows you to set an existing project to not upgrade ActiveX controls. If you do not check this option, existing projects will be converted to use the VB6 controls if you installed the relevent SP.

Finally, some OCX's have dependencies, eg. comctl32.ocx requires comctl32.dll, etc.

Locating an OCX in the filesystem

If you want to find out the location of the actual OCX or DLL file that is referenced by the CLSID, you can do that by going to the "CLSID" section under the HKEY_CLASSES_ROOT section and finding your CLSID. Once you find it, you'll notice there are several entries under it.  One of them is "InprocServer32".  The default value of this registry key will be the physical location of the file that is your ActiveX control.

You Do Not Have An Appropriate License To Use This Functionality In The Design Environment.

You might get the following message when adding a standard Microsoft component on a form after upgrading to a new Service pack:

"License Information For This Component Not Found. You Do Not Have An Appropriate License To Use This Functionality In The Design Environment."

Here's the fix.

Extracting a CLSID from an ActiveX file

  1. Add a reference to the MS-produced but unsupported TLBINF32.DLL which you probably already have since it ships with VB (Project | References)
  2. Add the following code:

    Private Sub Command1_Click()
        On Error Resume Next
        Dim sPath As String
        CommonDialog1.Filter = "OCX File (*.ocx)|*.ocx"
        CommonDialog1.InitDir = Environ$("WINDIR") & "\SYSTEM32"
        CommonDialog1.ShowOpen
        sPath = CommonDialog1.filename
        If sPath <> "" Then
            Err.Clear
            Dim tlii As TLI.TypeLibInfo
            Set tlii = TLIApplication.TypeLibInfoFromFile(sPath)
            'Error if the OCX has no type library
            If Err.Number Then
                MsgBox Err.Description, , "Error #" & Str$(Err.Number)
            End If
            Label1.Caption = "CLSID of " & sPath & " is "
            Text1.Text = tlii.Guid
        End If
    End Sub

Instantiating an ActiveX class from a specified .DLL file without registering

It's not as simple as you would like it to be, but it's not un-doable either.  ActiveX DLLs support 2 special functions, one of which is DLLGetClassObject, which is the key to this technique.  The full technique is explained in Matthew Curland's book : www.powervb.com It works for all ActiveX components.

From: Schmidt (sss@online.de) Newsgroups: microsoft.public.vb.com

Yes, I've written a Class for this:

usage:
 
Dim CF as CFactory,O as Object
 
Set CF = New CFactory
Set O = CF.GetInstance("C:\MyPath\scrrun.dll", "Dictionary")
Set O = CF.GetInstance("C:\MyPath\scrrun.dll", "FileSystemObject")
 
'or this way
Set O = CF.GetInstance("C:\MyPath\MyLib.dll", "MyClass")

Here the Factory-Code:

'****Into a Class named CFactory (set a reference to EdanMos OleLib.tlb)
Option Explicit
 
'Direct Instanciation of COM-Objects (bypassing the registry)
'Olaf Schmidt - os@datenhaus.de (2001)
'Uses Eduardo Morcillos OleLib.Tlb
 
Private Declare Function LoadLibrary& Lib "kernel32" Alias
"LoadLibraryA"
(ByVal lpLibFileName$)
Private Declare Function FreeLibrary& Lib "kernel32" (ByVal hLibModule&)
Private Declare Function GetProcAddress& Lib "kernel32" (ByVal hModule&,
ByVal
lpProcName$)
Private Declare Function CallWindowProc& Lib "user32" Alias
"CallWindowProcA"
(ByVal lpPrevWndFunc&, ByVal hWnd&, ByVal MSG&, ByVal wParam&, ByVal
lParam&)
Private Declare Sub RtlMoveMemory Lib "kernel32" (Dst As Any, Src As
Any,
ByVal bLength&)
 
Private IIDCF As UUID, IIU As UUID, pIUNull As IUnknown
Private Libs As Collection, CFs As Collection, ASM() As Byte
 
Private Sub Class_Initialize()
  'Get IID for IClassFactory
  CLSIDFromString "{00000001-0000-0000-C000-000000000046}", IIDCF
  'same for IUnknown
  CLSIDFromString "{00000000-0000-0000-C000-000000000046}", IIU
  Set Libs = New Collection
  Set CFs = New Collection
  'Initialize ASM-Code for StdCall (principle found on VBDotCom)
  ASM = StrConv("XYYYYPh    h    h        ", vbFromUnicode)
End Sub
 
Public Function GetInstance(sFile$, sClass$) As Object
Dim Result&, Lib&, pGetClass&, RefIU As IUnknown
Dim TLI As ITypeLib, CID As UUID, pICF As IClassFactory, pp&
  On Error Resume Next
  Lib = Libs(sFile)
  If Lib = 0 Then
    Lib = LoadLibrary(sFile)
  Else
    Set pICF = CFs(sFile & sClass)
    If Not pICF Is Nothing Then
      pICF.CreateInstance pIUNull, IIU, RefIU
      Set GetInstance = RefIU
      Exit Function
    End If
  End If
  If Lib = 0 Then Err.Clear: Exit Function
  Libs.Add Lib, sFile 'Cache the Library-Handle
  Set TLI = LoadTypeLibEx(sFile, REGKIND_NONE)
  If TLI Is Nothing Then Err.Clear: Exit Function
 
  If Not ClassExists(TLI, sClass, CID) Then Err.Clear: Exit Function
 
  pGetClass = GetProcAddress(Lib, "DllGetClassObject")
  If pGetClass = 0 Then Err.Clear: Exit Function
 
  RtlMoveMemory ASM(7), VarPtr(pICF), 4 'Param3
  RtlMoveMemory ASM(12), VarPtr(IIDCF), 4 'Param2
  RtlMoveMemory ASM(17), VarPtr(CID), 4 'Param1
  RtlMoveMemory ASM(22), pGetClass - VarPtr(ASM(22)) - 4, 4
  Result = CallWindowProc(VarPtr(ASM(0)), 0, 0, 0, 0)
  If Result = &H80040111 Then Err.Clear: Exit Function 'Bad ClassID
  If pICF Is Nothing Then Err.Clear: Exit Function 'couldn't get
IClassFactory
  CFs.Add pICF, sFile & sClass
  pICF.CreateInstance pIUNull, IIU, RefIU
  Set GetInstance = RefIU
  Err.Clear
End Function
 
Private Function ClassExists(TLI As ITypeLib, sClass$, CID As UUID) As
Boolean
Dim i&, sName$, Obj As Object, pAttr&
Dim TI As ITypeInfo, TA As TYPEATTR
  On Error Resume Next
  For i = 0 To TLI.GetTypeInfoCount - 1
    If TLI.GetTypeInfoType(i) <> TKIND_COCLASS Then GoTo nxt
    Set TI = TLI.GetTypeInfo(i)
    TI.GetDocumentation DISPID_UNKNOWN, sName, "", 0, ""
    If UCase(sName) <> UCase(sClass) Then GoTo nxt
    pAttr = TI.GetTypeAttr
    MoveMemory TA, ByVal pAttr, Len(TA)
    TI.ReleaseTypeAttr pAttr
    If TA.wTypeFlags Then CID = TA.iid: ClassExists = True: Exit For
nxt: Next i
  Err.Clear
End Function
 
Private Sub Class_Terminate()
Dim Lib
  Set CFs = Nothing
  For Each Lib In Libs: FreeLibrary Lib: Next
End Sub

Auto-updating an application

Getting the current application's Process ID

Private Declare Function GetCurrentProcessId Lib "kernel32.dll" () As Long
Private Sub Form_DblClick()
    MsgBox "This program's current Process ID is " & GetCurrentProcessId
End Sub

Calling a second application and passing it its parent's PID

Call Shell("child.exe " & Str$(GetCurrentProcessId), vbNormalFocus)

Making Shell() synchronous

Unfortunately, Shell() can only be called asynchronously. Here's to make it wait until the child application terminates.

Add this to a module:

Public Const SYNCHRONIZE = &H100000
Public Const INFINITE = &HFFFF
Public Const WAIT_OBJECT_0 = 0
Public Const WAIT_TIMEOUT = &H102
 
Public Const UPDATE = "update.exe"
 
Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, _
            ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
 
Public Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, _
            ByVal dwMilliseconds As Long) As Long
 
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
 
Public Sub Update()
    Dim lPid As Long
    Dim lHnd As Long
    Dim lRet As Long
                
    lPid = Shell(App.Path & "\" & UPDATE, vbNormalFocus)
    If lPid <> 0 Then
        lHnd = OpenProcess(SYNCHRONIZE, 0, lPid)
        If lHnd <> 0 Then
            lRet = WaitForSingleObject(lHnd, INFINITE)
            CloseHandle (lHnd)
        End If
    Else
        MsgBox err.Description, , "Error calling " & App.Path & "\" & UPDATE
    End If
End Sub

Add this to a form:

Private Sub Form_DblClick()
    Call Update
End Sub

Killing a process through the application's PID

I don't remember where I found this code on the web, but it works fine:

Function KillProcess(ByVal hProcessID As Long, Optional ByVal ExitCode As Long)  As Boolean
    Dim hToken As Long
    Dim hProcess As Long
    Dim tp As TOKEN_PRIVILEGES
    
    If GetVersion() >= 0 Then
        If OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES Or _
            TOKEN_QUERY, hToken) = 0 Then
            GoTo CleanUp
        End If
        
        If LookupPrivilegeValue("", "SeDebugPrivilege", tp.LuidUDT) = 0 Then
            GoTo CleanUp
        End If
    
        tp.PrivilegeCount = 1
        tp.Attributes = SE_PRIVILEGE_ENABLED
    
        If AdjustTokenPrivileges(hToken, False, tp, 0, ByVal 0&, _
            ByVal 0&) = 0 Then
            GoTo CleanUp
        End If
    End If
    
    hProcess = OpenProcess(PROCESS_ALL_ACCESS, 0, hProcessID)
    If hProcess Then
        KillProcess = (TerminateProcess(hProcess, ExitCode) <> 0)
    End If
    
    If GetVersion() >= 0 Then
        tp.Attributes = 0
        AdjustTokenPrivileges hToken, False, tp, 0, ByVal 0&, ByVal 0&
        
CleanUp:
        If hToken Then CloseHandle hToken
    End If
End Function
 
Private Sub OK_Click()
    If KillProcess(Val(Command()), 0) Then
        MsgBox "Calling app closed successfully"
    End If
End Sub

Extracting arguments from the command line

Here's how to fill an array with the parameters passed to a program, and loop through the array:

Function GetCommandLine(ArgArray() As Variant, Optional MaxArgs)
 
    Dim C, CmdLine, CmdLnLen, InArg, I, NumArgs
    If IsMissing(MaxArgs) Then MaxArgs = 10
 
    ReDim ArgArray(MaxArgs)
    NumArgs = 0
    InArg = False
 
    CmdLine = Command()
    CmdLnLen = Len(CmdLine)
    For I = 1 To CmdLnLen
        C = Mid(CmdLine, I, 1)
        If (C <> " " And C <> vbTab) Then
            If Not InArg Then
            If NumArgs = MaxArgs Then Exit For
                NumArgs = NumArgs + 1
                InArg = True
            End If
            ArgArray(NumArgs) = ArgArray(NumArgs) + C
        Else
            InArg = False
        End If
    Next I
    ReDim Preserve ArgArray(NumArgs)
End Function
 
Private Sub Form_DblClick()
    Dim ArgArray() As Variant
    Dim iCounter As Integer
    
    Call GetCommandLine(ArgArray())
 
    '0 = name of EXE; parameters start at 1
    For iCounter = 1 To UBound(ArgArray)
        MsgBox ArgArray(iCounter)
    Next iCounter
End Sub

Parsing a list of files

Here's a code snippet to parse through a list of files returned by a PHP script:

<?php
 
//http://localhost/check.php?input=myfile.ini
$listFile = $_GET['input'];
if (!($fp = fopen($listFile, "r")))
        exit("Unable to open $listFile.");
 
while (!feof($fp)) {
        $buffer = fscanf($fp, "%s", $name);
        if ($buffer == 1) {
                //file1,123#file2,456# : better use # to avoid the usual CRLF/CR/LF issue
                print "$name," . filesize($name) . "#";
        }
}
fclose ($fp);
?>

The VB script:

Dim sStuff As String
sStuff = "item1,item2#item3,item4#item5,item6#item7,item8#"
Dim iPos As Integer
    
iPos = 1
Do While iPos < Len(sStuff)
    sItem = Mid$(sStuff, iPos, InStr(iPos, sStuff, "#") - iPos)
    sName = Left$(sItem, InStr(sItem, ",") - 1)
    sSize = Right$(sItem, Len(sItem) - InStr(sItem, ","))
 
    MsgBox sName & " - " & sSize
 
    iPos = iPos + ((InStr(iPos, sStuff, "#") - iPos) + 1)
Loop

Some working solution

Here's a two-part solution to auto-update an application which doesn't require any OCX to download in HTTP (uses WININET.DLL), but requires the non-COM aamd532.dll (or here, a.k.a. Almeida & Andrade Ltda's MD5 Maker DLL) to generate hashings (CryptoAPI wasn't available in 98 Original, and doesn't offer hashing in 98SE):

  1. First, by calling checksize.php on the server, the main EXE first checks whether update.exe is available locally, and if yes, whether it's up to date. If no to either case, update.exe is downloaded from the web server
  2. The main EXE shells to update.exe in blocking mode (by itself, shell() is asynchronous, and we need to wait until update.exe is through, using WaitForSingleObject() ), passing as parameters the name of the INI file on the server that holds the static list of files that make up this application, the PID of the caller EXE so that update.exe can kill it in case it needs to be updated, and the name of the caller EXE so that update.exe can restart it after it's done updating
  3. update.exe calls a PHP script on a web site, checkhash.php, that returns a list of files this application needs, each file being uniquely identified by its MD5 hash (we don't care about version numbers, just whether such and such file that makes up the application is up to date; Non-executables don't have version numbers, and besides, the Win32 module is only available when the PHP interpreter is run under a Windows server)
  4. Any file that is either missing, or not up to date is downloaded by update.exe
  5. Update.exe restarts the caller EXE, display a file like parent.txt (ie. extract left part of caller EXE, add .txt, and check if such a file exists on the server) for information purposes (eg. what changes were made), and dies

Here's how update.exe is called in the parent VB EXE:

'========== TO MAKE SHELL() SYNCHRONOUS ============
 
Public Const SYNCHRONIZE = &H100000
Public Const INFINITE = &HFFFF
Public Const WAIT_OBJECT_0 = 0
Public Const WAIT_TIMEOUT = &H102
 
Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
 
Public Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
 
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
 
'========== WININET STUFF
 
Type INTERNET_VERSION_INFO
    dwMajorVersion As Long
    dwMinorVersion As Long
End Type
 
Enum WinInet_Versions
    INET_VER_ERROR = 0
    INET_VER_UNKNOWN = 1
    INET_VER_IE3 = 3 'wininet shipped with IE3
    INET_VER_IE4 = 4 '-//- with IE4
    INET_VER_IE5 = 5 '-//- with IE5
End Enum
 
Public Const SITEMAJ = "http://www.acme.com/downloads/"
Public Const Update = "update.exe"
 
Public Const INTERNET_OPTION_VERSION = 40
Public Const INTERNET_OPEN_TYPE_PRECONFIG As Long = 0
Public Const INTERNET_OPEN_TYPE_DIRECT As Long = 1
Public Const INTERNET_OPEN_TYPE_PROXY As Long = 3
Public Const HTTP_QUERY_CONTENT_LENGTH As Long = 5
Public Const INTERNET_FLAG_RELOAD As Long = &H80000000
 
'WinInet Declarations
Public Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Public Declare Function HttpQueryInfo Lib "wininet.dll" Alias "HttpQueryInfoA" (ByVal hHttpRequest As Long, ByVal lInfoLevel As Long, ByRef sBuffer As Any, ByRef lBufferLength As Long, ByRef lIndex As Long) As Integer
Public Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" (ByVal hOpen As Long, ByVal sUrl As String, ByVal sHeaders As String, ByVal lLength As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Public Declare Function HttpOpenRequest Lib "wininet.dll" Alias "HttpOpenRequestA" (ByVal hHttpSession As Long, ByVal sVerb As String, ByVal sObjectName As String, ByVal sVersion As String, ByVal sReferer As String, ByVal something As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Public Declare Function HttpSendRequest Lib "wininet.dll" Alias "HttpSendRequestA" (ByVal hHttpRequest As Long, ByVal sHeaders As String, ByVal lHeadersLength As Long, sOptional As Any, ByVal lOptionalLength As Long) As Integer
Public Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
Public Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
Public Declare Function InternetQueryDataAvailable Lib "wininet.dll" (ByVal hFile As Long, lpdwNumberOfBytesAvailable As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Public Declare Function InternetQueryOption Lib "wininet.dll" Alias "InternetQueryOptionA" (ByVal hInternet As Long, ByVal dwOption As Long, lpBuffer As Any, lpdwBufferLength As Long) As Long
 
Public Declare Function GetCurrentProcessId Lib "kernel32.dll" () As Long
 
Public Function HttpReadPage(ByVal Url As String) As String
    Dim vBuff As String
    Dim vhOpen As Long
    Dim vhUrl As Long
    Dim vSize As Long
    Dim vRet As Long
    
    vhOpen = InternetOpen("Mozilla/4.0", INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
    If vhOpen Then
        vhUrl = InternetOpenUrl(vhOpen, Url, vbNullString, 0, INTERNET_FLAG_RELOAD, 0)
        If vhUrl Then
            If InternetQueryDataAvailable(vhUrl, vSize, 0, 0) Then
                If (vSize = 0) Then vSize = 4096
                vBuff = String(vSize, 0)
                Do
                    InternetReadFile vhUrl, vBuff, vSize, vRet
                    If (vRet = 0) Then Exit Do
                    HttpReadPage = HttpReadPage & Left$(vBuff, vRet)
                Loop
            End If
            InternetCloseHandle vhUrl
        End If
        InternetCloseHandle vhOpen
    End If
End Function
 
'The only reliable way I found to check for an active Internet connection
Function InternetCheck() As Boolean
    Dim vhOpen As Long
    Dim vhUrl As Long
    
    InternetCheck = False
    
    vhOpen = InternetOpen("Mozilla/4.0", INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
    If vhOpen Then
        vhUrl = InternetOpenUrl(vhOpen, "http://www.google.com", vbNullString, 0, INTERNET_FLAG_RELOAD, 0)
        If vhUrl Then
            InternetCheck = True
            InternetCloseHandle vhUrl
        End If
        InternetCloseHandle vhOpen
    End If
End Function
 
Public Function FileExists(ByVal filename As String) As Boolean
    Dim length As Long
    
    On Error GoTo FileDoesntExist
    length = FileLen(filename)
    FileExists = True
    Exit Function
         
FileDoesntExist:
    FileExists = False
End Function
 
Public Sub UpdateApp(sINI As String)
    Dim sFile As String
    Dim iFile As Integer
    
    If InternetCheck() Then
        //Check if update.exe is available, and hasn't been updated on the server
        sFile = HttpReadPage(SITEMAJ & "checksize.php?input=" & Update)
        If sFile <> "-1" Then
            On Error Resume Next
            If Not FileExists(App.Path & "\" & Update) Or sFile <> FileLen(App.Path & "\" & Update) Then
                iFile = FreeFile
                sFile = HttpReadPage(SITEMAJ & Update)
                Open App.Path & "\" & Update For Binary Access Write As #iFile
                Put #iFile, , sFile
                Close #iFile
            End If
 
            'Downloaded OK?
            If FileExists(App.Path & "\" & Update) Then
                Dim lPid As Long
                Dim lHnd As Long
                Dim lRet As Long
                
                'Block on Shell() to let it do its stuff
                lPid = Shell(App.Path & "\" & Update & " " & sINI & " " & Str$(GetCurrentProcessId) & " " & App.EXEName & ".exe", vbNormalFocus)
                If lPid <> 0 Then
                    'Get a handle to the shelled process.
                    lHnd = OpenProcess(SYNCHRONIZE, 0, lPid)
                    'If successful, wait for the application to end and close the handle.
                    If lHnd <> 0 Then
                            lRet = WaitForSingleObject(lHnd, INFINITE)
                            CloseHandle (lHnd)
                    End If
                    'MsgBox "Just terminated.", vbInformation, "Shelled Application"
                Else
                    MsgBox err.Description, , "Error calling " & App.Path & "\" & Update
                    Exit Sub
                End If
            Else
                'MsgBox "Error downloading " & UPDATE
            End If
        Else
            'MsgBox UPDATE & " not found on server"
        End If
    Else
        MsgBox "Active Internet Connection Not Found", vbInformation, "Mise jour programmes"
    End If
End Sub
 
Private Sub Form_DblClick()
    'myapp.ini on the server lists the files that make up this application
    Call UpdateApp("myapp.ini")
End Sub

Here's the code of update.exe. First, module.bas:

'============ GENERAL =============================
Public Declare Function CopyPointer2String Lib "kernel32" _
   Alias "lstrcpyA" ( _
  ByVal NewString As String, ByVal OldString As Long) As Long
 
Public Declare Function lstrlenW Lib "kernel32" _
  (ByVal lpString As Long) As Long
 
Public Declare Sub CopyMemory Lib "kernel32" _
   Alias "RtlMoveMemory" _
  (pTo As Any, uFrom As Any, _
   ByVal lSize As Long)
 
'============ MD5 hashing =========================
Public Declare Sub MDFile Lib "aamd532.dll" (ByVal f As String, ByVal r As String)
 
'============= PROGRESS BAR ========================
' Brought to you by:
'   Brad Martinez
'   btmtz@aol.com
'   http:' //members.aol.com/btmtz/vb
 
Global m_hProgBar As Long   ' hWnd
 
Public Declare Sub InitCommonControls Lib "comctl32.dll" ()
Public Declare Function InitCommonControlsEx Lib "comctl32.dll" (lpInitCtrls As tagINITCOMMONCONTROLSEX) As Boolean
 
Type tagINITCOMMONCONTROLSEX
    dwSize As Long
    dwICC As Long
End Type
 
Public Const ICC_LISTVIEW_CLASSES = &H1    ' // listview, header
Public Const ICC_TREEVIEW_CLASSES = &H2  ' // treeview, tooltips
Public Const ICC_BAR_CLASSES = &H4            ' // toolbar, statusbar, trackbar, tooltips
Public Const ICC_TAB_CLASSES = &H8             ' // tab, tooltips
Public Const ICC_UPDOWN_CLASS = &H10       ' // updown
Public Const ICC_PROGRESS_CLASS = &H20   ' // progress
Public Const ICC_HOTKEY_CLASS = &H40         ' // hotkey
Public Const ICC_ANIMATE_CLASS = &H80        ' // animate
Public Const ICC_WIN95_CLASSES = &HFF        ' loads everything above
Public Const ICC_DATE_CLASSES = &H100        ' // month picker, date picker, time picker, updown
Public Const ICC_USEREX_CLASSES = &H200   ' // comboex
Public Const ICC_COOL_CLASSES = &H400       ' // rebar (coolbar) control
 
 
Public Const PROGRESS_CLASS = "msctls_progress32"
 
Public Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" _
                          (ByVal dwExStyle As Long, ByVal lpClassName As String, _
                           ByVal lpWindowName As String, ByVal dwStyle As Long, _
                           ByVal x As Long, ByVal y As Long, _
                           ByVal nWidth As Long, ByVal nHeight As Long, _
                           ByVal hWndParent As Long, ByVal hMenu As Long, _
                           ByVal hInstance As Long, lpParam As Any) As Long
Public Const PBS_SMOOTH = &H1    ' IE3 and later
Public Const PBS_VERTICAL = &H4   ' IE3 and later
Public Const WS_VISIBLE = &H10000000
Public Const WS_CHILD = &H40000000
 
Public Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
 
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
                          (ByVal hwnd As Long, ByVal wMsg As Long, _
                          wParam As Any, lParam As Any) As Long
 
Public Const WM_USER = &H400
Public Const PBM_SETRANGE = (WM_USER + 1)
Public Const PBM_SETPOS = (WM_USER + 2)
Public Const PBM_DELTAPOS = (WM_USER + 3)
Public Const PBM_SETSTEP = (WM_USER + 4)
Public Const PBM_STEPIT = (WM_USER + 5)
Public Const PBM_SETRANGE32 = (WM_USER + 6)
Public Const PBM_GETRANGE = (WM_USER + 7)
Public Const PBM_GETPOS = (WM_USER + 8)
 
Type PPBRANGE
   iLow As Integer
   iHigh As Integer
End Type
 
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 
Public Declare Function IsWindow Lib "user32" (ByVal hwnd As Long) As Long
 
'============= WININET.DLL ========================
Type INTERNET_VERSION_INFO
    dwMajorVersion As Long
    dwMinorVersion As Long
End Type
 
Enum WinInet_Versions
    INET_VER_ERROR = 0
    INET_VER_UNKNOWN = 1
    INET_VER_IE3 = 3 'wininet shipped with IE3
    INET_VER_IE4 = 4 '-//- with IE4
    INET_VER_IE5 = 5 '-//- with IE5
End Enum
 
 
Public Const SITE = "http://www.acme.com"
 
Public Const INTERNET_OPTION_VERSION = 40
Public Const INTERNET_OPEN_TYPE_PRECONFIG As Long = 0
Public Const INTERNET_OPEN_TYPE_DIRECT As Long = 1
Public Const INTERNET_OPEN_TYPE_PROXY As Long = 3
Public Const HTTP_QUERY_CONTENT_LENGTH As Long = 5
Public Const INTERNET_FLAG_RELOAD As Long = &H80000000
 
'WinInet Declarations
Public Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Public Declare Function HttpQueryInfo Lib "wininet.dll" Alias "HttpQueryInfoA" (ByVal hHttpRequest As Long, ByVal lInfoLevel As Long, ByRef sBuffer As Any, ByRef lBufferLength As Long, ByRef lIndex As Long) As Integer
Public Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" (ByVal hOpen As Long, ByVal sUrl As String, ByVal sHeaders As String, ByVal lLength As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Public Declare Function HttpOpenRequest Lib "wininet.dll" Alias "HttpOpenRequestA" (ByVal hHttpSession As Long, ByVal sVerb As String, ByVal sObjectName As String, ByVal sVersion As String, ByVal sReferer As String, ByVal something As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Public Declare Function HttpSendRequest Lib "wininet.dll" Alias "HttpSendRequestA" (ByVal hHttpRequest As Long, ByVal sHeaders As String, ByVal lHeadersLength As Long, sOptional As Any, ByVal lOptionalLength As Long) As Integer
Public Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
Public Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
Public Declare Function InternetQueryDataAvailable Lib "wininet.dll" (ByVal hFile As Long, lpdwNumberOfBytesAvailable As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Public Declare Function InternetQueryOption Lib "wininet.dll" Alias "InternetQueryOptionA" (ByVal hInternet As Long, ByVal dwOption As Long, lpBuffer As Any, lpdwBufferLength As Long) As Long
 
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function GetProcAddress Lib "kernel32" (ByVal hLibrary As Long, ByVal strFunctionName As String) As Long
Public Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal strFileName As String) As Long
Public Declare Function FreeLibrary Lib "kernel32" (ByVal hLibrary As Long) As Long
  
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Public Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
 
'============= ProcessID ========================
Private Type LUID
   lowpart As Long
   highpart As Long
End Type
 
Private Type TOKEN_PRIVILEGES
    PrivilegeCount As Long
    LuidUDT As LUID
    Attributes As Long
End Type
 
Const TOKEN_ADJUST_PRIVILEGES = &H20
Const TOKEN_QUERY = &H8
Const SE_PRIVILEGE_ENABLED = &H2
Const PROCESS_ALL_ACCESS = &H1F0FFF
 
Private Declare Function GetVersion Lib "kernel32" () As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As _
    Long
Private Declare Function OpenProcessToken Lib "advapi32" (ByVal ProcessHandle _
    As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function LookupPrivilegeValue Lib "advapi32" Alias _
    "LookupPrivilegeValueA" (ByVal lpSystemName As String, _
    ByVal lpName As String, lpLuid As LUID) As Long
Private Declare Function AdjustTokenPrivileges Lib "advapi32" (ByVal _
    TokenHandle As Long, ByVal DisableAllPrivileges As Long, _
    NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, _
    PreviousState As Any, ReturnLength As Any) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As _
    Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As _
    Long, ByVal uExitCode As Long) As Long
 
Public Function MD5File(f As String) As String
' compute MD5 digest on o given file, returning the result
    Dim r As String * 32
    r = Space(32)
    MDFile f, r
    MD5File = r
End Function
 
Function GetWinInetVersion() As WinInet_Versions
 
    Dim lStructSize As Long
    Dim VersionStruct As INTERNET_VERSION_INFO
    Dim lRetVal As Long
 
    lStructSize = Len(VersionStruct)
 
    lRetVal = InternetQueryOption(0&, INTERNET_OPTION_VERSION, _
                                  VersionStruct, lStructSize)
    If lRetVal = 0 Then
        GetWinInetVersion = INET_VER_ERROR
        Exit Function
    Else
        If VersionStruct.dwMajorVersion = 1 Then
            Select Case VersionStruct.dwMinorVersion
                Case 0
                    GetWinInetVersion = INET_VER_IE3
                Case 1
                    GetWinInetVersion = INET_VER_IE4
                Case 2
                    GetWinInetVersion = INET_VER_IE5
                Case Else
                    GetWinInetVersion = INET_VER_UNKNOWN
                End Select
        Else
            GetWinInetVersion = INET_VER_UNKNOWN
        End If
    End If
 
End Function
 
Public Function HttpReadPage(ByVal Url As String, Optional lSize As Long, Optional cMe As Control = Nothing) As String
    Dim vBuff As String
    Dim vhOpen As Long
    Dim vhUrl As Long
    Dim vSize As Long
    Dim vRet As Long
    
    Dim dwItins As Long
    Dim dwIncrement As Long
    
    'BAD: uses cache instead ! vhOpen = InternetOpen("Mozilla/4.0", INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
    vhOpen = InternetOpen("Mozilla/4.0", INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, INTERNET_FLAG_NO_CACHE_WRITE)
    If vhOpen Then
        vhUrl = InternetOpenUrl(vhOpen, Url, vbNullString, 0, INTERNET_FLAG_RELOAD, 0)
        If vhUrl Then
            If InternetQueryDataAvailable(vhUrl, vSize, 0, 0) Then
                If (vSize = 0) Then vSize = 4096
                
                If lSize Then
                    dwIncrement = lSize * 0.1
                    'BAD!!!! Overflow? SendMessage m_hProgBar, PBM_SETRANGE, 0, ByVal (lSize * &H10000)
                    SendMessage m_hProgBar, PBM_SETRANGE, 0, ByVal (100 * &H10000)
                    SendMessage m_hProgBar, PBM_SETSTEP, ByVal 1, 0
                End If
                
                vBuff = String(vSize, 0)
                Dim dwIdx As Long
                dwIdx = 0
                Dim sLabel As String
                If Not cMe Is Nothing Then
                    sLabel = cMe.Caption
                End If
                Do
                    If InternetReadFile(vhUrl, vBuff, vSize, vRet) = False Then
                        MsgBox "Error downloading " & Url, vbExclamation, "Network error"
                        HttpReadPage = "Bad"
                        Exit Function
                    End If
                    dwIdx = dwIdx + vRet
                    If lSize Then
                        'BAD Form1.Label1.Caption = sLabel & " " & (dwIdx \ lSize) & "%"
                        If Not cMe Is Nothing Then
                            cMe.Caption = sLabel & " " & CInt((dwIdx / lSize) * 100) & "%"
                        End If
                        SendMessage m_hProgBar, PBM_SETPOS, ByVal CLng((dwIdx / lSize) * 100), 0
                    End If
                    If (vRet = 0) Then Exit Do
                    HttpReadPage = HttpReadPage & Left$(vBuff, vRet)
                    DoEvents
                Loop
            End If
            InternetCloseHandle vhUrl
        End If
        InternetCloseHandle vhOpen
    End If
End Function
 
Public Function FileExists(ByVal filename As String) As Boolean
    Dim length As Long
    
    On Error GoTo FileDoesntExist
    length = FileLen(filename)
    FileExists = True
    Exit Function
         
FileDoesntExist:
    FileExists = False
End Function
 
'Used to regiser a file with .ocx extension
Public Function RegisterCom(ByVal strFileName As String) As Boolean
  
  Dim hLibrary As Long
  Dim hFunction As Long
  
  ' Validate parameters
  strFileName = Trim(strFileName)
  If Dir(strFileName, vbArchive Or vbHidden Or vbNormal Or vbReadOnly Or vbSystem) = "" Then
    Exit Function
  End If
  If Right(strFileName, 1) <> Chr(0) Then strFileName = strFileName & Chr(0)
  
  ' Load the COM object using the LoadLibrary function
  hLibrary = LoadLibrary(strFileName)
  If hLibrary = 0 Then Exit Function
  
  ' Get the handle to the function to call
  hFunction = GetProcAddress(hLibrary, "DllRegisterServer" & Chr(0))
  If hFunction = 0 Then GoTo CleanUp
  
  ' Call the function
  If CallWindowProc(hFunction, 0, 0, 0, 0) = 0 Then RegisterCom = True
  
CleanUp:
  
  If hLibrary <> 0 Then FreeLibrary hLibrary
  
End Function
 
Function InternetCheck() As Boolean
    Dim vhOpen As Long
    Dim vhUrl As Long
    
    InternetCheck = False
    
    vhOpen = InternetOpen("Mozilla/4.0", INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
    If vhOpen Then
        vhUrl = InternetOpenUrl(vhOpen, "http://www.google.com", vbNullString, 0, INTERNET_FLAG_RELOAD, 0)
        If vhUrl Then
            InternetCheck = True
            InternetCloseHandle vhUrl
        End If
        InternetCloseHandle vhOpen
    End If
End Function
 
' Terminate any application and return an exit code to Windows
' This works under NT/2000, even when the calling process
' doesn't have the privilege to terminate the application
' (for example, this may happen when the process was launched
'  by yet another program)
'
' Usage:  Dim pID As Long
'         pID = Shell("Notepad.Exe", vbNormalFocus)
'         '...
'         If KillProcess(pID, 0) Then
'             MsgBox "Notepad was terminated"
'         End If
 
Function KillProcess(ByVal hProcessID As Long, Optional ByVal ExitCode As Long) _
    As Boolean
    Dim hToken As Long
    Dim hProcess As Long
    Dim tp As TOKEN_PRIVILEGES
    
    ' Windows NT/2000 require a special treatment
    ' to ensure that the calling process has the
    ' privileges to shut down the system
    
    ' under NT the high-order bit (that is, the sign bit)
    ' of the value retured by GetVersion is cleared
    If GetVersion() >= 0 Then
        ' open the tokens for the current process
        ' exit if any error
        If OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES Or _
            TOKEN_QUERY, hToken) = 0 Then
            GoTo CleanUp
        End If
        
        ' retrieves the locally unique identifier (LUID) used
        ' to locally represent the specified privilege name
        ' (first argument = "" means the local system)
        ' Exit if any error
        If LookupPrivilegeValue("", "SeDebugPrivilege", tp.LuidUDT) = 0 Then
            GoTo CleanUp
        End If
    
        ' complete the TOKEN_PRIVILEGES structure with the # of
        ' privileges and the desired attribute
        tp.PrivilegeCount = 1
        tp.Attributes = SE_PRIVILEGE_ENABLED
    
        ' try to acquire debug privilege for this process
        ' exit if error
        If AdjustTokenPrivileges(hToken, False, tp, 0, ByVal 0&, _
            ByVal 0&) = 0 Then
            GoTo CleanUp
        End If
    End If
    
    ' now we can finally open the other process
    ' while having complete access on its attributes
    ' exit if any error
    hProcess = OpenProcess(PROCESS_ALL_ACCESS, 0, hProcessID)
    If hProcess Then
        ' call was successful, so we can kill the application
        ' set return value for this function
        KillProcess = (TerminateProcess(hProcess, ExitCode) <> 0)
        ' close the process handle
        CloseHandle hProcess
    End If
    
    If GetVersion() >= 0 Then
        ' under NT restore original privileges
        tp.Attributes = 0
        AdjustTokenPrivileges hToken, False, tp, 0, ByVal 0&, ByVal 0&
        
CleanUp:
        If hToken Then CloseHandle hToken
    End If
End Function
 
Public Function GetCommandLine(ArgArray() As Variant, Optional MaxArgs)
    Dim C, CmdLine, CmdLnLen, InArg, I, NumArgs
 
    If IsMissing(MaxArgs) Then MaxArgs = 10
 
    ReDim ArgArray(MaxArgs)
    NumArgs = 0: InArg = False
 
    'Extract params from command line
    CmdLine = Command()
    CmdLnLen = Len(CmdLine)
    For I = 1 To CmdLnLen
 
        C = Mid(CmdLine, I, 1)
        If (C <> " " And C <> vbTab) Then
            If Not InArg Then
            If NumArgs = MaxArgs Then Exit For
                NumArgs = NumArgs + 1
                InArg = True
 
            End If
            ArgArray(NumArgs) = ArgArray(NumArgs) + C
        Else
            'InArg flag prend la valeur False.
            InArg = False
        End If
    Next I
 
    ReDim Preserve ArgArray(NumArgs)
 
    'GetCommandLine = ArgArray()
End Function
 
' Still needed?
' Return the window handle for an instance handle.
Public Function InstanceToWnd(ByVal target_pid As Long) As Long
    Dim test_hwnd As Long
    Dim test_pid As Long
    Dim test_thread_id As Long
 
    ' Get the first window handle.
    test_hwnd = FindWindow(ByVal 0&, ByVal 0&)
 
    ' Loop until we find the target or we run out
    ' of windows.
    Do While test_hwnd <> 0
        ' See if this window has a parent. If not,
        ' it is a top-level window.
        If GetParent(test_hwnd) = 0 Then
            ' This is a top-level window. See if
            ' it has the target instance handle.
            test_thread_id = _
                GetWindowThreadProcessId(test_hwnd, _
                test_pid)
 
            If test_pid = target_pid Then
                ' This is the target.
                InstanceToWnd = test_hwnd
                Exit Do
            End If
        End If
 
        ' Examine the next window.
        test_hwnd = GetWindow(test_hwnd, GW_HWNDNEXT)
    Loop
End Function
 
Public Function ExtractLeft(sString As String) As String
    ExtractLeft = Left$(sString, InStr(sString, ".") - 1)
End Function
 
Public Function CheckIfUpdateNeeded(sStuff As String) As Boolean
    Dim iPos As Integer
    Dim sItem As String
    Dim sName As String
    Dim sSize As String
    'Dim oHash As New MD5
    Dim sHash As String
    Dim sDLL As String
    Dim sFile As String
    Dim iFile As Integer
    
    CheckIfUpdateNeeded = False
    
    'Err 53 not trapped by FileExists()!
    On Error Resume Next
            
    'Check if aamd532.dll available to hash local files
    sDLL = "aamd532.dll"
    If Not FileExists(App.Path & "\" & sDLL) Then
        sFile = HttpReadPage(SITE & sDLL, Val(sSize))
        If sFile = "Bad" Then
            MsgBox "Error downloading " & sDLL, vbExclamation, "Error downloading"
            End
        End If
        
        iFile = FreeFile
        Open App.Path & "\" & sDLL For Binary Access Write As #iFile
        Put #iFile, , sFile
        Close #iFile
    End If
    
    'Parse output from checkhash.php, and compare with local files
    iPos = 1
    Dim iPosInside As Integer
    Do While iPos < Len(sStuff)
        sItem = Mid$(sStuff, iPos, InStr(iPos, sStuff, "#") - iPos)
        
        iPosInside = 1
        sName = Mid$(sItem, iPosInside, InStr(iPosInside, sItem, ",") - iPosInside)
        iPosInside = iPosInside + Len(sName) + 1
        
        sSize = Mid$(sItem, iPosInside, (InStr(iPosInside, sItem, ",")) - iPosInside)
        iPosInside = iPosInside + Len(sSize) + 1
        
        sHash = Right$(sItem, (Len(sItem) - iPosInside) + 1)
        If sHash = "-1" Then
            'Call AddItem("Fichier non trouv : " & sName)
        Else
            If Not FileExists(App.Path & "\" & sName) Or sHash <> MD5File(App.Path & "\" & sName) Then
                CheckIfUpdateNeeded = True
                Exit Function
            Else
                'MsgBox sName & " is up to date"
            End If
        
        End If
        
        iPos = iPos + Len(sItem) + 1
        DoEvents
    Loop
    
End Function
 
 
Public Function GetPointerToByteStringW(ByVal dwData As Long) As String
  
   Dim tmp() As Byte
   Dim tmplen As Long
   
   If dwData <> 0 Then
   
      tmplen = lstrlenW(dwData) * 2
      
      If tmplen <> 0 Then
      
         ReDim tmp(0 To (tmplen - 1)) As Byte
         CopyMemory tmp(0), ByVal dwData, tmplen
         GetPointerToByteStringW = tmp
         
     End If
     
   End If
    
End Function
 
'Needed to use progress bar
Public Function IsNewComctl32() As Boolean
    Dim icc As tagINITCOMMONCONTROLSEX
    On Error GoTo OldVersion
    icc.dwSize = Len(icc)
    icc.dwICC = ICC_PROGRESS_CLASS
    IsNewComctl32 = InitCommonControlsEx(icc)
    Exit Function
 
OldVersion:
    InitCommonControls
End Function
 
Public Function PointerToString(p As Long) As String
    'The values returned in the NETRESOURCE structures are pointers to
    'ANSI strings so they need to be converted to Visual Basic Strings.
    Dim s As String
    s = String(255, Chr$(0))
    CopyPointer2String s, p
    PointerToString = Left(s, InStr(s, Chr$(0)) - 1)
End Function

Next, form1.frm:

Dim sCmdLine As String
Dim ArgArray() As Variant
Dim sStuff As String
Dim sEXE As String
 
'rsout pas le problme tt en bas... sEXE = vbNullString
 
Dim iFile As Integer
Dim iPos As Integer
Dim sItem As String
Dim sName As String
Dim sSize As String
Dim sFile As String
 
'A new version is available. Would you like to update? OK
Private Sub Command1_Click()
    Command1.Enabled = False
    
    'Parameter 2 = PID (optional)
    If UBound(ArgArray) >= 2 Then
        '[TODO] Get caller EXE name from PID
        'http://groups.google.com/groups?q=vb+name+from+pid&start=30&hl=en&lr=&ie=UTF-8&selm=q540301mtaftja00eee5lb19njj93gm5gc%404ax.com&rnum=39
        'http://groups.google.com/groups?hl=en&lr=&ie=UTF-8&threadm=e%23tDDPW3BHA.2428%40tkmsftngp07&rnum=49&prev=/groups%3Fq%3Dvb%2Bname%2Bfrom%2Bpid%26start%3D40%26hl%3Den%26lr%3D%26ie%3DUTF-8%26selm%3De%2523tDDPW3BHA.2428%2540tkmsftngp07%26rnum%3D49
        If KillProcess(Val(ArgArray(2)), 0) Then
            'MsgBox "Caller app closed successfully."
        Else
            'MsgBox "Error while closing caller app"
        End If
    End If
    
    'Display progress bar without OCX
    Call IsNewComctl32
    m_hProgBar = CreateWindowEx(0, PROGRESS_CLASS, vbNullString, _
       WS_CHILD Or WS_VISIBLE Or _
       PBS_SMOOTH, _
       10, 25, 390, 15, _
       hwnd, 0, _
       App.hInstance, ByVal 0)
    
    If m_hProgBar = 0 Then
        'MsgBox "Error loading progress bar", vbExclamation, "CreateWindowEx"
        'Exit Sub
    End If
    
    'Parse output from PHP script "file,hash,size#", and compare
    '[TODO] This is the second time we parsed the INI -> put in array to avoid two parsings
    iPos = 1
    Dim iPosInside As Integer
    Dim sHash As String
    
    Do While iPos < Len(sStuff)
        sItem = Mid$(sStuff, iPos, InStr(iPos, sStuff, "#") - iPos)
        
        iPosInside = 1
        sName = Mid$(sItem, iPosInside, InStr(iPosInside, sItem, ",") - iPosInside)
        iPosInside = iPosInside + Len(sName) + 1
        
        sSize = Mid$(sItem, iPosInside, (InStr(iPosInside, sItem, ",")) - iPosInside)
        iPosInside = iPosInside + Len(sSize) + 1
        
        sHash = Right$(sItem, (Len(sItem) - iPosInside) + 1)
        
        If sHash = "-1" Then
            'Call AddItem("File not found : " & sName)
        Else
            'Err 53 not caught by FileExists()!
            On Error Resume Next
            Err.Clear
 
            If Not FileExists(App.Path & "\" & sName) Or sHash <> MD5File(App.Path & "\" & sName) Then
                '!! MUST USE, OR FILE IS REPLACED BUT MAINTAINS SAME SIZE !!!!
                Kill App.Path & "\" & sName
                
                Me.Label1.Caption = "Downloading " & sName
                sFile = HttpReadPage(SITE & sName, Val(sSize), Me.Label1)
                If sFile = "Bad" Then
                    End
                End If
                
                '[TODO] Check if OK if file exists but size different (do KILL before?)
                iFile = FreeFile
                Open App.Path & "\" & sName For Binary Access Write As #iFile
                Put #iFile, , sFile
                Close #iFile
                
                'Call AddItem(sName & " : mise jour effectue")
                
                If InStr(sName, ".ocx") Then
                    Call RegisterCom(App.Path & "\" & sName)
                End If
            Else
                'Call AddItem(sName & " : up to date")
            End If
        End If
        
        iPos = iPos + Len(sItem) + 1
        DoEvents
    Loop
    
    If IsWindow(m_hProgBar) Then DestroyWindow m_hProgBar
    
    'Relaunch caller EXE
    If sEXE Then
        Call Shell(sEXE, vbNormalFocus)
    End If
    
    'Download <left part of INI>.txt, as a MOTD (Message of the day)
    sFile = ExtractLeft(sCmdLine) & ".txt"
    sStuff = HttpReadPage(SITE & sFile)
    If InStr(sStuff, "<TITLE>404 Not Found</TITLE>") Then
        'Call AddItem("(no changes file available)")
    Else
        'Display .TXT file in NotePad so customers can print
        iFile = FreeFile
        Open App.Path & "\" & sFile For Binary Access Write As #iFile
        Put #iFile, , sStuff
        Close #iFile
        Call Shell("notepad.exe " & App.Path & "\" & sFile, vbNormalFocus)
    End If
    
    End
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
    Set Form1 = Nothing
    End
End Sub
 
'Do you wish to update? Cancel
Private Sub Command2_Click()
    End
End Sub
 
Private Sub Form_Load()
    Dim sServers() As String
    
    Me.Caption = App.EXEName & " - " & App.Major & "." & App.Minor & "." & App.Revision
    
    If InternetCheck() Then
        Call GetCommandLine(ArgArray())
        
        'UPDATE.EXE launched manually?
        If UBound(ArgArray) = 0 Then
            Do While (True)
                sCmdLine = InputBox("Update file? (ex. myapp.ini)", "Please select list of files to check", "myapp.ini")
                If sCmdLine = vbNullString Then
                    End
                Else
                    Exit Do
                End If
            Loop
        End If
        
        'Only one param = name of INI file
        If UBound(ArgArray) >= 1 Then
            sCmdLine = ArgArray(1)
        End If
        
        'If 2 params, second param is PID of caller EXE : killed some time below...
        
        'Param 3  = caller EXE to relaunch (optional)
        If UBound(ArgArray) = 3 Then
            sEXE = ArgArray(3)
        End If
        
        If UBound(ArgArray) > 3 Then
            MsgBox App.EXEName & " called with more than 3 parameters", vbExclamation, "Error calling application"
            End
        End If
            
        sStuff = HttpReadPage(SITE & "checkhash.php?input=" & sCmdLine)
        If InStr(sStuff, "<TITLE>404 Not Found</TITLE>") Or InStr(sStuff, "Unable to access") Then
            'MsgBox "File not found: " & sCmdLine, vbInformation, "File not found on web site"
            End
        End If
    
        If CheckIfUpdateNeeded(sStuff) Then
            Me.Show
        Else
            'MsgBox "All files up to date"
            End
        End If
    
    Else
        MsgBox "Internet connection not found", vbInformation, "Updating programs"
        End
    End If
End Sub

Here's checksize.php to check if update.exe itselfs hasn't changed on the server:

<?php
//Called through http://www.acme.com/downloads/checksize.php?input=update.exe
$file = $_GET['input'];
if (file_exists($file))
        print(filesize($file));
else
        print("-1");
?>

Here's what an INI file on the server looks like:

myfile.exe
mydll.dll

And here's checkhash.php that takes the INI file, and adds an MD5 hash for each file:

<?php
//Called through http://www.acme.com/downloads/checkhash.php?input=myapp.ini
 
$listFile = $_GET['input'];
if (!($fp = fopen($listFile, "r")))
        exit("Unable to open $listFile.");
 
while (!feof($fp)) {
        $buffer = fscanf($fp, "%s", $name);
        if ($buffer == 1) {
                //To avoid issues with CRLF or CR, I prefer to not use carriage returns at all,
                //and just return eg. file1,size1,hash1#file2,size2,hash2
                if (file_exists($name)) {
                        print "$name," . filesize($name) . "," . md5_file($name) . "#";
                } else {
                        print "$name,-1,-1#";
                }               
        }
}
 
fclose ($fp);     
?>

Dependency Walker

For starters, there are certain modules you should never redistribute with your application, such as kernel32.dll, user32.dll, and gdi32.dll.

To see which files you are allowed to redistribute, you can look for a file named REDIST.TXT on your development computer.  This file is included with development suites like Microsoft Visual C++ and Visual Basic.

You can also look up "redistributable files" and "redist.txt" in the MSDN index for more information on what files to redistribute, how to redistribute them, how to check file versions, etc.  Another site worth mentioning is the Microsoft DLL Help Database (http://support.microsoft.com/servicedesks/FileVersion/dllinfo.asp).  This site has detailed version histories of DLLs, and lists what products were shipped with each version.

Dependency Walker can also perform a run-time profile of your application to detect dynamically loaded modules and module initialization failures.  The same error checking from above applies to dynamically loaded modules as well.

Explicit Dependency (also known as a dynamic or run-time dependency): Module A is not linked with Module B at compile/link time.  At runtime, Module A dynamically loads Module B via a LoadLibrary type function.  Module B becomes a run time dependency of Module A, but will not be listed in any of Module A’s tables.  This type of dependency is common with OCXs, COM objects, and Visual Basic applications.

Microsoft AppVerifier

Set of tools provided to test compatibility with XP, hence of no use on other versions of XP.

http://www.microsoft.com/technet/prodtechnol/winxppro/deploy/AppVrfr.asp

Working with pointers

Resources

Menus

To use pop-up menus (ie. "contextual menus"), build a menu with sub-items, make sure the top-level menu is invisible while at least one sub-item is visible, and use the following code in the MouseUp event:

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbRightButton Then
        PopupMenu Test, vbPopupMenuLeftAlign
    End If
End Sub

Debugging

Debug.Print "action:", "db_ID", "Namen", "Zeiten"

Using the IDE

To make it easier to navigate through code, make use of bookmarks: To set one, Edit | Bookmark | Set; To navigate Edit | Bookmark | Prev/Next; To remove all bookmarks, Edit | Bookmark | Remove all bookmarks.

A list of some shortcuts is here.

Make the most of the little-known niceties of the IDE:

... where A allows you to scroll through either just the current routine or through the entire file, while B lets you split the text box into two halves

Charting data

Here are some free or cheap controls to graph data:

Here's how to chart data in MSChart:

Option Base 1
 
Private Sub Form_Load()
    Dim arrData(3, 1 To 3)
    arrData(1, 1) = "Jan"   ' Set the labels in the first series.
    arrData(2, 1) = "Feb"
    arrData(3, 1) = "Mar"
    
    arrData(1, 2) = 8
    arrData(2, 2) = 4
    arrData(3, 2) = 0.3
    
    arrData(1, 3) = 0.2
    arrData(2, 3) = 3
    arrData(3, 3) = 6.3
    MSChart1.ChartData = arrData
End Sub

Reporting

Charting only handles the creation of graphs, while a reporting tool is able to fetch data from a database (SQL or file-based), and build full-fledged reports.

http://www.datadynamics.com/Products/ProductOverview.aspx?Product=SG

http://www.datadynamics.com/Products/ProductOverview.aspx?Product=AR2

http://www.sqlmag.com/Article/ArticleID/5222/sql_server_5222.html

http://www.freereporting.com/?gclid=COWYv8P45ocCFUKBQwodBzw_gg

http://www.componentsource.com/relevance/a100/xreport/index.html?q=REPORT%2A++BASIC%2A

http://www.synaptris.com/products/reporting-analytics/reporting/index.html

http://www.synaptris.com/products/reporting-analytics/reporting/intelliviewreporter/index.html

http://www.vbcity.com/forums/forum.asp?fid=53

http://visualbasic.ittoolbox.com/documents/popular-q-and-a/reporting-options-in-visual-basic-5-1230

http://www.componentsource.com/features/c201/xreport/index.html

http://groups.google.fr/groups?as_q=reporting+tool&num=10&scoring=r&hl=fr&as_epq=&as_oq=&as_eq=&as_ugroup=microsoft.public.vb.%2A&as_usubject=&as_uauthors=&lr=&as_drrb=q&as_qdr=&as_mind=1&as_minm=1&as_miny=1981&as_maxd=7&as_maxm=10&as_maxy=2006

http://www.freevbcode.com/ShowCode.asp?ID=2562

http://www.thescripts.com/forum/thread13641.html

http://www.google.com/search?q=%22visual+basic%22+reporting&hl=en&lr=&client=opera&rls=en&start=50&sa=N

http://www.sharewareconnection.com/titles/access-query-generator1.htm

http://www.google.fr/search?q=%22visual+basic%22+query+generator&hl=en&lr=&start=20&sa=N

http://www.eazycode.com/en/eazysql.htm

http://fast-report.com/en/products/

http://www.aglowsoft.com/

http://bidata.net/

http://www.tysonsoftware.co.uk/

http://www.superiorsql.com/

http://www.visualsoftru.com/main.asp

http://www.unitysolutions.com/utbdirect/

http://www.activequerybuilder.com/

Improving performance

RichText

There is an important caveat here -- you cannot assume that a file really is in RTF simply because its has an RTF extension. There are some macro viruses which intercept the attempt to save a file as RTF and force it to be saved as a DOC file, but with an RTF extension. If someone sends you such a file via email, and you double-click it, Word will attempt to load the file. Since Word recognizes it as a DOC file, despite its name, it loads it as a DOC file and activates the virus.

Fortunately, it is easy to check for yourself that an RTF really is what it claims. Try looking at a DOC file and an RTF file using NOTEPAD. The RTF file will load as legible ASCII text, starting with "{\rtf". The DOC file will load as binary gobbledegook. Although checking like this is inconvenient, it does let you make sure that things are as they seem, on those occasions when it really matters.

Write leading RTF Header

WriteToBuffer('{\rtf1\ansi\deff0\deftab720{\fonttbl{\f0\fswiss MS SansSerif;}

{\f1\froman\fcharset2 Symbol;}{\f2\fmodern Courier New;}}'+#13+#10);

WriteToBuffer('{\colortbl\red0\green0\blue0;}'+#13+#10);

WriteToBuffer('\deflang1033\pard\plain\f2\fs20 ');

A quick glimpse at RTF syntax

For those interested, here's how to add plain text and a URL into a RichEdit text box. It remains to add code in your application to change the cursor to the familiar arrow to show users that (yes) it's a clickable link, parse that token to extract the URL (should be easy thx to PB/DLL 6's regex support), and launch the default browser with the ShellExecute() function:

{\rtf1\ansi\ansicpg1252\deff0\deflang1033
{\colortbl;\red0\green0\blue255;}
{\stylesheet
{\*\cs15 \additive \ul\cf1 \sbasedon10 Hyperlink;}
}
 
Before URL
{\par }
 
{\field
{\*\fldinst {HYPERLINK http://www.powerbasic.com } }
{\fldrslt {\cs15\ul\cf1 http://www.powerbasic.com} }
}
{\par }
After URL
}

Managing time

To wait X seconds

Create a Timer object, set its interval, go to its Timer() routine, and place whatever code you want executed at every tick

Form_Load
    Timer1.Interval = 5000
 
Time1_Timer
    MsgBox "Keeps on ticking..."

Syncing clock

This code syncs a client host's clock to a server's through the NET TIME NetBios command:

Dim sCommand As String
sCommand = Environ("comspec")
sCommand = sCommand & " /c NET TIME \\SERVER /SET /YES"
   
Call Shell(sCommand, vbHide)

Programming forms

Scrolling down to the latest item in a Listbox

Here's how to add strings to a listbox, and scroll down to the last one:

List1.AddItem "Line 1"
List1.AddItem "Line 2"
List1.AddItem "Line 3"
List1.AddItem "Line 4"
List1.AddItem "Line 5"
List1.AddItem "Line 6"
 
With List1
    .ListIndex = .ListCount - 1
    .Selected(.ListIndex) = False
End With

Scrolling down in a textbox automatically

Same as the above, but here's how to have a multine textbox scroll down automatically as you add text to it:

  1. Add some text using Text1.Text = Text1.Text & "My new text" & vbCrLf
  2. Add this code to Text1.Change: Text1.SelStart = Len(Text1.Text)

Passing parameters between forms

From: Adrian M Newsgroups: microsoft.public.vb.general.discussion

What I normally do is just create properties for the form.  Something like:
Private mCarType As String Public Property Let CarType(s As String)
  mCarType = s
End Property
Now, before you show the form just set the properties:   
With Form1
    .CarType = "Ford"
    .Show
  End With

From: Bob Butler

maybe something like...
 
dlgEditCar.SetOptions "Ford","Taurus"
dlgEditCar.Show vbModal,Me
 
and in dlgEditCar:
 
Private msMake As String
Private msModel As String
 
Public Sub SetOptions(byval CarMake As string, byval CarModel As String)
    msMake=CarMake
    msModel=CarModel
End Sub
 
Be careful to watch where Form_Initialize and Form_Load fire -- it will vary depending on how you instantiate dlgEditCar so you may need to move code around there.

From: Rick Rothstein

You do not have to create global variables in order to pass information into forms. There are some which already exist by default which you can use. Every form comes with a Tag Property -- after the form is loaded (or shown), you can place a string of information in the Tag and pick it up anytime (say, Form1_Activate, Command1_Click, etc.). Also, properties can be set for controls on other forms. For example, program code on Form1 can set Command Button Captions on Form2 as follows: Form2.Command1.Caption = "Ford" Form2.Label1.Caption = "Taurus" or whatever you need. These too act as "automatic" global "variables".

From: Galtier guillaume

an other way to do it: declare a public variable in your form ('Public MyVar as string') Before calling your form, put the following code:
Dim Form1 As MyForm
Set Form1 = New MyForm
Form1.MyVar = 'value'
Form1.Show

From: Jeff Ashley

Darren: Certainly you want to be passing values between forms and to avoid declaring globals that are not really global to the application. You can pass values from form to form by
1.  setting and retrieving public properties
2.  setting and retrieving public variables
3.  passing values as parameters of a method (function or sub), byref or byval
There are arguments for all of these techniques (I suppose). Personally, I use (3) in virtually all cases.  Most of my forms have a Public Function Display which accepts parameters (required and optional), uses them to prepare its display, then shows the form.  If the form is being displayed modally, the function returns true if the user indicates 'OK', false if he/she cancels.  If values are to be returned, I expose them through read-only properties of the form (if Display has returned False, the caller realizes it should ignore those properties).  Forms shown modally hide themselves and are unloaded by their callers; others must, of course, unload themselves.   Occasionally (not often), a form will be able to raise an event back to its caller, which would be another way to return data with a parameter list (I've never used it for that, though).  It works for me.  Hope it helps you.  

Programming objects

Checking for existence of optional parameter

Starting with VB5, you can pass optional parameters. Here's how to check whether a routine was called with a given parameter:

Public Sub BLT(Optional cMe As Control = Nothing)
    If Not cMe Is Nothing Then

Another way:

Public Sub BLT(Optional cMe As Control = Nothing)
    If Not TypeName(cMe) = "Nothing" Then

Those don't work:

To simulate an event

eg. pretending that a button was clicked

Command1.Value = True

Accessing INI files

Put this in a module:

Declare Function GetPrivateProfileString Lib "kernel32" Alias _
   "GetPrivateProfileStringA" (ByVal lpApplicationName As String, _
   ByVal lpKeyName As Any, ByVal lpDefault As String, _
   ByVal lpReturnedString As String, ByVal nSize As Long, _
   ByVal lpFileName As String) As Long
 
Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" ( _
    ByVal lpApplicationName As String, _
    ByVal lpKeyName As Any, _
    ByVal lpString As Any, _
    ByVal lpFileName As String) As Long

... and this in a form:

Private Sub Form_DblClick()
    'We'll write into C:\TEST.INI, in a section called [myapp], a key called "mykey"
    'whose value is "myvalue"
    Call WritePrivateProfileString("myapp", "mykey", "myvalue", "c:\test.ini")
    
    'sValue will contain the value of mykey, if any
    Dim sValue As String * 128
    Dim lValue As Long
    lValue = Len(sValue)
    
    '3rd param = default value if mykey doesn't exist or is empty
    Call GetPrivateProfileString("myapp", "mykey", "key empty or non-existent", sValue, lValue, "c:\test.ini")
    MsgBox sValue
End Sub

Accessing the Registry

Here's some code written by Kenneth Ives:

Constants and Declarations

Private m_lngRetVal As Long
Private Const REG_NONE As Long = 0                  ' No value type
Private Const REG_SZ As Long = 1                    ' nul terminated string
Private Const REG_EXPAND_SZ As Long = 2             ' nul terminated string w/enviornment var
Private Const REG_BINARY As Long = 3                ' Free form binary
Private Const REG_DWORD As Long = 4                 ' 32-bit number
Private Const REG_DWORD_LITTLE_ENDIAN As Long = 4   ' 32-bit number (same as REG_DWORD)
Private Const REG_DWORD_BIG_ENDIAN As Long = 5      ' 32-bit number
Private Const REG_LINK As Long = 6                  ' Symbolic Link (unicode)
Private Const REG_MULTI_SZ As Long = 7              ' Multiple Unicode strings
Private Const REG_RESOURCE_LIST As Long = 8         ' Resource list in the resource map
Private Const REG_FULL_RESOURCE_DESCRIPTOR As Long = 9 ' Resource list in the hardware description
Private Const REG_RESOURCE_REQUIREMENTS_LIST As Long = 10
 
Private Const KEY_QUERY_VALUE As Long = &H1
Private Const KEY_SET_VALUE As Long = &H2
Private Const KEY_CREATE_SUB_KEY As Long = &H4
Private Const KEY_ENUMERATE_SUB_KEYS As Long = &H8
Private Const KEY_NOTIFY As Long = &H10
Private Const KEY_CREATE_LINK As Long = &H20
Private Const KEY_ALL_ACCESS As Long = &H3F
 
Private Const HKEY_CLASSES_ROOT As Long = &H80000000
Private Const HKEY_CURRENT_USER As Long = &H80000001
Private Const HKEY_LOCAL_MACHINE As Long = &H80000002
Private Const HKEY_USERS As Long = &H80000003
Private Const HKEY_PERFORMANCE_DATA As Long = &H80000004
Private Const HKEY_CURRENT_CONFIG As Long = &H80000005
Private Const HKEY_DYN_DATA As Long = &H80000006
 
Private Const ERROR_SUCCESS As Long = 0
Private Const ERROR_ACCESS_DENIED As Long = 5
Private Const ERROR_NO_MORE_ITEMS As Long = 259
 
Private Const REG_OPTION_NON_VOLATILE As Long = 0
Private Const REG_OPTION_VOLATILE As Long = &H1
 
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal lngRootKey As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal lngRootKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal lngRootKey As Long, ByVal lpSubKey As String) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal lngRootKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal lngRootKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal lngRootKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal lngRootKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long

regCreate_A_Key

Public Function regCreate_A_Key(ByVal lngRootKey As Long, ByVal strRegKeyPath As String)
 
' --------------------------------------------------------------
' Written by Kenneth Ives                     kenaso@home.com
'
' Important:     If you treat all key data strings as being
'                case sensitive, you should never have a problem.
'                Always backup your registry files (System.dat
'                and User.dat) before performing any type of
'                modifications
'
' Description:   This function will create a new key
'
' Parameters:
'          lngRootKey  - HKEY_CLASSES_ROOT, HKEY_CURRENT_USER,
'                  HKEY_lOCAL_MACHINE, HKEY_USERS, etc
'   strRegKeyPath  - is name of the key you wish to create.
'                  to make sub keys, continue to make this
'                  call with each new level.  MS says you
'                  can do this in one call; however, the
'                  best laid plans of mice and men ...
'
' Syntax:
'   regCreate_A_Key HKEY_CURRENT_USER, "Software\AAA-Registry Test"
'   regCreate_A_Key HKEY_CURRENT_USER, "Software\AAA-Registry Test\Products"
' --------------------------------------------------------------
 
' --------------------------------------------------------------
' Define variables
' --------------------------------------------------------------
  Dim lngKeyHandle As Long
  
' --------------------------------------------------------------
' Create the key.  If it already exist, ignore it.
' --------------------------------------------------------------
  m_lngRetVal = RegCreateKey(lngRootKey, strRegKeyPath, lngKeyHandle)
 
' --------------------------------------------------------------
' Always close the handle in the registry.  We do not want to
' corrupt these files.
' --------------------------------------------------------------
  m_lngRetVal = RegCloseKey(lngKeyHandle)
  
End Function

regCreate_Key_Value

Public Sub regCreate_Key_Value(ByVal lngRootKey As Long, ByVal strRegKeyPath As String, _
                               ByVal strRegSubKey As String, varRegData As Variant)
    
' --------------------------------------------------------------
' Written by Kenneth Ives                     kenaso@home.com
'
' Important:     If you treat all key data strings as being
'                case sensitive, you should never have a problem.
'                Always backup your registry files (System.dat
'                and User.dat) before performing any type of
'                modifications
'
' Description:   Function for saving string data.
'
' Parameters:
'           lngRootKey - HKEY_CLASSES_ROOT, HKEY_CURRENT_USER,
'                  HKEY_lOCAL_MACHINE, HKEY_USERS, etc
'    strRegKeyPath - is name of the key path you wish to traverse.
'     strRegSubKey - is the name of the key which will be updated.
'       varRegData - Update data.
'
' Syntax:
'    regCreate_Key_Value HKEY_CURRENT_USER, _
'                      "Software\AAA-Registry Test\Products", _
'                      "StringTestData", "22 Jun 1999"
'
' Saves the key value of "22 Jun 1999" to sub key "StringTestData"
' --------------------------------------------------------------
    
' --------------------------------------------------------------
' Define variables
' --------------------------------------------------------------
  Dim lngKeyHandle As Long
  Dim lngDataType As Long
  Dim lngKeyValue As Long
  Dim strKeyValue As String
  
' --------------------------------------------------------------
' Determine the type of data to be updated
' --------------------------------------------------------------
  If IsNumeric(varRegData) Then
      lngDataType = REG_DWORD
  Else
      lngDataType = REG_SZ
  End If
  
' --------------------------------------------------------------
' Query the key path
' --------------------------------------------------------------
  m_lngRetVal = RegCreateKey(lngRootKey, strRegKeyPath, lngKeyHandle)
    
' --------------------------------------------------------------
' Update the sub key based on the data type
' --------------------------------------------------------------
  Select Case lngDataType
         Case REG_SZ:       ' String data
              strKeyValue = Trim(varRegData) & Chr(0)     ' null terminated
              m_lngRetVal = RegSetValueEx(lngKeyHandle, strRegSubKey, 0&, lngDataType, _
                                          ByVal strKeyValue, Len(strKeyValue))
                                   
         Case REG_DWORD:    ' numeric data
              lngKeyValue = CLng(varRegData)
              m_lngRetVal = RegSetValueEx(lngKeyHandle, strRegSubKey, 0&, lngDataType, _
                                          lngKeyValue, 4&)  ' 4& = 4-byte word (long integer)
                                   
  End Select
  
' --------------------------------------------------------------
' Always close the handle in the registry.  We do not want to
' corrupt these files.
' --------------------------------------------------------------
  m_lngRetVal = RegCloseKey(lngKeyHandle)
  
End Sub

regDoes_Key_Exist

Public Function regDoes_Key_Exist(ByVal lngRootKey As Long, _
                                  ByVal strRegKeyPath As String) As Boolean
    
' --------------------------------------------------------------
' Written by Kenneth Ives                     kenaso@home.com
'
' Important:     If you treat all key data strings as being
'                case sensitive, you should never have a problem.
'                Always backup your registry files (System.dat
'                and User.dat) before performing any type of
'                modifications
'
' Description:   Function to see if a key does exist
'
' Parameters:
'           lngRootKey - HKEY_CLASSES_ROOT, HKEY_CURRENT_USER,
'                  HKEY_lOCAL_MACHINE, HKEY_USERS, etc
'    strRegKeyPath - is name of the key path you want to test
'
' Syntax:
'    strKeyQuery = regQuery_A_Key(HKEY_CURRENT_USER, _
'                       "Software\AAA-Registry Test\Products")
'
' Returns the value of TRUE or FALSE
' --------------------------------------------------------------
    
' --------------------------------------------------------------
' Define variables
' --------------------------------------------------------------
  Dim lngKeyHandle As Long
 
' --------------------------------------------------------------
' Initialize variables
' --------------------------------------------------------------
  lngKeyHandle = 0
  
' --------------------------------------------------------------
' Query the key path
' --------------------------------------------------------------
  m_lngRetVal = RegOpenKey(lngRootKey, strRegKeyPath, lngKeyHandle)
  
' --------------------------------------------------------------
' If no key handle was found then there is no key.  Leave here.
' --------------------------------------------------------------
  If lngKeyHandle = 0 Then
      regDoes_Key_Exist = False
  Else
      regDoes_Key_Exist = True
  End If
  
' --------------------------------------------------------------
' Always close the handle in the registry.  We do not want to
' corrupt these files.
' --------------------------------------------------------------
  m_lngRetVal = RegCloseKey(lngKeyHandle)
  
End Function

regQuery_A_Key

Public Function regQuery_A_Key(ByVal lngRootKey As Long, _
                               ByVal strRegKeyPath As String, _
                               ByVal strRegSubKey As String) As Variant
    
' --------------------------------------------------------------
' Written by Kenneth Ives                     kenaso@home.com
'
' Important:     If you treat all key data strings as being
'                case sensitive, you should never have a problem.
'                Always backup your registry files (System.dat
'                and User.dat) before performing any type of
'                modifications
'
' Description:   Function for querying a sub key value.
'
' Parameters:
'           lngRootKey - HKEY_CLASSES_ROOT, HKEY_CURRENT_USER,
'                  HKEY_lOCAL_MACHINE, HKEY_USERS, etc
'    strRegKeyPath - is name of the key path you wish to traverse.
'     strRegSubKey - is the name of the key which will be queryed.
'
' Syntax:
'    strKeyQuery = regQuery_A_Key(HKEY_CURRENT_USER, _
'                       "Software\AAA-Registry Test\Products", _
                        "StringTestData")
'
' Returns the key value of "StringTestData"
' --------------------------------------------------------------
    
' --------------------------------------------------------------
' Define variables
' --------------------------------------------------------------
  Dim intPosition As Integer
  Dim lngKeyHandle As Long
  Dim lngDataType As Long
  Dim lngBufferSize As Long
  Dim lngBuffer As Long
  Dim strBuffer As String
 
' --------------------------------------------------------------
' Initialize variables
' --------------------------------------------------------------
  lngKeyHandle = 0
  lngBufferSize = 0
  
' --------------------------------------------------------------
' Query the key path
' --------------------------------------------------------------
  m_lngRetVal = RegOpenKey(lngRootKey, strRegKeyPath, lngKeyHandle)
  
' --------------------------------------------------------------
' If no key handle was found then there is no key.  Leave here.
' --------------------------------------------------------------
  If lngKeyHandle = 0 Then
      regQuery_A_Key = ""
      m_lngRetVal = RegCloseKey(lngKeyHandle)   ' always close the handle
      Exit Function
  End If
  
' --------------------------------------------------------------
' Query the registry and determine the data type.
' --------------------------------------------------------------
  m_lngRetVal = RegQueryValueEx(lngKeyHandle, strRegSubKey, 0&, _
                         lngDataType, ByVal 0&, lngBufferSize)
  
' --------------------------------------------------------------
' If no key handle was found then there is no key.  Leave.
' --------------------------------------------------------------
  If lngKeyHandle = 0 Then
      regQuery_A_Key = ""
      m_lngRetVal = RegCloseKey(lngKeyHandle)   ' always close the handle
      Exit Function
  End If
  
' --------------------------------------------------------------
' Make the API call to query the registry based on the type
' of data.
' --------------------------------------------------------------
  Select Case lngDataType
         Case REG_SZ:       ' String data (most common)
              ' Preload the receiving buffer area
              strBuffer = Space(lngBufferSize)
      
              m_lngRetVal = RegQueryValueEx(lngKeyHandle, strRegSubKey, 0&, 0&, _
                                     ByVal strBuffer, lngBufferSize)
              
              ' If NOT a successful call then leave
              If m_lngRetVal <> ERROR_SUCCESS Then
                  regQuery_A_Key = ""
              Else
                  ' Strip out the string data
                  intPosition = InStr(1, strBuffer, Chr(0))  ' look for the first null char
                  If intPosition > 0 Then
                      ' if we found one, then save everything up to that point
                      regQuery_A_Key = Left(strBuffer, intPosition - 1)
                  Else
                      ' did not find one.  Save everything.
                      regQuery_A_Key = strBuffer
                  End If
              End If
              
         Case REG_DWORD:    ' Numeric data (Integer)
              m_lngRetVal = RegQueryValueEx(lngKeyHandle, strRegSubKey, 0&, lngDataType, _
                                     lngBuffer, 4&)  ' 4& = 4-byte word (long integer)
              
              ' If NOT a successful call then leave
              If m_lngRetVal <> ERROR_SUCCESS Then
                  regQuery_A_Key = ""
              Else
                  ' Save the captured data
                  regQuery_A_Key = lngBuffer
              End If
         
         Case Else:    ' unknown
              regQuery_A_Key = ""
  End Select
  
' --------------------------------------------------------------
' Always close the handle in the registry.  We do not want to
' corrupt these files.
' --------------------------------------------------------------
  m_lngRetVal = RegCloseKey(lngKeyHandle)
  
End Function

regDelete_A_Key

Public Function regDelete_A_Key(ByVal lngRootKey As Long, _
                                ByVal strRegKeyPath As String, _
                                ByVal strRegKeyName As String) As Boolean
    
' --------------------------------------------------------------
' Written by Kenneth Ives                     kenaso@home.com
'
' Important:     If you treat all key data strings as being
'                case sensitive, you should never have a problem.
'                Always backup your registry files (System.dat
'                and User.dat) before performing any type of
'                modifications
'
' Description:   Function for removing a complete key.
'
' Parameters:
'           lngRootKey - HKEY_CLASSES_ROOT, HKEY_CURRENT_USER,
'                        HKEY_lOCAL_MACHINE, HKEY_USERS, etc
'    strRegKeyPath - is name of the key path you wish to traverse.
'   strRegKeyValue - is the name of the key which will be removed.
'
' Returns a True or False on completion.
'
' Syntax:
'    regDelete_A_Key HKEY_CURRENT_USER, "Software", "AAA-Registry Test"
'
' Removes the key "AAA-Registry Test" and all of its sub keys.
' --------------------------------------------------------------
    
' --------------------------------------------------------------
' Define variables
' --------------------------------------------------------------
  Dim lngKeyHandle As Long
  
' --------------------------------------------------------------
' Preset to a failed delete
' --------------------------------------------------------------
  regDelete_A_Key = False
  
' --------------------------------------------------------------
' Make sure the key exist before trying to delete it
' --------------------------------------------------------------
  If regDoes_Key_Exist(lngRootKey, strRegKeyPath) Then
  
      ' Get the key handle
      m_lngRetVal = RegOpenKey(lngRootKey, strRegKeyPath, lngKeyHandle)
      
      ' Delete the key
      m_lngRetVal = RegDeleteKey(lngKeyHandle, strRegKeyName)
      
      ' If the value returned is equal zero then we have succeeded
      If m_lngRetVal = 0 Then regDelete_A_Key = True
      
      ' Always close the handle in the registry.  We do not want to
      ' corrupt the registry.
      m_lngRetVal = RegCloseKey(lngKeyHandle)
  End If
End Function

regDelete_Sub_Key

Public Function regDelete_Sub_Key(ByVal lngRootKey As Long, _
                                  ByVal strRegKeyPath As String, _
                                  ByVal strRegSubKey As String)
    
' --------------------------------------------------------------
' Written by Kenneth Ives                     kenaso@home.com
'
' Important:     If you treat all key data strings as being
'                case sensitive, you should never have a problem.
'                Always backup your registry files (System.dat
'                and User.dat) before performing any type of
'                modifications
'
' Description:   Function for removing a sub key.
'
' Parameters:
'           lngRootKey - HKEY_CLASSES_ROOT, HKEY_CURRENT_USER,
'                  HKEY_lOCAL_MACHINE, HKEY_USERS, etc
'    strRegKeyPath - is name of the key path you wish to traverse.
'     strRegSubKey - is the name of the key which will be removed.
'
' Syntax:
'    regDelete_Sub_Key HKEY_CURRENT_USER, _
                  "Software\AAA-Registry Test\Products", "StringTestData"
'
' Removes the sub key "StringTestData"
' --------------------------------------------------------------
    
' --------------------------------------------------------------
' Define variables
' --------------------------------------------------------------
  Dim lngKeyHandle As Long
  
' --------------------------------------------------------------
' Make sure the key exist before trying to delete it
' --------------------------------------------------------------
  If regDoes_Key_Exist(lngRootKey, strRegKeyPath) Then
  
      ' Get the key handle
      m_lngRetVal = RegOpenKey(lngRootKey, strRegKeyPath, lngKeyHandle)
      
      ' Delete the sub key.  If it does not exist, then ignore it.
      m_lngRetVal = RegDeleteValue(lngKeyHandle, strRegSubKey)
  
      ' Always close the handle in the registry.  We do not want to
      ' corrupt the registry.
      m_lngRetVal = RegCloseKey(lngKeyHandle)
  End If
  
End Function

... and a bunch of alternatives:

Programming Sockets

Add a Microsoft Winsock control 5.0. Lotta tips at WinsockVB.

Displaying the computer's hostname and IP address

where "winsock_server" is the name of the form:

winsock_server.Caption = Socket.LocalHostName + "/" + Socket.LocalIP

To launch a socket and listen to a port

where "Socket" is the name of a Winsock object:

Socket.LocalPort = 1007
'Socket.Protocol = sckTCPProtocol (default; use Socket.Protocol = sckUDPProtocol if you wish to use UDP)
Socket.Listen

To accept an incoming connection

Private Sub Socket_ConnectionRequest(ByVal requestID As Long)
    Socket.Accept requestID

To read incoming data

Private Sub Socket_DataArrival(ByVal bytesTotal As Long)
    Dim sTemp As String
    Socket.GetData sTemp

To send data

Private Sub Text1_KeyUp(KeyCode As Integer, Shift As Integer)
    Socket.SendData Chr$(KeyCode)

To close a socket

Socket.Close

To check that a socket is open

Open a DOS box, and run "netstat -an"

To send an email directly to a remote SMTP server

Here's code from Homestead:

Dim ConnectedState As Boolean
 
Private Sub cmdSend_Click()
    Dim lbSendWorked As Boolean
    
    On Error Resume Next
    Socket.Close
    Socket.Connect txtHost, txtPort
            
    Do While ConnectedState = False
        DoEvents
    Loop
                
    lbSendWorked = SendMail(txtTo, txtFrom, txtSubject, txtBody)
    
    Socket.Close
End Sub
 
Private Sub Socket_Connect()
    ConnectedState = True
End Sub
 
Function SendMail(psTo As String, psFrom As String, psSubject As String, _
                     psBody As String) As Boolean
    Dim lsMessage As String
    Dim lsSep As String
        
    lsMessage = "MAIL FROM: <" & psFrom & ">" & vbCrLf _
        & "RCPT TO: <" & psTo & ">" & vbCrLf _
        & "DATA" & vbCrLf _
        & "DATE: " & Format$(Now, "dd mmm yy ttttt") & vbCrLf _
        & "FROM: " & psFrom & vbCrLf _
        & "TO: " & psTo & vbCrLf _
        & "SUBJECT: " & psSubject & vbCrLf & vbCrLf _
        & psBody & vbCrLf & "." & vbCrLf
               
    Socket.SendData (lsMessage)
End Function

Client-server communication in UDP

Here's the server part:

Private Sub Form_Load()
    ServerSock.Protocol = sckUDPProtocol
    ServerSock.LocalPort = 5555
    ServerSock.Bind
End Sub
 
Private Sub ServerSock_DataArrival(ByVal bytesTotal As Long)
    Dim strDataIn As String
    ServerSock.GetData strDataIn
    Label1.Caption = strDataIn
End Sub

Here's the client part:

Private Sub Command1_Click()
    'Required to avoid error 40020: "Invalid operation at current state"
    If ClientSock.State <> sckClosed Then
        ClientSock.Close
    End If
    
    ClientSock.Protocol = sckUDPProtocol
    ClientSock.RemotePort = 5555
    ClientSock.RemoteHost = "localhost"
    ClientSock.SendData Time$
    
    'DoEvents
End Sub

Using Winsock control through code

If multiple forms need to use an MS Winsock control, it's better to move the whole code into modules, and just call a single routine from the forms. For this to work, you must add a Module and a Class Module: The Class Module will contain the actual Winsock code (inherited from the MS Winsock control), while the Module will create the class object dynamically, and sit between the forms and the Class Module:

  1. Make sure no Winsock control is available in the Toolbar
  2. Through Project > References, add "Microsoft Winsock Control"
  3. Add this code in Class Module (SocketClass.cls):

    Public WithEvents Socket As MSWinsockLib.Winsock

    Private Sub Class_Initialize()
        'If you get "Invalid use of New keyword", close project,
        'delete MSWINSCK.OCA, reload project, ignore error, re-add MSWINSOCK.OCX
        Set Socket = New MSWinsockLib.Winsock
    End Sub

    Public Sub GetStuff()
        MsgBox "here"
    End Sub

    Private Sub Class_Terminate()
      Set Socket = Nothing
    End Sub
     
  4. Add this code in a Module:

    Public Sub CallMe()
        Dim Test As SocketClass

        Set Test = New SocketClass
        Test.GetStuff
        Test = Nothing

    End Sub
     
  5. Add this code in a Form:

    Private Sub Command1_Click()
        CallMe
    End Sub 

To read

Using the WIN32 API

Use the APILoad applet to browse through the Win32 API and copy/paste their definition in Visual Basic. The APILoad applet is located in Drive:\Program Files\DevStudio\VB\Winapi\ (just load the win32api.txt file). You should also order Dan Appleman's "Visual Basic Programmer's Guide to the Win32 API".

Note that there are two kinds of DLL's: Those built for VB applications (ActiveX DLL) which can be added to a project through Project | Components, and those built for C applications which require a Declare statement to tell VB how to handle the parameters required by a function/sub, if any.

Adding a delay

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 
Call Sleep(5000) ' for a delay of 5 seconds.

Adding a splash screen

A ready-made form is available to add a splash screen to your application : Project | Add Form... | Splash Screen. Customize the different labels (lblCompany, imgLogo, etc.), make this form the startup form in your project, add a Timer to this form so it's displayed for a few seconds, and add the following code

Private Sub Form_Load()
    lblVersion.Caption = "Version " & App.Major & "." & App.Minor & "." & App.Revision
    lblProductName.Caption = App.Title
    lblCopyright.Caption = " 2002 Acme Inc."
    lblCompany.Caption = "Acme Inc."
    lblWarning.Caption = "All fights defered"
    lblLicenseTo.Caption = "Licensed to Widget Ltd."
End Sub
 
Private Sub Timer1_Timer()
    Load form0
    Unload Me
End Sub

Displaying version infos

If you enable versioning in the VB project (Project | Properties | Build), here's how to display the version number that is embeded in the EXE:

MsgBox "Version " + Trim(Str$(App.Major)) & "." & Trim(Str$(App.Minor)) & "." & Trim(Str$(App.Revision)), vbInformation

Reading properties from a file

Private Sub Form_DblClick()
 
    Dim BufferLen As Long, Buffer() As Byte, Pointer As Long, PointerLen As Long
    Dim VInfo As VS_FIXEDFILEINFO
    
    BufferLen = GetFileVersionInfoSize("c:\abc5\pya.exe", 0&)
 
    'Some files have little version infos
    If BufferLen > 1 Then
        ReDim Buffer(BufferLen)
        GetFileVersionInfo "c:\abc5\pya.exe", 0&, BufferLen, Buffer(0)
        VerQueryValue Buffer(0), "\", Pointer, BufferLen
        MoveMemory VInfo, Pointer, Len(VInfo)
    End If
 
    Debug.Print "Infos versions de c:\abc5\pya.exe"
    Debug.Print "Numro version : " & Format$(VInfo.dwFileVersionMSh) & "." & _
        Format$(VInfo.dwFileVersionMSl) & "." & _
        Format$(VInfo.dwFileVersionLSh) & "." & _
        Format$(VInfo.dwProductVersionLSl)
End Sub 

Displaying the Windows version

To check which version of Windows and whether any service pack is installed, you need to call a Win32 API:

Copy the following in a module

Public Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
 
Public Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128 '  Maintenance string for PSS usage
End Type ' dwPlatforID Constants
 
Public Const VER_PLATFORM_WIN32s = 0
Public Const VER_PLATFORM_WIN32_WINDOWS = 1
Public Const VER_PLATFORM_WIN32_NT = 2

Copy this in a form (eg. "About" menu):

    Dim tOSVer As OSVERSIONINFO
    Dim sVersion As String
    
    tOSVer.dwOSVersionInfoSize = Len(tOSVer)
    GetVersionEx tOSVer
    
    With tOSVer
      Select Case .dwPlatformId
         Case VER_PLATFORM_WIN32_NT
            If .dwMajorVersion >= 5 Then
               sVersion = "Windows 2000 "
            Else
               sVersion = "Windows NT "
            End If
         Case Else
            If .dwMajorVersion >= 5 Then
               sVersion = "Windows ME "
            ElseIf .dwMajorVersion = 4 And .dwMinorVersion > 0 Then
               sVersion = "Windows 98 "
            Else
               sVersion = "Windows 95 "
            End If
         End Select
         
         ' Get OS version
        sVersion = sVersion & .dwMajorVersion & "." & .dwMinorVersion & "." & .dwBuildNumber & " "
         ' Check for service pack
        sVersion = sVersion & Left(.szCSDVersion, InStr(1, .szCSDVersion, Chr$(0)))
    End With

Getting the local computer's name

Copy this in a module:

Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
 
Public Const MAX_COMPUTERNAME_LENGTH = 31
 
Public Function ComputerNameIs() As String 'User Defined Function
    Dim lngLength As Long
    Dim lngResult As Long
    Dim strNameBuffer As String
    
    'Maximum Computer Name + Terminating Null Char
    lngLength = MAX_COMPUTERNAME_LENGTH + 1
 
    'Create Buffer
    strNameBuffer = String(lngLength, "X")
    
    'Get the computer Name
    lngResult = GetComputerName(strNameBuffer, lngLength)
    If lngResult <> 0 Then
        ComputerNameIs = Mid(strNameBuffer, 1, lngLength)
    Else
        ComputerNameIs = " "
    End If
End Function

... and call this routine:

MsgBox ComputerNameIs

Working with RAS/DUN

Here are some samples on how to check for remote access connections, and launching one of them:

Start an internet connection

Public Sub Connect(strConnectName As String, blnPressConnect As Boolean)
    Shell "rundll32.exe rnaui.dll,RnaDial " & strConnectName, 0
    If (blnPressConnect = True) Then
        DoEvents
        SendKeys "{ENTER}"
    End If
End Sub
 
Private Sub cmdConnect_Click()
    Connect "Freeserve", True
End Sub 

Check internet connection state

There is plenty of code around to show you how to detect connections to the internet when using Dial Up Networking. But how about internet connections over a LAN? This code solves your problems.
 
Add this code to a module :
 
Option Explicit
Public Declare Function InternetGetConnectedState _
    Lib "wininet.dll" (ByRef lpSFlags As Long, _
    ByVal dwReserved As Long) As Long
Public Const INTERNET_CONNECTION_LAN As Long = &H2
Public Const INTERNET_CONNECTION_MODEM As Long = &H1
 
Public Function Online() As Boolean
    'If you are online it will return True, otherwise False
    Online = InternetGetConnectedState(0& ,0&)
End Function
 
Public Function ViaLAN() As Boolean Dim SFlags As Long
    'return the flags associated with the connection
    Call InternetGetConnectedState(SFlags, 0&) 'True if the Sflags has a LAN connection
    ViaLAN = SFlags And INTERNET_CONNECTION_LAN
End Function
 
Public Function ViaModem() As Boolean
    Dim SFlags As Long
    'return the flags associated with the connection
    Call InternetGetConnectedState(SFlags, 0&) 'True if the Sflags has a modem connection
    ViaModem = SFlags And INTERNET_CONNECTION_MODEM
End Function
 
Add this code to a form with one command button and three text boxes. It will return "True" for which ever one you are connected to.
 
Option Explicit Private Sub Command1_Click()
    Text1 = ViaLAN()
    Text2 = ViaModem()
    Text3 = Online()
End Sub

Extendend Connection Infos

'Module
Public Declare Function InternetGetConnectedStateEx Lib "wininet.dll" Alias "InternetGetConnectedStateExA" _
   (ByRef lpdwFlags As Long, _
   ByVal lpszConnectionName As String, _
   ByVal dwNameLen As Long, _
   ByVal dwReserved As Long _
   ) As Long
 
Public Enum EIGCInternetConnectionState
   INTERNET_CONNECTION_MODEM = &H1&
   INTERNET_CONNECTION_LAN = &H2&
   INTERNET_CONNECTION_PROXY = &H4&
   INTERNET_RAS_INSTALLED = &H10&
   INTERNET_CONNECTION_OFFLINE = &H20&
   INTERNET_CONNECTION_CONFIGURED = &H40&
End Enum
 
Public Property Get InternetConnected( _
     Optional ByRef eConnectionInfo As EIGCInternetConnectionState, _
     Optional ByRef sConnectionName As String _
   ) As Boolean
    
    Dim dwFlags As Long
    Dim sNameBuf As String
    Dim lR As Long
    Dim iPos As Long
    
    sNameBuf = String$(513, 0)
    
    lR = InternetGetConnectedStateEx(dwFlags, sNameBuf, 512, 0&)
    eConnectionInfo = dwFlags
    iPos = InStr(sNameBuf, vbNullChar)
    If iPos > 0 Then
        sConnectionName = Left$(sNameBuf, iPos - 1)
    ElseIf Not sNameBuf = String$(513, 0) Then
        sConnectionName = sNameBuf
    End If
    InternetConnected = (lR = 1)
End Property
 
'Form
Private Sub Command1_Click()
    Dim eR As EIGCInternetConnectionState
    Dim sMsg As String
    Dim sName As String
    Dim bConnected As Boolean    ' Determine whether we have a connection:
   
    bConnected = InternetConnected(eR, sName)    ' The connection state info parameter provides details
    'MsgBox bConnected, , "Connected?"
    
    ' about how we connect:
    If (eR And INTERNET_CONNECTION_MODEM) = INTERNET_CONNECTION_MODEM Then
      sMsg = sMsg & "Connection uses a modem." & vbCrLf
    End If
    If (eR And INTERNET_CONNECTION_LAN) = INTERNET_CONNECTION_LAN Then
      sMsg = sMsg & "Connection uses LAN." & vbCrLf
    End If
    If (eR And INTERNET_CONNECTION_PROXY) = INTERNET_CONNECTION_PROXY Then
      sMsg = sMsg & "Connection is via Proxy." & vbCrLf
    End If
    If (eR And INTERNET_CONNECTION_OFFLINE) = INTERNET_CONNECTION_OFFLINE Then
      sMsg = sMsg & "Connection is Off-line." & vbCrLf
    End If
    If (eR And INTERNET_CONNECTION_CONFIGURED) = INTERNET_CONNECTION_CONFIGURED Then
      sMsg = sMsg & "Connection is Configured." & vbCrLf
    Else
      sMsg = sMsg & "Connection is Not Configured." & vbCrLf
    End If
    If (eR And INTERNET_RAS_INSTALLED) = INTERNET_RAS_INSTALLED Then
      sMsg = sMsg & "System has RAS installed." & vbCrLf
    End If
    
    ' Display the connection name and info:
    If bConnected Then
      Text1.Text = "Connected: " & sName & vbCrLf & vbCrLf & sMsg
    Else
      Text1.Text = "Not Connected: " & sName & vbCrLf & vbCrLf & sMsg
    End If
End Sub

Sockets

http://www.sockets.com/

http://www.vbip.com/

You could run "ipconfig /ALL &gt; ipdata.txt" and then parse the ipdata.txt file for the DNS servers. Kinda cheesy but it should work.

http://www.vbip.com/wininet/index.asp

http://msdn.microsoft.com/workshop/networking/wininet/overview/overview.asp

Connecting to the remote host

Creating and closing a socket

Microsoft Winsock Resources

Establishing connection to ISP (Internet Service Provider) (For IE 3/4)

WebChecker Sample Application

Playing with files

Checking if a directory exists on a shared drive

If Dir("\\srv\myshare\mydir", vbDirectory) <> vbNullString Then
    MsgBox "\MYDIR exists"
End If

Updating a file from a web server using WININET.DLL

Note: You must kill() a file instead of expecting WININET.DLL to replace it with the version that you download from the Net, as VB will silently replace the bytes in the local file with whatever comes down its way, ie. the size of the original, local file will not change after the update.

Make sure you use InternetOpen("My Browser", INTERNET_OPEN_TYPE_DIRECT...) instead of InternetOpen("My Browser", INTERNET_OPEN_TYPE_PRECONFIG ...), as the latter fetches stuff from the cache, and it seems like W2K with no SP is buggy in that area.

Read a text file

This works for a small file:

Dim iFile as Integer
Dim sItem as String
 
iFile = FreeFile
Open "myfile.txt" For Input As #iFile
Do While Not EOF(iFile)
    Line Input #iFile, sItem
Loop
 
Close #iFile

This is the way to go if you have to read a bigger file:

Dim iFile as Integer
Dim sItem as String
 
iFile = FreeFile
Open "myfile.txt" For Binary As #iFile
sItem = Space$(LOF(iFile))
Get #iFile, , sItem
Close #iFile

Write a text file

Dim iFile as Integer
iFile = FreeFile
Open "myfile.txt" For Output As #iFile
Print #iFile, "some text"
Close #iFile

Note:

Checking if a file exists

Note: Dir() seems to only work with visible files, ie. it'll fail for hidden files even if the file does exist. This code came from here:

Private Function FileExistsWithFileLen(ByVal filename As String)  as Boolean
    Dim length As Long
 
    On Error GoTo FileDoesntExist
    length = FileLen(filename)
    FileExistsWithFileLen = True
    Exit Function
    
FileDoesntExist:
    FileExistsWithFileLen = False
End Function

Zipping and unzipping files

While several commercial solutions exist (such as Bigspeed or DinaZip), the only free solution for libraries seems to be

Yet other alternatives are to shell to an EXE that can be driven from the command line, eg. bz2 format. More infos on compression tools here.

More articles:

Extracting the version number

Note: Not all binary files have a version number.

Declarations

Private Declare Function GetFileVersionInfoSize Lib "version.dll" Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, lpdwHandle As Long) As Long
Private Declare Function GetFileVersionInfo Lib "version.dll" Alias "GetFileVersionInfoA" (ByVal lptstrFilename As String, ByVal dwHandle As Long, ByVal dwLen As Long, lpData As Any) As Long
Private Declare Function VerQueryValue Lib "version.dll" Alias "VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As String, lplpBuffer As Long, puLen As Long) As Long
Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, ByVal Source As Long, ByVal length As Long)

Function

Public Function FileVersion(sFichier As String)
    Dim BufferLen As Long, buffer() As Byte, Pointer As Long, PointerLen As Long
    Dim VInfo As VS_FIXEDFILEINFO
    Dim sVersion As String
    
    BufferLen = GetFileVersionInfoSize(sFichier, 0&)
    'Certains fichiers n'ont pas d'infos tendues
    If BufferLen > 1 Then
        ReDim buffer(BufferLen)
        GetFileVersionInfo sFichier, 0&, BufferLen, buffer(0)
        VerQueryValue buffer(0), "\", Pointer, BufferLen
        MoveMemory VInfo, Pointer, Len(VInfo)
    End If
    sVersion = Format$(VInfo.dwFileVersionMSh) & "." & _
        Format$(VInfo.dwFileVersionMSl) & "." & _
        Format$(VInfo.dwFileVersionLSh) & "." & _
        Format$(VInfo.dwProductVersionLSl)
    FileVersion = sVersion
End Function

Extracting the filename from a path

VB6 offers support for regular expressions and other niceties like split(), but VB5 doesn't. So...

Public Function ExtractFileName(PathName As String) As String
    Dim X As Integer
    For X = Len(PathName) To 1 Step -1
        If Mid$(PathName, X, 1) = "/" Then Exit For
    Next
    ExtractFileName = Right$(PathName, Len(PathName) - X)
End Function

Drawing stuff

Displaying a progress bar without using COMCTL32.OCX

(Simplified sample written by Brad Martinez). Here's how to call the API's to display a progress bar with the smooth look. First, put this in a module:

Type tagINITCOMMONCONTROLSEX
    dwSize As Long
    dwICC As Long
End Type
 
Type PPBRANGE
   iLow As Integer
   iHigh As Integer
End Type
 
Public Const ICC_LISTVIEW_CLASSES = &H1    ' // listview, header
Public Const ICC_TREEVIEW_CLASSES = &H2  ' // treeview, tooltips
Public Const ICC_BAR_CLASSES = &H4            ' // toolbar, statusbar, trackbar, tooltips
Public Const ICC_TAB_CLASSES = &H8             ' // tab, tooltips
Public Const ICC_UPDOWN_CLASS = &H10       ' // updown
Public Const ICC_PROGRESS_CLASS = &H20   ' // progress
Public Const ICC_HOTKEY_CLASS = &H40         ' // hotkey
Public Const ICC_ANIMATE_CLASS = &H80        ' // animate
Public Const ICC_WIN95_CLASSES = &HFF        ' loads everything above
Public Const ICC_DATE_CLASSES = &H100        ' // month picker, date picker, time picker, updown
Public Const ICC_USEREX_CLASSES = &H200   ' // comboex
Public Const ICC_COOL_CLASSES = &H400       ' // rebar (coolbar) control
 
Public Const PROGRESS_CLASS = "msctls_progress32"
 
Public Const PBS_SMOOTH = &H1    ' IE3 and later
Public Const PBS_VERTICAL = &H4   ' IE3 and later
Public Const WS_VISIBLE = &H10000000
Public Const WS_CHILD = &H40000000
 
Public Const WM_USER = &H400
Public Const PBM_SETRANGE = (WM_USER + 1)
Public Const PBM_SETPOS = (WM_USER + 2)
Public Const PBM_DELTAPOS = (WM_USER + 3)
Public Const PBM_SETSTEP = (WM_USER + 4)
Public Const PBM_STEPIT = (WM_USER + 5)
Public Const PBM_SETRANGE32 = (WM_USER + 6)
Public Const PBM_GETRANGE = (WM_USER + 7)
Public Const PBM_GETPOS = (WM_USER + 8)
 
Declare Sub InitCommonControls Lib "comctl32.dll" ()
Declare Function InitCommonControlsEx Lib "comctl32.dll" (lpInitCtrls As tagINITCOMMONCONTROLSEX) As Boolean
 
Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" _
                          (ByVal dwExStyle As Long, ByVal lpClassName As String, _
                           ByVal lpWindowName As String, ByVal dwStyle As Long, _
                           ByVal x As Long, ByVal y As Long, _
                           ByVal nWidth As Long, ByVal nHeight As Long, _
                           ByVal hWndParent As Long, ByVal hMenu As Long, _
                           ByVal hInstance As Long, lpParam As Any) As Long
 
Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
 
Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
                          (ByVal hwnd As Long, ByVal wMsg As Long, _
                          wParam As Any, lParam As Any) As Long
 
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
                            (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
                              (ByVal hwnd As Long, ByVal nIndex As Long, _
                              ByVal dwNewLong As Long) As Long
 
Public Const GWL_STYLE = (-16)
Public Const ES_NUMBER = &H2000
 
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 
Declare Function IsWindow Lib "user32" (ByVal hwnd As Long) As Long
 
Declare Function MoveWindow Lib "user32" _
                              (ByVal hwnd As Long, _
                              ByVal x As Long, ByVal y As Long, _
                              ByVal nWidth As Long, ByVal nHeight As Long, _
                              ByVal bRepaint As Long) As Long
 
Public Function IsNewComctl32() As Boolean
    Dim icc As tagINITCOMMONCONTROLSEX
 
    On Error GoTo OldVersion
 
    icc.dwSize = Len(icc)
    icc.dwICC = ICC_PROGRESS_CLASS
    IsNewComctl32 = InitCommonControlsEx(icc)
    Exit Function
 
OldVersion:
    InitCommonControls
End Function

Next, copy this in a form:

Dim m_hProgBar As Long   ' hWnd
 
Private Sub Form_DblClick()
    Dim bIsIE3 As Boolean
    Dim dwItins As Long
    Dim dwIncrement As Long
    Dim dwIdx As Long
    Dim vDummy As Variant
    
    m_hProgBar = CreateWindowEx(0, PROGRESS_CLASS, vbNullString, _
       WS_CHILD Or WS_VISIBLE Or _
       PBS_SMOOTH, _
       0, 0, 200, 15, _
       hwnd, 0, _
       App.hInstance, ByVal 0)
    
    If m_hProgBar = 0 Then MsgBox "Uh oh...": Exit Sub
    
    Call IsNewComctl32
 
    dwItins = 1000
    dwIncrement = dwItins * 0.1
    'Max range in high-word, hence the &H10000
    SendMessage m_hProgBar, PBM_SETRANGE, 0, ByVal (dwItins * &H10000)
    SendMessage m_hProgBar, PBM_SETSTEP, ByVal dwIncrement, 0
 
    'Use Step for smoother increase
    For dwIdx = 1 To dwItins Step dwIncrement
        SendMessage m_hProgBar, PBM_STEPIT, 0, 0
        DoEvents
        Call Sleep(dwIncrement)
    Next
 
    If IsWindow(m_hProgBar) Then DestroyWindow m_hProgBar
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
    Set Form1 = Nothing
    End
End Sub

Here's another way to play with a progress bar:

Private Sub Form_Load()
    Call IsNewComctl32
    
    m_hProgBar = CreateWindowEx(0, PROGRESS_CLASS, vbNullString, _
       WS_CHILD Or WS_VISIBLE Or _
       PBS_SMOOTH, _
       10, 25, 150, 15, _
       hwnd, 0, _
       App.hInstance, ByVal 0)
    
    If m_hProgBar = 0 Then MsgBox "Uh oh...": Exit Sub
 
    'No need, as 100 is the default range, and 1 the default increment
    'SendMessage m_hProgBar, PBM_SETRANGE, 0, ByVal (100 * &H10000)
    'SendMessage m_hProgBar, PBM_SETSTEP, ByVal 1, 0
    Timer1.Interval = 100 'Called every .1s
    Timer1.Enabled = True
End Sub
 
Private Sub Timer1_Timer()
    Static iCounter As Integer
    
    SendMessage m_hProgBar, PBM_SETPOS, ByVal iCounter, 0
    iCounter = iCounter + 1
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
    If IsWindow(m_hProgBar) Then DestroyWindow m_hProgBar
End Sub

More info here.

Printing a grid on top of a WMF file

Note: Order is important! You should use PaintPicture before printing a grid.

Dim iCounter As Integer, iVar As Integer
 
'Load file and link to Picture object
Picture1.Picture = LoadPicture("C:\myfile.wmf")
Printer.PaintPicture Picture1.Picture, 0, 0
        
'Add string on top of picture
Printer.CurrentX = 271
Printer.CurrentY = 79
Printer.Print "123 Sunset Blvd."
       
'Print grid to ease location of strings
'Vertical
For iCounter = 1 To 23
    iVar = (iCounter - 1) * 500
    Printer.CurrentX = iVar
    Printer.CurrentY = 0
    Printer.Print Str$(iVar)
    Printer.Line (iVar, 0)-(iVar, 16000)
Next iCounter
'Horizontal
For iCounter = 1 To 34
    iVar = (iCounter - 1) * 500
    Printer.CurrentX = iVar
    Printer.CurrentY = 0
    Printer.Print Str$(iVar)
    Printer.Line (0, iVar)-(11000, iVar)
Next iCounter

Coordinates

VB gives coordinates in twips, while most methods expect pixels. Here's how to obtain screen width and height in pixels:

MsgBox "Width in pixels = " + Str$(Screen.Width / Screen.TwipsPerPixelX) + "Height in pixels = " + Str$(Screen.Height / Screen.TwipsPerPixelY)  

Getting coordinates of the client area

In an MDI window, .Height and .Width include the area used by the title bar and the and scroll bars (if any). To get the coordinates of the client area itself, use the .ScaleHeight, and .ScaleWidth, respectively:

Form2.Width = MDIForm1.ScaleWidth - Form1.Width

Checking if a printer is installed

... and displaying the Add Printer dialog:

Dim bPrinterInstalled As Boolean
bPrinterInstalled = (Printers.Count > 0) 'True if count > 0
If Not bPrinterInstalled Then
    Shell ("rundll32.exe shell32.dll,SHHelpShortcuts_RunDLL AddPrinter")
End If
End

More infos here

InstallPrinter - Install a new printer on the system

Display the Add Printer Dialog

Enumerating Local and Network Printers

Managing Data

Numerous solutions exist to access data, through either database objects (Data Bound Grid and Data Bound List) or grid objects (Grid (older VB), MSFlexGrid (newer VB), VSFlexGrid, etc.). More information is available here. More information in this document. Remember that in grid objects (at least VSFlexGrid, coordinates are x,y, ie. myarray(column, row).

The older Control Data object cannot use ODBC; In this case, use the ActiveX component MS Remote Data Control (RDC) instead. The data access model used by the Data1 object was DAO (to access Access and ODBCDirect databases), while the model used by the MS RDC object is RDO (Remote Data Object; Runs on top of ODBC; To access Oracle and Sql Server databases; Recommended for heavy use due to capability to run requests on server and run stocked procedures.) Since programming with RDO is a pain in the rear-end, MS merged DAO and RDO and came up with ADO (ActiveX Data Object; Only 4 objects; Component is ADODC; Based on OLEDB).

Sharing data between forms

Here are the different ways to let two forms communicate:

Property()

Add variables (they are private by default) to a form, and create Let/Get/Set procedures so as to give indirect access to those private variables to other forms:

Put this code in Form1, the form whose data you want to access from Form2:

'Dim = Private, ie. not readable directly from Form2
Dim sMyVar As String
 
Public Property Get Dummy() As Variant
    Dummy = sMyVar
End Property
 
Public Property Let Dummy(ByVal vNewValue As Variant)
    sMyVar = vNewValue
End Property
 
Private Sub Form_DblClick()
    sMyVar = "Original data"
    Form2.Show
End Sub

... and in Form2:

Private Sub Form_Load()
    MsgBox Form1.Dummy
    Form1.Dummy = "My data"
    MsgBox Form1.Dummy
End Sub

What's the difference between Let and Set?

Event and RaiseEvent

Similar to writing Property() routines, you can add a custom public Event to a form, and call it from another form with parameters:

In Form1, the form whose data you wish to access from Form2, add the following code:

Public Event MyFunc(ByVal dummy As String)
 
Private Sub Form_DblClick()
    Form2.Show
End Sub
 
Public Sub MyFunc(ByVal dummy As String)
    MsgBox "Dummy = " & dummy
End Sub

And in Form2, ie. the caller form, add this:

Private Sub Form_Load()
    RaiseEvent Form1.MyFunc("Some dummy call")
End Sub

Encapsuling data in a class

Similar to using a module, except data are cleanly kept in a class as properties. "I prefer to use a class that has static variables.  That way you can type (G = class name) G. and then see a list of all global variables. Use "FormVariable = clsFee.Fee1" instead of "Dim c as new clsFee: FormVariable = c.Fee1" as there is no need to create an instance of a class that just has static variables."

However, if you need constants, use a module instead of a class since VB6 doesn't allow public constants in a class. You CAN have public enums, but all enums are internally of type Long.

Variables in modules

Define variables as public in a module:

Public sMySharedData As String

Public variable in a form

Stick this in Form1:

Public sMyVar As String
 
Private Sub Form_DblClick()
    sMyVar = "Form1"
    Form2.Show
End Sub

... and this in Form2:

Private Sub Form_Load()
    MsgBox Form1.sMyVar
    Form1.sMyVar = "Form2"
    MsgBox Form1.sMyVar
End Sub

Tag form property

Use the Tag form property:

Form1.Tag = "Some data"

... and in Form2:

MsgBox Form1.Tag

Sharing data via a file or database

Poor man's persistent engine :-)

Copying a file from a remote host

Note that you can't simply use "C:\" as destination.

FileCopy "\\server\files\*.*","c:\MyFiles"

Playing with files

Here's how to create a file for write access:

    Dim iFileNumber As Integer
    iFileNumber = FreeFile
    
    Open "TEST.TXT" For Output As #iFileNumber
    Write #iFileNumber, "This is an example"
    Close #iFileNumber

Here's how to create a log file to append messages:

Public Sub Log(sItem)
    Dim iFileNumber As Integer
    iFileNumber = FreeFile
     
    Open "LOG.TXT" For Append As #iFileNumber
    Print #iFileNumber, Time$ & " - " & sItem
    Close #iFileNumber
End Sub

Connecting to SQLite

Moved here

Connecting to MySQL directly

... through its libmysql.dll interface (Note: This DLL is a regular C DLL, not a COM DLL, hence no need to register it into Windows using REGSVR32.EXE, which will fail anyway.) The API can be found here. Access from an Excel sheet and VBA is here.

Checking the client version

Public Declare Function mysql_get_client_info Lib "libmySQL" () As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDestination As Any, lpSource As Any, ByVal lLength As Long)
Public Const BYTE_SIZE = 1&
 
Dim pClientVer As Long
Dim bbb    As Byte
Dim buffer As String
 
pClientVer = mysql_get_client_info()
 
bbb = vbNull
buffer = ""
 
Do Until bbb = 0
    CopyMemory bbb, ByVal pClientVer, BYTE_SIZE
    buffer = buffer & Chr(bbb)
    pClientVer = pClientVer + BYTE_SIZE
Loop 'Do Until bbb = 0
 
MsgBox buffer

Initializing a MySQL structure

Public Declare Function mysql_init Lib "libmySQL.dll" (ByVal lMYSQL As Long) As Long
Global db_ID As Long
 
db_ID = 0&
db_ID = mysql_init(db_ID)
If db_ID = 0 Then
    Debug.Print "error mysql_init"; Hex(db_ID)
    End
End if

Connecting to the server

Public Declare Function mysql_real_connect Lib "libmySQL" _
        (ByVal lMYSQL As Long, _
         ByVal sHostName As String, _
         ByVal sUserName As String, _
         ByVal sPassword As String, _
         ByVal sDbName As String, _
         ByVal lPortNum As Long, _
         ByVal sSocketName As String, _
         ByVal lFlags As Long) As Long
Global HostNam  As String
Global UserNam  As String
Global PassWrd  As String
Global DB_Name  As String
Global PortNum  As Long
 
HostNam = "127.0.0.1"
UserNam = "root"
PassWrd = "test"
PortNum = 3306
DB_Name = "mysql"
If mysql_real_connect(db_ID, HostNam, UserNam, PassWrd, DB_Name, PortNum, "", 0&) = 0 Then
    Debug.Print "error mysql_real_connect"
End If

Checking connection to a MySQL server

Public Declare Function mysql_ping Lib "libmySQL" (ByVal lMYSQL As Long) As Long
 
lResult = mysql_ping(db_ID)

Creating a database

Public Declare FunctioPublic Declare Function mysql_real_query Lib "libmySQL" (ByVal lMYSQL As Long, ByVal strQuery As String, ByVal lLength As Long) As Long
 
Dim sQuery as String
sQuery = "create database mydb"
Call mysql_real_query(db_ID, sQuery, Len(sQuery))

Creating a table

sQuery = "create table mytable (id INT NOT NULL AUTO_INCREMENT PRIMARY KEY, name VARCHAR(20))"
Call mysql_real_query(db_ID, sQuery, Len(sQuery))

Adding records in a table

sQuery = "insert into mytab values (NULL,'john doe')"
For iCounter = 1 To 10000
    If mysql_real_query(db_ID, sQuery, Len(sQuery)) Then
        MsgBox "Error Query"
        Exit Sub
    End If
    DoEvents
Next iCounter

Dropping a database

Note: This function is deprecated.  It is preferable to use mysql_query() to issue a SQL DROP DATABASE statement instead.
 
Public Declare Fnction mysql_drop_db Lib "libmySQL" (ByVal lMYSQL As Long, ByVal sDataBaseName As String) As Long
lResult = mysql_drop_db (db_ID, "mydb")

Closing a connection

Public Declare Sub mysql_close Lib "libmySQL" (ByVal lMYSQL As Long)
 
Call mysql_close(db_ID)

Connection through VBMySQLDirect

Connecting to MySQL through the MyVbQl wrapper

(RIP) Icarz, Inc's MyVbQL.dll is just a wrapper to MySQL's libmysql DLL, and provides four objects: MYSQL_CONNECTION, MYSQL_RS, MYSQL_FIELD, and MYSQL_ERR. The documentation is here.

MYSQL_CONNECTION

Methods

Properties

Enums

MYSQL_RS

Methods

Properties

Enums

MYSQL_FIELD (not creatable)

Properties

Enums

MYSQL_ERR (not creatable)

Methods

Properties

Connecting to MySQL through VbMySQL

Available here. As of Oct 2002, documentation is only available in French. Based on two DLL's, one object, and requires VB6SP3 (May 2004 : empty?)

To-do

Either install MDAC + MyODBC + ADO/OLEDB provider, ("MyVbQL is a Visual Basic API for accessing MySQL databases. This API was developed by icarz, Inc. as an alternative to the MS ADO - MyODBC interface that VB developers must use for MySQL database connectivity. Since we have a very large code base using ADO, MyVbQL was designed to replace ADO with minimal code changes. " Note that myvbql.dll really is a wrapper around the standard libmysql.dll created by the MySQL team), or the VBMySQL OCX.

  1. Install the MyODBC or MySQL OLEDB Provider driver on the client
  2. Connection sample:

    With gADO_OSCConn
      .ConnectionString = "DRIVER={MySQL ODBC 3.51 Driver};" & _
                          "SERVER=<IP Address>;" & _
                          "DATABASE=<DatabaseName>;" & _
                          "UID=<UserName>;" & _
                          "PWD=<Password>;" & _
                          "OPTION=" & Trim(<MySQL Option>)
      .Open
    End With

Other sample:

Imports System.Data.OleDb
Dim conString As New String("Provider=MySQLProv;" & _
"Data Source=test;" & _
"User Id=myusername;" & _
"Password=mypassword")
Dim con As New OleDbConnection(conString)
con.Open()
con.Close()

Connecting to a DBMS through ODBC

Connection

Global ghEnv As Long
Global ghDbc As Long                'Only one connection per app
Global gDSN As String               'Active DSN name
Global Const gAppName = "ODBC Test" 'Dialog box titles
Global rc As Long                   'ODBC api rc
 
rc = SQLAllocEnv(ghEnv)
If (rc <> SQL_SUCCESS) Then
    MsgBox "Unable to allocate hdbc", , gAppName
End If
 
' Allocate a connection handle
rc = SQLAllocConnect(ghEnv, ghDbc)
If (rc <> SQL_SUCCESS) Then
    MsgBox "Unable to allocate hdbc", , gAppName
    GoTo errmnuConnect
End If
      
' Make the connection
ConnStrIn = "DSN="
ConnStrOut = Space(300)
rc = SQLDriverConnect(ghDbc, hwnd, _
    ConnStrIn, Len(ConnStrIn), _
    ConnStrOut, Len(ConnStrOut), _
    cbConnStrOut, _
    SQL_DRIVER_COMPLETE_REQUIRED)
 
If (rc = SQL_ERROR) Or (rc = SQL_INVALID_HANDLE) Then
    MsgBox "Error"
    GoTo errmnuConnect
End If
 
If (Len(ConnStrOut) = 0) Then    'cancel
    GoTo errmnuConnect
End If
    
gDSN = Left(ConnStrOut, InStr(ConnStrOut, ";") - 1)
MsgBox "Connected to " & gDSN, , gAppName
 
errmnuConnect:
      On Error Resume Next
      rc = SQLDisconnect(ghDbc)
      rc = SQLFreeConnect(ghDbc)
      rc = SQLFreeEnv(ghEnv)
      ghDbc = 0                        '//clear connection handle
 

Disconnection

In this article "Visual Basic 6 code for connecting to a MySQL database using the MySQL ODBC driver", access to MySQL is achieved through an RDO object.

Yet another example of connecting to MySQL through MyODBC:

set up a DSN and do: myConn.open "DSN=<your DSN>" & "Uid=<id>;" & "Pwd=<pass>;"

OR

myConn.open "Driver={mySQL};" & "Server=<your server>;" "Database=<your database>;" "Uid=<id>;" "Pwd=<pass>;"

Connecting to a DBMS through OLEDB/ADO

ActiveX Data Object, (apparently) available from VB6 . ADO encapsultates an OLEDB provider and makes it a snap to work with a DBMS. Here's a sample:

Dim adoConn As New ADODB.Connection
adoConn.ConnectionString = "provider=LCPI.IBProvider;data source=localhost:C:\Interbase
              DBs\Employee.gdb;ctype=win1251;user id=SYSDBA;password=masterkey"
adoConn.Open

From: "Dennis Salguero"
Subject: Re: MySql, VB, Ado
Newsgroups: mailing.database.mysql

I haven't tested these functions yet for efficiency (or lack of), but below is what I use. It's straightforward - one function establishes the connection while the others either retrurn a recordset (SELECT statements) or just run a query (INSERT, UPDATE, DELETE). I would put these in it's own module and then call them at will (hence, the public ADO objects).
 
Public objRS As ADODB.Recordset
 
Function Get_Connection() As Boolean
    Set objConn = New ADODB.Connection
    objConn.Open "uid=root;pwd=password;driver={MySQL};server=localhost;database=database"
    If Err.Number = 0 Then
        Get_Connection = True
    Else
        Get_Connection = False
    End If
End Function
 
Function Get_Records(strSQL As String) As Boolean
    'Returns a recordset per the SQL statement
    Call Get_Connection
    Set objRS = New ADODB.Recordset
    Set objRS = objConn.Execute(strSQL)
    If Err.Number = 0 Then
        Get_Records = True
    Else
        Get_Records = False
    End If
End Function
 
Function Run_Query(strSQL As String) As Boolean
'Only executes an SQL statement
    Call Get_Connection
    objConn.Execute (strSQL)
    If Err.Number = 0 Then
        Run_Query = True
    Else
        Run_Query = False
    End If
End Function

From: "William Decker"

[...] Another way to do this is to create a system DSN pointed to your MySQL server then call that DSN from your VB app. To open your connection, use the following statement:
 
objConn.Open ("DSN=<dsn name>;UID=<userid>;pwd=<password>")
 
Then, if you need to change server names, you can do it in one place, not in all your applications  

Generating a big INSERT string

Due to how VB handles strings, this kind of code is quite slow:

Dim sCommand As String
    
sCommand = "begin;"
    
For lCounter = 0 To 10000
    sCommand = sCommand & "insert into mytab values (NULL,'someval','someval','someval','someval','someval','someval','someval','someval','someval','someval','someval','someval','someval','someval','someval','someval','someval','someval','someval','someval');"
    DoEvents
Next lCounter
 
sCommand = sCommand & "commit;"   

Here's how to improve things (code snippet from MS):

Const ccIncrement = 50000
Const INSERTSTRING = "insert into mytab values (NULL,'someval','someval','someval','someval','someval','someval','someval','someval','someval','someval','someval','someval','someval','someval','someval','someval','someval','someval','someval','someval');"
 
Dim ccOffset As Long
 
Sub Concat(Dest As String, Source As String)
    Dim L As Long
  L = Len(Source)
  If (ccOffset + L) >= Len(Dest) Then
      If L > ccIncrement Then
        Dest = Dest & Space$(L)
    Else
        Dest = Dest & Space$(ccIncrement)
    End If
  End If
  Mid$(Dest, ccOffset + 1, L) = Source
  ccOffset = ccOffset + L
End Sub
 
For lCounter = 0 To 10000
    Concat sCommand, INSERTSTRING
    DoEvents
Next lCounter
 
sCommand = Left$(sCommand, ccOffset)
sCommand = "begin;" & sCommand
sCommand = sCommand & "commit;"

This code can also be used to turn a two-dimensional array into a string where each item is followed by a separator, eg. cell00#cell01, etc. Pretty useful to link a grid object to an SQL engine.

Error handling

Visual Basic Error Handling

On Error Goto ErrHandler:
[...]
ErrHandler:
        Err.Raise Err.Number, Err.Source, Err.Description
        Resume MyProcedure_Exit

On Error Goto ErrHandler:
[...]
ErrHandler:
        Err.Raise Err.Number, Err.Source, Err.Description

On Error Goto ErrHandler:
Err.Clear
[...]
ErrHandler:
        mlngErrorNumber = Err.Number
        mstrErrorSource = Err.Source
        mstrErrorDescription = Err.Description
        If mlngErrorNumber <> 0 Then
                'RE-RAISE error.
                Err.Raise mlngErrorNumber, mstrErrorSource, mstrErrorDescription
        End If

TEMP STUFF - MS Internet Transfer Control

HTTP Transfer Component: Create a Server Component Using Internet Transfer Control By S.S. Ahmed

Properties

URL

Renvoie ou dfinit l'adresse URL utilise par les mthodes Execute ou OpenURL.La mthode URL doit au moins contenir un protocole et le nom d'un ordinateur hte distant.

UserName, Password

Par dfaut, si vous ne fournissez pas de valeur pour les proprits UserName et Password, le contrle envoie anonymous comme UserName, et votre identificateur de courrier lectronique comme Password.

With Inet1
        .URL = "ftp://ftp.someFTPSite.com"
        .UserName = "John Smith"
        .Password = "mAuI&9$6"
        .Execute ,"DIR" ' Renvoie le dossier.
        .Execute ,"CLOSE" ' Ferme la connexion.
End With

Note pour UserName: L'appel des mthodes OpenURL ou Execute modifie la valeur de cette proprit.

StillExecuting

Renvoie une valeur qui spcifie si le contrle Internet Transfer est occup. Le contrle renvoie la valeur True lorsqu'il est engag dans une opration telle que la rcupration d'un fichier sur Internet ; il ne rpondra pas d'autres demandes tant qu'il est occup. Cette proprit est indispensable lors de l'utilisation de la mthode Execute(), qui est asynchrone:

Inet1.Execute , "GET acme.exe"
'Wait till Execute() is done before proceeding
Do While Inet1.StillExecuting
    DoEvents
Loop
    
Inet1.Execute , "CLOSE"

RequestTimeout

Renvoie ou dfinit le temps, en secondes, avant l'expiration d'un dlai d'attente. Si une demande faite avec la mthode OpenURL (synchrone), ne rpond pas dans le temps imparti, une erreur est gnre ; si la demande a t faite l'aide de la mthode Execute, l'vnement StateChanged est dclench avec un code d'erreur. La valeur 0 affecte cette proprit signifie illimit.

hInternet

Renvoie l'identificateur Internet en provenance de l'API Wininet.dll sous-jacent. Cet identificateur peut ensuite tre utilis lors d'appels directs dans l'API. Cette proprit n'est pas utilise lors d'accs au contrle partir de Visual Basic.

Document

Renvoie ou dfinit le fichier ou le document qui sera utilis avec la mthode Execute. Si cette proprit n'est pas spcifie, le document par dfaut en provenance du serveur est renvoy. Pour les oprations d'criture, une erreur se produit si aucun document n'est spcifi.

ResponseCode

Renvoie le code d'erreur en provenance de la connexion lorsque l'tat icError (11) se produit dans l'vnement StateChanged. Vrifiez la proprit ResponseInfo pour la description de l'erreur.

        Case icError  ' 11
                ' Lecture du texte de l'erreur.
           strMess = "Code Erreur: " & Inet1.ResponseCode & " : " & Inet1.ResponseInfo

Protocol

Renvoie ou dfinit une valeur qui spcifie le protocole qui sera utilis avec la mthode Execute.

LocalIP

[????] Renvoie l'adresse IP de l'ordinateur local dans le format d'adresse IP chane ponctue (xxx.xxx.xxx.xxx). Cette proprit, en lecture seule, n'est pas disponible au moment de la cration.

Proxy

Si vous prvoyez utiliser un proxy autre que ceux indiqus dans la bote de dialogue, attribuez la proprit AccessType la valeur icNamedProxy (2). Attribuez ensuite la proprit Proxy le nom du proxy comme dans le code ci-dessous :

Inet1.Proxy = "myProxyName"
Inet1.AccessType = icNamedProxy

D’autre part, si le proxy propos par dfaut vous convient (tel que dtermin par la base de registres de votre ordinateur), ne tenez pas compte de la proprit Proxy et attribuez simplement la proprit AccessType la valeur icUseDefault (0). Une fois que vous avez dfini la proprit AccessType, l’opration de base consiste utiliser la mthode OpenURL avec un URL valide.  

AccessType

RemoteHost

Renvoie ou dfinit l'ordinateur distant sur lequel un contrle envoie ou reoit des donnes. Vous pouvez fournir soit un nom d'hte, par exemple "FTP://ftp.microsoft.com", soit une adresse IP sous forme de chane ponctue, telle que "100.0.1.1".

ResponseCode

Private Sub Inet1_StateChanged(ByVal State As Integer)
        Dim strMess As String ' Variable Message.
        Select Case State
        ' ... Les autres cas ne sont pas dcrits ici.
        Case icError  ' 11
                ' Lecture du texte de l'erreur.
           strMess = "Code Erreur: " & Inet1.ResponseCode & " : " & Inet1.ResponseInfo
        End Select
 
        Debug.Print strMess
End Sub

Methods

OpenURL

Lorsque vous utilisez la mthode OpenURL ou Execute, il n’est pas ncessaire de dfinir la proprit Protocol. Le contrle Internet Transfer active automatiquement le protocole appropri, tel que dtermin par la partie protocole de l’URL.

Dim strURL As String
Dim bData() As Byte             ' Variable de donnes
Dim intFile As Integer  ' Variable FreeFile
strURL = _
"ftp://ftp.microsoft.com/Softlib/Softlib.exe"
intFile = FreeFile()            ' Attribue intFile un
                                                                ' fichier inutilis.
' Le rsultat de la mthode OpenURL est plac dans le
' tableau Byte, et ce dernier est enregistr sur
' disque.
bData() = Inet1.OpenURL(strURL, icByteArray)
Open "C:\Temp\Softlib.exe" For Binary Access Write _
        As #intFile
Put #intFile, , bData()
Close #intFile

 

Dim strURL As String            ' Chane URL
Dim intFile As Integer  ' Variable FreeFile
IntFile = FreeFile()
strURL = "http://www.microsoft.com"
Open "c:\temp\MSsource.txt" For Output _
        As #IntFile
Write #IntFile, Inet1.OpenURL(strURL)
Close #IntFile

La mthode OpenURL donne une transmission de donnes synchrone. Dans ce contexte, synchrone signifie que l’opration de transfert est excute avant toute autre procdure. Par consquent, le transfert de donnes doit tre effectu avant l’excution de tout autre code. En revanche, la mthode Execute donne une transmission asynchrone.

 En bref, l’utilisation de la mthode OpenURL donne un flux direct de donnes que vous pouvez enregistrer sur disque (comme dans l’exemple ci-dessus) ou afficher directement dans un contrle TextBox (si les donnes correspondent du texte). En revanche, si vous utilisez la mthode Execute pour extraire des donnes, vous devez contrler l’tat de connexion du contrle l’aide de l’vnement StateChanged. Lorsque l’tat appropri est atteint, invoquez la mthode GetChunk pour rcuprer les donnes du tampon du contrle. Cette opration est dcrite de faon dtaille ci-dessous.

La mthode OpenURL revient invoquer la mthode Execute avec une opration GET, suivie d'un appel de la mthode GetChunk dans l'vnement StateChanged. Toutefois, le rsultat de la mthode OpenURL est le renvoi d'un flot synchrone de donnes en provenance du site.

Si vous rcuprez un fichier binaire, vrifiez que vous utilisez un tableau d'octets comme variable temporaire avant de l'crire sur le disque, comme le montre l'exemple ci-dessous :

Dim b() As Byte
Dim strURL As String
' Dfinit une adresse valide pour strURL.
strURL = "FTP://ftp.GreatSite.com/China.exe"
b() = Inet1.OpenURL(strURL, icByteArray)
Open "C:\Temp\China.exe" For Binary Access _
Write As #1
Put #1, , b()
Close #1

Execute

Excute une demande vers un serveur distant. Seules des demandes valides pour le protocole particulier peuvent tre envoyes.

La mthode Execute prend en charge les commandes FTP communes, telles que CD et GET. Elle prend quatre arguments : url, operation, data et requestHeaders. Les oprations FTP ne prennent que l’argument operation et l’argument url, qui est facultatif. Par exemple, pour obtenir un fichier d’un ordinateur distant, vous pourriez utiliser le code suivant :

Inet1.Execute "FTP://ftp.microsoft.com", "GET disclaimer.txt C:\Temp\Disclaimer.txt"
Execute "http://www.microsoft.com" & _"/default.htm", "GET"
Execute , "HEAD"
Execute , "POST", strFormData
Execute , "PUT", "replace.htm"
Dim strURL As String, strFormData As String
strURL = "//www.yippee.com/cgi-bin/find.exe"
strFormData = "find=Hangzhou"
Inet1.Execute strURL, "POST", strFormData

Important   Le protocole FTP utilise une chane unique qui inclut le nom de l'opration et tous les autres paramtres ncessaires cette opration. En d'autres termes, les arguments data et requestHeaders ne sont pas utiliss ; l'opration avec ses paramtres est intgralement passe sous forme d'une chane unique dans l'argument operation. Les paramtres sont spars par un espace. Prenez garde, dans les descriptions ci-dessous, de ne pas confondre les termes "file1" et "file2" avec les arguments data et requestHeaders.

Remarque   Les noms de fichiers incluant des espaces ne sont pas admis.

Inet1.Execute "FTP://ftp.microsoft.com", "GET Disclaimer.txt C:\Temp\Disclaimer.txt"
QUIT    Termine la connexion en cours pour l'utilisateur.
Inet1.Execute txtURL.Text, "SEND C:\MyDocuments\Send.txt SentDocs\Sent.txt"

GetChunk

Si vous prvoyez le renvoi d’un rsultat d’un serveur (comme dans l’exemple ci-dessus), vous devez utiliser la mthode GetChunk pour rcuprer le document HTML rsultant.

Lorsque vous tlchargez des donnes d’un ordinateur distant, une connexion asynchrone est tablie. Par exemple, en utilisant la mthode Execute avec l’opration GET , le serveur rcupre le fichier demand. Une fois la totalit du fichier rcupre, l’argument State renvoie icResponseCompleted (12). ce stade, vous pouvez utiliser la mthode GetChunk pour rcuprer les donnes du tampon.

Private Sub Inet1_StateChanged(ByVal State As Integer)
        Dim vtData As Variant ' Variable de donnes.
        Select Case State
        ' ... Autres cas non prsents.
        Case icResponseCompleted ' 12
                ' Ouvre un fichier pour y crire.
                Open txtOperation For Binary Access _
                Write As #intFile
 
                ' Obtient le premier segment. REMARQUE :
                ' spcifier un tableau Byte (icByteArray) pour
                ' rcuprer un fichier binaire.
                vtData = Inet1.GetChunk(1024, icString)
 
                Do While LenB(vtData) > 0
                        Put #intFile, , vtData
                        ' Rcupre le segment suivant.
                        vtData = Inet1.GetChunk(1024, icString)
                Loop
                Put #intFile, , vtData
                Close #intFile
        End Select
End Sub

Aprs l’invocation de la mthode Execute, la connexion reste ouverte. Vous pouvez alors continuer utiliser la mthode Execute pour effectuer d’autres oprations FTP, telles que CD et GET. Une fois la session termine, fermez la connexion l’aide de la mthode Execute avec l’opration CLOSE. Vous pouvez galement fermer la connexion automatiquement en changeant la proprit URL et en invoquant la mthode OpenURL ou la mthode Execute ; cette action fermera alors automatiquement la connexion FTP et ouvrira le nouvel URL.

GetHeader

La mthode GetHeader permet de rcuprer un texte d'en-tte dans un fichier HTTP. Si un en-tte n'est pas explicitement dsign, tous les en-ttes sont renvoys.

Cancel

Annule la demande en cours et ferme toutes les connexions actuellement tablies.

Events

StateChanged

Gnralement, l'vnement StateChanged est utilis pour dterminer le moment o les donnes pourront tre rcupres l'aide de la mthode GetChunk. Pour cela, utilisez une instruction Select Case pour tester les valeurs icResponseReceived (8) ou icResponseCompleted (12).

Notez cependant, que l'tat icResponseReceived peut tre prsent si le contrle a termin une opration sans que des donnes soient inscrites dans le tampon. Par exemple, lors d'une connexion un site FTP, le contrle ralise avec le site un acquittement qui n'entrane aucun transfert de donnes, mme si l'tat prend la valeur icResponseReceived.

D'autre part, l'tat icResponseCompleted se produit ds lors qu'une opration est termine dans son intgralit. Par exemple, si vous utilisez la mthode Execute avec l'opration GET pour rcuprer un fichier, l'vnement icResponseCompleted ne se produira qu'une seule fois : aprs la rcupration totale du fichier.

Dans la pratique, l'tat icResponseReceived vous permet d'analyser les donnes jusqu' ce que vous possdiez les informations qui vous sont ncessaires, (par exemple, seulement des en-ttes lors de la rcupration d'un fichier HTML). Vous pouvez interrompre l'opration ds que vous tes en possession des informations dsires. Si, en revanche, vous voulez rcuprer la totalit du fichier, l'tat icResponseCompleted vous avertit de la fin du transfert.

Private Sub Inet1_StateChanged(ByVal State As Integer)
        ' Rcupre la rponse du serveur l'aide de
        ' la mthode GetChunk lorsque State = 12.
 
        Dim vtData As Variant ' Variable Data.
        Select Case State
        ' ... Les autres cas ne sont pas dcrits ici.
 
            Case icError ' 11
                ' En cas d'erreur, renvoie ResponseCode et
                ' ResponseInfo.
                vtData = Inet1.ResponseCode & ":" & _
                Inet1.ResponseInfo
            Case icResponseCompleted ' 12
                vtData = Inet1.GetChunk(1024)
        End Select
        txtResponse.Text = vtData
End Sub

Uploading files to an FTP server

Private Sub Form_DblClick()
    Dim sRemote As String
    Dim sLocal As String
    Dim i As Integer
        
    sRemote = "scandisk.log"
    sLocal = "C:\Scandisk.log"
    
    Inet1.Protocol = icFTP
    Inet1.RemoteHost = "www.acme.com"
    Inet1.UserName = "user"
    Inet1.Password = "passwd"
    Inet1.Execute , "PUT """ & sLocal & """ " & sRemote
    
    Do While Inet1.StillExecuting
        DoEvents
    Loop
 
End Sub

Download a file in FTP

Inet1.UserName = "jdoe"
Inet1.Password = "test"
Inet1.URL = "ftp://www.acme.com"
    
Inet1.Execute , "GET download\acme.exe C:\Temp\acme.exe"
'Execute is asynchronous... Check the Inet1_StateChanged event to monitor the transaction
Do While Inet1.StillExecuting
    DoEvents
Loop
    
Inet1.Execute , "CLOSE"
Do While Inet1.StillExecuting
    DoEvents
Loop   

Downloading a web page in HTTP

MsgBox Inet1.OpenURL("http://www.acme.com/cgi-bin/list.exe?dir=download")
 

Another way:

Private Sub cmdDownload_Click()
    Dim strURL As String
    Dim bData() As Byte
    Dim intFile As Integer
 
    strURL = txtAddress.Text
    'Temporary storage
    intFile = FreeFile()
 
    bData() = Inet1.OpenURL(strURL, icByteArray)
    ' The file will be saved in the temp folder with the name download.exe'
    Open "c:\temp\download.exe" For Binary Access Write As #intFile
    Put #intFile, , bData()
 
    Close #intFile
End Sub

Example on how to use GetChunk() .

Resources

Useful add-ons

Does the VB5 IDE support the following features?

To add support for the mouse wheel to the VB IDE, download the FreeWheel freeware.

Here are some add-ins for the IDE, and general add-on's to VB:

CodeSmart

MZTools

BDC Software Free AddErrorHandler add-in

SourceCode to FlowChart

Dev4Dev Project Browser+

Visustin

Project Analyzer

SourceFormatX

Smart Indenter

VB Code Auto Indenter

PrettyCode Print

VBFriend

TurboVB

VB Friend

Seems to be the ancestor of CodeSmart. Auto-code in VBFriend 2.0.5 wouldn't work with VB5.

Zeus

SlickEdit

CodeWright

Multi-Edit

jEdit

Q&A

How to register ActiveX controls through a batch file?

Two working solutions I found on the Net:

For %%a in (*.ocx) do regsvr32 /s %%a

Alternative:

rem @echo off
 
setlocal
 
for /f "tokens=*" %%i in ('dir *.ocx /b /s') do call :REGIT "%%i"
goto :eof
 
:REGIT
echo register %1
regsvr32 /s %1
goto :eof
 
:eof

How to extract the path from App.Path?

Dim Index As Integer
Index = Len(App.Path)
Do Until (Not Index)
    If (Mid$(App.Path, Index, 1) = "\") Then
        Exit Do
    End If
    Index = Index - 1
Loop
AppPath = Left(App.Path, Index)

VB and Unicode?

Is it possible to display a control's name through a tool-tip?

Here's some useful code that displays a control's name as tool-tip when you move the mouse over it. Put this code in every form:

'Put this in the form
#Const DebugApp = True
 
Private Sub Form_Activate()
    #If DebugApp Then
        Dim ctl As Control
        
        Me.Caption = Me.Name
        
        On Error Resume Next
        
        For Each ctl In Controls
          If TypeOf Controls(ctl.Name) Is Control Then
            ctl.ToolTipText = ctl.Name
          Else
            ctl.ToolTipText = ctl.Name & "(" & CStr(ctl.Index) & ")"
          End If
        Next
    #End If
End Sub

The previous version:

Private Sub Form_Activate()
    Dim ctl As Control
    Dim sToolTip    As String
         
    For Each ctl In Me.Controls
        sToolTip = "Name Not Set"
 
        On Error Resume Next ' not all controls will have these properties
 
        sToolTip = ctl.Name
        'Index = if array of controls
        sToolTip = sToolTip & "(" & ctl.Index & ")"
        ctl.ToolTipText = sToolTip
    Next
 
    Me.Caption = Me.Name
End Sub

Why does UBound() on an empty array crash VB?

The old trick for checking for an empty array is this:

Dim X() As String
 
If (Not X) = -1 Then
    Debug.Print "empty"
Else
    Debug.Print "UBound is " & UBound(X)
End If

X itself is a pointer to an array. For an empty array, it is actually 0, meaning it is pointing to memory address 0, which is always taken to mean "pointing to nothing" or "pointing to null" - i.e. it is the Null Pointer. vbNullString does the same thing when it is passed to an API call.

As a pointer, there is not much you can do with X directly in VB; most attempts to use it produce a type mismatch compile error. However, (Not X) will still perform a binary Not operation on X, the actual pointer. If the pointer is 0, the result of the Not operation will be -1.

modSDSSafeArray.bas, utility functions for SafeArrays

If using a Variant array, you can use IsEmpty():

If IsEmpty(vOutput) Then

This doesn't work with Variant arrays:

How can I align items in a Listbox without using a fixed font?

Use one or more TABs between items:

    List1.AddItem "Item1" & vbTab & vbTab & "Item2"
    List1.AddItem "Item3" & vbTab & vbTab & "Item4"

Iterating through loaded forms

This code only works for forms that are currently in memory; It won't work to extract a list of forms contained in the current EXE.

Dim f As Form
'Forms is a collection of currently loaded forms
For Each f In Forms
    if frmX.Name="MySearchName" Then
        Load frmX
    end if
Next
Forms.Count

I get a license-related error when adding the Inet object

Looks like a bug in the installer or something. When adding the Internet Transfer Control to VB5 (even after adding SP3; Looks like this bug exists for VB6 as well), the IDE will complain with: "License information for this component not found. You do not have an appropriate license to use this functionality in the design environment (Error 429)". A fix is available here.

When using the Internet Transfer Control, why does the IDE hangs for a few seconds?

... although the connection is correctly closed?

Transfer errors when using the MSInet control

inet.ocx is very unstable. Either use the Winsock control along with HTTP, or get a better control.

What are the different project types in VB5?

Some code I copy/pasted from the web doesn't work

Some invisible caracters may have crept in and keep VB from running. Make sure you remove all empty characters.

What is "data binding"?

What is MDAC in the grand scheme of things?

Lost with the alphabet soup that is MS' solutions to connect a client program to a DBMS...

What are the different grid objects available for VB?

How to call an object's method?

I'd like to simulate that the user has clicked on a command button, eg. Close.Click

Can I install VB5 and VB6 on the same development host?

Not recommended. INFO: Visual Basic 5.0 and 6.0 Compatibility Issues

How to access methods after loading an OCX manually with LoadLibraryEx()?

What does the "Update ActiveX Control" checkbox in Project | Properties mean exactly?

Is it an authorization to the IDE to update a VBP/FRM when loading it in a host/IDE that has more recent versions of such and such OCX used in the project?

Can a SP meant for eg. VB6 install on a host that only has VB5 installed?

If yes, what is the consequence of mixing two sets of ActiveX controls in a project that will be compiled with the older compiler (eg. installing a VB6 SP on a host that has VB5, and compile a VB5 exe that contains some OCX's gotten from that VB6SP)?

Are OCX's VB version-dependent?

ie. if I build a VB5 EXE that includes some OCX's installed from a for V6 SP, do I need to install the VB6 runtime in addition to the VB5 runtime?

Why does an OCX have two CLSID-looking entries in the Registry?

What is the diff between a CLSID and a TypeLib?

Is there a Reg cleaner to _safely_ remove entries that point to OCX's that have been moved or removed from the filesystem?

What causes error 339 (Neither in Reg no in known directories?) ? 429 (Can find, but can't load?) ? 50003 (in Reg, but no on filesystem?) ?

Is there a link between the two-digit version number that shows up in Object lines in a VBP or FRM file, and the four-digit version number of an OCX?

Why didn't VB5SP3 install the .DEP files (in C:\WINNT\SYSTEM32 or elsewhere)?

Because I might have installed a more recent SP?

Is there a reliable way to check that a SP is installed?

... so as to avoid downloading from the Net, or should I just forget about it and download the thing? since some of our customers are still running at 56Kbps so I would like to build a light, through-the-web installer...

VB Weirderies

'This doesn't work
Call Query(db_ID, "create table table2 _
    (champ1 VARCHAR(20), champ2 VARCHAR(20))")
'Why doesn't this work, while the same instruction on one line works
Call Query(db_ID, _
    "CREATE TABLE table2 (champ1 VARCHAR(20))")
Form1.Top = 0
Form2.Top = 0
Form2.Left = Form1.Width + 20
Form2.Width = MDIForm1.Width - Form1.Width
Form2.Height = Form1.Height
Form1.Show
'Form2.Show

VB5 Peeves

Temp stuff

Visual Basic 6.0 Package and Deployment Wizard Notes

http://www.pietschsoft.com/programming/articles/Package%20and%20Deployment%20Notes.htm

http://visualbasic.about.com/od/usevb6/l/bl0001a.htm

 

 

http://docvb.free.fr/apidetail.php?idapi=190

 

http://www.garybeene.com/vb/tut-file.htm

Win32 Internet API (WinInet API)

http://www.vbip.com/wininet/index.asp

 

How to detect the WinInet version?

http://www.vbip.com/wininet/wininet_version.asp

 

Handling WinInet API errors

http://www.vbip.com/wininet/wininet_errors.asp

 

Establishing connection to ISP (Internet Service Provider) (For IE 3/4)

http://www.vbip.com/wininet/wininet_dialup.asp

 

Microsoft Winsock Resources

http://www.vbip.com/winsock-api/resources/msresources.asp

 

Class CWinInetConnection

http://www.vbip.com/wininet/wininet_connection_01.asp

 

---

Winsock Resources

 

Winsock API and VB - step by step tutorial for the Visual Basic developers

http://www.vbip.com/winsock-api/default.asp

 

CSocket class - replacement for the MS Winsock Control

http://www.vbip.com/winsock-api/csocket-class/csocket-class-01.asp

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

The Internet Transfer Control (ITC)

http://www.vbip.com/itc/default.asp

 

Binary download with the Internet transfer control

http://www.vbip.com/itc/itc-binary-download-01.asp

 

HTTP Transfer Component

http://www.vbip.com/itc/itc-http-component-01.asp

 

How to track the download progress

http://www.vbip.com/itc/itc-http-progress-01.asp

----

Retrieving network interface information

http://www.vbip.com/iphelper/get_interface_info.asp

 

---

WinSock Development Information

http://www.sockets.com/

 

http://groups.google.fr/groups?q=vb+csv+parse&hl=fr&lr=&ie=UTF-8&selm=e04db21d.0310282111.1068d678%40posting.google.com&rnum=1

http://groups.google.fr/groups?hl=fr&lr=&ie=UTF-8&threadm=uBFAmbFWCHA.4228%40tkmsftngp08&rnum=30&prev=/groups%3Fq%3Dvb%2Bcsv%2Bparse%26start%3D20%26hl%3Dfr%26lr%3D%26ie%3DUTF-8%26selm%3DuBFAmbFWCHA.4228%2540tkmsftngp08%26rnum%3D30

http://groups.google.fr/groups?hl=fr&lr=&ie=UTF-8&threadm=%23LnAYUgZAHA.1324%40tkmsftngp03&rnum=29&prev=/groups%3Fq%3Dvb%2Bcsv%2Bparse%26start%3D20%26hl%3Dfr%26lr%3D%26ie%3DUTF-8%26selm%3D%2523LnAYUgZAHA.1324%2540tkmsftngp03%26rnum%3D29

http://groups.google.fr/groups?q=vb+csv+parse&start=30&hl=fr&lr=&ie=UTF-8&selm=39C006FC.C048B1E6%40mindspring.com&rnum=31

http://groups.google.fr/groups?hl=fr&lr=&ie=UTF-8&threadm=01bc93aa%2447b37d40%242fce2399%40ams-laptop&rnum=35&prev=/groups%3Fq%3Dvb%2Bcsv%2Bparse%26start%3D30%26hl%3Dfr%26lr%3D%26ie%3DUTF-8%26selm%3D01bc93aa%252447b37d40%25242fce2399%2540ams-laptop%26rnum%3D35

http://www.freevbcode.com/ShowCode.asp?ID=2250

http://www.xbeat.net/vbspeed/c_Split.htm

http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=52142&lngWId=1

 

 

Private Sub Form_Load()

    Dim sString As String

    sString = "item1" & vbTab & "item2" & vbCrLf & "item3" & vbTab & "item4" & vbCrLf

    

    Dim iPos As Integer

    iPos = 1

    Do While (iPos < Len(sString))

        MsgBox Mid$(sString, iPos, InStr(iPos, sString, vbTab) - 1)

        'Jump after TAB

        iPos = iPos + InStr(iPos, sString, vbTab)

        

        MsgBox Mid$(sString, iPos, InStr(iPos, sString, vbCrLf) - iPos)

        'CRLF = 2 characters

        iPos = iPos + ((InStr(iPos, sString, vbCrLf) + 1) - iPos)

    Loop

    MsgBox "Done"

End Sub

 

 

 

InternetReadFile

http://www.mentalis.org/apilist/InternetReadFile.shtml

Reads data from a handle opened by the InternetOpenUrl, FtpOpenFile, GopherOpenFile, or HttpOpenRequest function.

VB4-32,5,6

Declare Function InternetReadFile Lib "wininet" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer

 

Operating Systems Supported Requires Windows NT 4.0 or later; Win9x/ME: Not supported

Resources

Tools

Source code

Documentation

TO READ

Registration-Free COM (only works for .Net apps?): Simplify App Deployment with ClickOnce and Registration-Free COM, Avoid DLL Hell with Registration-free COM

User Control and GUID problems...

 

When registering control I'm getting message 'LoadLibrary("smtp.ocx") Failed'

Control requires Visual Basic run-time libraries (MSVBVM60.dll, etc.) to be registered on your system, otherwise you'll get this error.

When I tried to register the component using "regsvr32 SMTP.ocx" I received an error message "DllRegisterServer in smtp.ocx failed"

Most likely you don't have VB runtimes on your system. To get around this problem you can download full setup for SMTP.ocx

Compiling VB

vb6.exe /make my.vbp

Visual Basic Tutorial by James S. Laferriere, MCP

tlbinfht.exe

http://www.angelfire.com/biz/rhaminisys/vboledll.html
http://www.google.fr/search?q=vb+error+339&ie=UTF-8&oe=UTF-8&hl=fr&btnG=Recherche+Google
http://www.codeguru.com/columns/Karl/index.html?id=19

http://www.devx.com/vb2themax/

http://www.codeguru.com/activex/ActiveXShellRegistration.shtml
http://www.codeguru.com/activex/ComTutorial.shtml
http://www.codeguru.com/activex/activex_tut.shtml
http://www.codeguru.com/activex/COMSecurity2.html
http://www.codeguru.com/activex/COMSecurity1.html
http://www.codeguru.com/activex/RegClean.html
http://www.codeguru.com/activex/TheOdd.html
http://www.codeguru.com/activex/hyperlinks.shtml
http://www.codeguru.com/activex/typelibres.shtml
http://www.codeguru.com/activex/tlbrowser.shtml
http://www.codeguru.com/activex/DyCOM.html
http://www.codeguru.com/activex/ObjectLookup.html
http://www.codeguru.com/activex/AfxGetClassIDFromString.shtml
http://www.codeguru.com/activex/RemoteReg.shtml
http://www.codeguru.com/activex/regserver.shtml
http://www.codeguru.com/activex/DllUnregisterServer_MFC_Impl.shtml

http://www.codeguru.com/activex/index.shtml
http://www.codeguru.com/activex/index.shtml

http://groups.google.fr/groups?hl=fr&ie=UTF-8&oe=UTF-8&q=vb+%22update+activex+controls%22&sa=N&tab=wg

http://www.ifat.net/index2.html

Early binding?

Dim o As YourObject
Set o = New YourObject

Late binding?

Dim iAdd As CodeGuruMathLib.iAdd
Set iAdd = CreateObject("CodeGuru.FastAddition")

iAdd.SetFirstNumber 100
iAdd.SetSecondNumber 200

MsgBox "total = " & iAdd.DoTheAddition()