Windows applications in Visual Basic 5

Introduction

Best Practices

• Forms should contain UI-related only; Any logic should live in modules or (even better) class modules
• Class modules make it easier to encapsulate data and code, and reduce the consequences of code changes on the rest of a project
• Use local variables as much as possible, with form- or module-limited variables coming as second best. Avoid project-wide variables as much as possible
• Option Base 1 to reduce the risk of by-one errors in using arrays
• Option Explicit to make sure all the variables are declared before being used
• Indent your code: Since the VB IDE does not support automatic indenting, you can use add-ons such as VB Assistant (a bit buggy, though). Another enhancement to the IDE is MZ-Tools
• Use the Hungarian notation instead of suffixes to make it easier to tell the data type of a variable, eg. sCommand instead of command$
• Use tools like PEBundle to combine the EXE and its DLLs
• Use UPX to compress DLLs and EXEs
• Reduce dependencies as much as possible, eg. hit the Win32 API directly instead of relying on ActiveX controls that perform the same task, use DLL-based embedded SQL engines like SQLite to avoid installing MDAC and ODBC drivers, etc.
• For number-crunching parts, use PowerBasic for Windows (formerly known as PB/DLL) to compile this code into a fast DLL
• Use an installer program such as Inno Setup
• Consider using pointers to increase performance

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":

• ADVPACK.DLL 6.0.2600.0
• ASYCFILT.DLL 2.20.4118.1
• COMCAT.DLL 4.71.1441.1
• MSVBVM50.DLL 5.2.82.44 (Win98 comes with an older version)
• msvbvm50.inf N.A.
• OLEAUT32.DLL 2.20.4118.1
• OLEPRO32.DLL 5.0.4118.1
• REGTLIB.EXE N.A.
• STDOLE2.TLB 2.20.4118.1
• W95INF16.DLL 4.71.16.0
• W95INF32.DLL 4.71.16.0

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

• Binary Compatibility
• DLL Loading Rules in Win32
• When and how to install VB runtime DLLs, the OLE DLLs and the Common Controls and Common Dialogs
• DLL HELL: The inside story By FrankyWong - Vice President, Desaware, Inc.
• COMDLG32.OCX, COMCTL32.OCX, COMCT232.OCX Loading Errors
• SxS Components  vs. DLL/COM Redirection (check MMM The Next Generation)
• Do not attempt to replace any of the files protected by System File Protection that ship with Windows 2000, including most .sys, .dll, .exe, and .ocx files
• Windows 2000 includes Windows Installer version 1.1, which will support install and uninstall of side-by-side components
• A History question ... DLL Hell and Unix

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 :

• Unlike C-type DLLs which only need to live in locations set in the PATH or the local directory for Windows to locate them, OCXs are located by looking up their entry in the Registry (either directly through its unique CLSID, or indirectly through the human-readable indirection ProgID)
• Post-98 versions of Windows do not require explicit registration for the OCX to be available: The first time a brand new OCX is called (ie. provided it hasn't been registered with regsvr32.exe, either manually or through an install program like WYSE or InstallShield), Windows will register it silently, provided, obviously, that it could locate this OCX (which works if it is located either in the local directory where the calling EXE lives, in the Windows system directory, or in the PATH). From then on, the OCX is registered, and available to any program
• Whenever a program loads an OCX, Windows looks up in the Registry to find where this OCX lives on the hard-disk; if the OCX file has been removed with no unregistration, loading will fail. This also means that just copying an OCX in eg. your local directory is not enough to have your program use this version if another version is already registered in the Registry
• A worse issue is what happens when another program installs a different version of an OCX that your program uses
• The solution seems to be that your program should check at start-up whether the versions of all the OCXs that it depends on are currently registered; If a different version is registered (ie. the user installed another app that registered a different version of your OCXs), then you'll have to rewrite those pointers in the Registry for your application to use your versions instead. Yes, it's dirty...
• When building OCXs, ensure binary compatibility

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

• Create an Application Launcher by Chris Barlow [VBPJ April 1999]
• Create Internet-Friendly Applications by Andy Rosebrock
• Select Microsoft Internet Transfer Control 6.0 (SP4). Make sure you install Service Pack 4, because prior versions of the ITC contain a bug that can prevent the download of larger files
• like Install Shield's WebUpdate, Marimba's UpdateNow etc (if I am right ).
• I've done this with several applications.  The first couple of times I did it, I simply used the internet transfer control to have the app retrieve a web page on my server containing the application's most recent version.  I compared the version on that page with the version of the app that retrieved it, and prompted the user to come to the site to download the new version, if necessary.  Since the apps were designed to connect to the internet anyway, it was simple . . . I just checked for a version after I knew that they were already online and using the application.
• In my most recent applications, I've built an auto-update functionality that is a bit more sophisticated.  If the application finds that the user needs a new version, and the user chooses to update, a small stub .exe opens and the application closes down.  The stub .exe updater app goes to my site and retieves just the new files that are needed to update the main application .. . usually just the .exe file and perhaps some other small files.  My users like this, since they don't have to come to the site to download a huge installation package.  This is a fairly simple process using the Internet Transfer Control, part of wininet.dll.  You should find this as a component that you can add if you use VB 6.0.  Documentation is a bit skimpy, but you should be able to find enough on it to figure it out.  Make sure you look to http://codehound.com and http://planetsourcecode.com for examples, or any number of other VB sites.
• From:         Seth Perelman <seth@PERELMAN.COM>
  
  We did this on our own, and it was quite easy.  You didn't tell us much about your application, so what we did may not apply, but here goes:
  
  our application is initially launched from a web page as a DLL referenced from the page
  
  that DLL then uses the Dart PowerTCP WebTool to access our web server and download an installation built with Wise Installer
  
  the installer installs an ActiveX EXE
  
  when our web site needs to talk to the EXE, it uses the DLL installed in the first step
  
  the EXE always runs, and every x hours polls our web site to see if there is a new version.  It does this by only retrieving the headers from a specific page, and we have a custom header with the version number.  Getting the headers only is the lightest web transaction we could do.
  
  when there is a new version, the EXE prompts the user and will download it if the user clicks OK.  What is downloaded is the same installation the DLL downloads for the initial installation
  
  the installer loads the new version and runs it, and it then opens a "thank you" page in the web browser, and this page has the most recent object reference for the DLL, so it will prompt the user the load a new version if there is one
  
  This process keeps everything nicely up-to-date.  The polling process also tells our server what version the customer currently has, so we know how many are out-of-date.  All information sent to our server is clearly laid out in our license agreement.
• Check out MS' unsupported INUSE.EXE utility (updates a locked file at the next reboot)
• "The WebVrChk ActiveX Control lets you easily add version checking to your applications across the internet or an intranet. Suggested usage is to periodically (e.g. on application start up or once a month) call the Check() method that performs a version check for you. If a different version is found the one specified, the control triggers the UpdateAvailable Event. This allows the flexiblity to prompt the user to download a newer version if one is available."

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

 

'résout pas le problème 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 effectuée")

                

                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

• Unofficial Documentation for VarPtr, StrPtr, and ObjPtr
• Programmatically register an ActiveX control or DLL
• Register Components without using Regsvr32.exe

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:

• VB comes with the MS Chart control MSCHART.OCX. Good for simple usage. It appears that the second edition (MSCHRT20.OCX) adds support for OLEDB, ie. I guess you can link the control to a database, and have SELECTed data be graphed automagically
• CsXGraph ($60)
• Imagio SimpleChart ($130)
• Gigasoft ProEssentials (Lite $149.00, Standard $399.00, Pro $1299.00)
• Quinn-Curtis ($150)
• TeeChart Pro ($ 359)
• ComponentOne Chart ($459.95)
• DataDynamics Active Reports (more than just graphing; alternative to Crystal Report; Standard Edition - $499.00)
• SoftwareFX Chart FX Client Server ($600)

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

• Optimize your code
• VBHelper Performance Tuning
• VB Profiler (including When a VB string becomes a noose)
• Aivosto's Visual Basic tips and Optimize string handling in Visual Basic 6.0
• VBSpeed
• Performance Tuning Tips
• A fast method for appending strings by Jody Gelowitz
• Class to handle string concatenation more efficiently by Brian M. Matumbur
• Implement VB6 string functions in VB5 (Improved Over MSKB Version) by Jay Duhon
• InStrRev for VB5 by Intelligent Solutions Inc.
• How the System Deals with Text
• StringBuilder Class for VB
• Optimizing your VB code even more by Almar Joling
• Play VB's Strings by Francesco Balena (PDF)
• Mastering Strings

RichText

• http://msdn.microsoft.com/library/en-us/dnrtfspec/html/RTFSpec_5.asp
• http://msdn.microsoft.com/library/en-us/dnrtfspec/html/rtfspec.asp
• Rich Text Format (RTF) Specification,version 1.6
• http://www.cpan.org/authors/Philippe_Verdret/
• http://www.logictran.net/
• http://piper.ntua.gr/toolkit.html
• http://www.convertzone.com/document_converter/help.htm
• http://www.php9.com/index.php/section/articles/name/Using%20PHP%20for%20Rich%20Text%20Format%20RTF
• http://netghost.narod.ru/gff/graphics/summary/micrtf.htm
• http://search.microsoft.com/search/results.aspx?View=msdn&st=a&qu=rtf&c=4&s=2
• RTF file normalization
• http://en.wikipedia.org/wiki/RTF
• http://www.snake.net/software/RTF/
• http://www.rssol.com/en/html/tips/atlant10/supercompact_rtf.htm
• AbiWord

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:

• IsObject
• IsMissing
• IsNull
• IsEmpty
• If Not cMe Then
• If Not cMe Is Nothing Then

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:

• http://www.ilook.fsnet.co.uk/vb/vbreg.htm
• http://www.freevbcode.com/ShowCode.Asp?ID=2887
• http://www.freevbcode.com/ShowCode.Asp?ID=1422
• http://www.freevbcode.com/ShowCode.Asp?ID=1156
• http://www.freevbcode.com/ShowCode.Asp?ID=1156
• http://www.freevbcode.com/ShowCode.Asp?ID=607
• http://www.freevbcode.com/ShowCode.Asp?ID=13
• http://www.freevbcode.com/ShowCode.Asp?ID=1819
• http://www.freevbcode.com/ShowCode.Asp?ID=1519
• http://www.freevbcode.com/ShowCode.Asp?ID=843
• http://www.freevbcode.com/ShowCode.Asp?ID=314
• http://www.freevbcode.com/ShowCode.Asp?ID=335
• http://www.freevbcode.com/ShowCode.Asp?ID=242
• http://www.freevbcode.com/ShowCode.Asp?ID=2598
• http://www.freevbcode.com/ShowCode.Asp?ID=3377
• http://www.freevbcode.com/ShowCode.Asp?ID=1368
• http://www.freevbcode.com/ShowCode.Asp?ID=437
• http://www.freevbcode.com/ShowCode.Asp?ID=3175
• http://www.freevbcode.com/ShowCode.Asp?ID=2475
• http://www.freevbcode.com/ShowCode.Asp?ID=767
• http://www.freevbcode.com/ShowCode.Asp?ID=1370

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

• Introduction to Client/Server Applications using Winsock Control by ahmed

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 "Numéro 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:

• Put # (can be used for either binary or text?), Write # (inserts comas, etc.), Print # (as is; "Si vous souhaitez lire ultérieurement un fichier à l'aide de l'instruction Input #, utilisez l'instruction Write # plutôt que l'instruction Print # pour écrire les données dans ce fichier. L'utilisation de l'instruction Write # garantit l'intégrité de chaque champ de données grâce à une délimitation précise, de sorte que le fichier peut ensuite être relu à l'aide de l'instruction Input #. L'instruction Write # permet également une lecture correcte du fichier, quels que soient les paramètres régionaux.")
• Input #, Line Input #

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

• Zip, a PKZIP compatible compressor/decompressor; Check Chris Eastwood's CGZipLibrary for a VB wrapper to the DLLs (either copy the CLS and BAS files in your EXE for static compiling, or build the OCX; See Product Version for actual version number of DLL)
• zlib, a spin-off of the InfoLib/ZIP project, and is a free compression library by Jean-loup and Mark, based on the deflate/inflate code in Zip and UnZip, but uses a different format from PKZIP. Mark Nelson's OCX makes it a breeze to work with ZLib (which is compiled into the OCX, so you only need to distribute the OCX; Mark's unsupported OCX). You can also try Benjamin Dowse's OCX, and play with a Win32 version of the DLL (using STDCALL, I guess). Yet another solution is to use Bob Sewell's code (posted in the VisBas-L archives) to use the Zlib DLL to pack files in a proprietary way
• SawZip (more infos here and here)
• 7Zip (GPL, but the DLL seems only available against $? "[...] you can request special Developer license. Developer license may include: the right to use 7-Zip program and 7-Zip source code in your software and hardware with license that you need, technical support for 7-Zip source code and 7-Zip DLL modules, custom feature development and so on"; LZDMA SDK is GPL, though)
• XZip (not open-source)
• VBZip (not open-source, requires 4 files)
• VFZip (not open-source, error when loading : missing license)
• WinRAR (not open-source; OCX available)

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:

• XFile - Extending the Win32 File API for Server Applications By Hans Dietrich (C++ source)
• XZip and XUnzip - Add zip and/or unzip to your app with no extra .lib or .dll By Hans Dietrich
• Four articles over at VBAccelerator on accessing the InfoZip and Zlib DLLs from VB
• Add Some Zip to Your Apps
• ZLib Compression Routines - Part I, Part II, Part III (registration required)

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

• http://projects.vbmysql.com/vbmysqldirect
• A fork from MyVbQl

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

• SetOption
• ClearOptions
• OpenConnection 
• CloseConnection
• SelectDb
• Execute
• QueryInfo
• Flush
• LastInsertID
• Ping

Properties

• Error
• State
• Hostname
• Username
• Password
• DbName
• AutoUpdate
• QueryString

Enums

• MYSQL_CONNECTION_STATE
• MYSQL_OPTION
• MYSQL_FLAG
• MYSQL_FLUSH

MYSQL_RS

Methods

• MoveFirst
• MoveLast
• MovePrevious
• MoveNext
• CloseRecordset
• FindFirst
• FindLast
• FindNext
• FindPrevious
• RsToHtmlTable
• AddNew
• Update
• CancelUpdate
• Delete
• Requery

Properties

• State
• AffectedRecords
• QueryString
• RecordCount
• FieldCount
• Fields
• BOF
• EOF
• AbsolutePosition
• EditMode
• Table
• TableCount

Enums

• MYSQL_RECORDSET_STATE
• MYSQL_ABSOLUTE_POSITION
• MYSQL_FIND
• MYSQL_EDIT_MODE

MYSQL_FIELD (not creatable)

Properties

• Name
• MySqlType
• Value
• Table
• Flags
• Length
• MaxLength
• Decimals

Enums

• MYSQL_FIELD_TYPES
• MYSQL_FIELD_FLAGS

MYSQL_ERR (not creatable)

Methods

• Clear

Properties

• Number
• Description

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 définit l'adresse URL utilisée par les méthodes Execute ou OpenURL.La méthode URL doit au moins contenir un protocole et le nom d'un ordinateur hôte distant.

UserName, Password

Par défaut, si vous ne fournissez pas de valeur pour les propriétés UserName et Password, le contrôle 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 méthodes OpenURL ou Execute modifie la valeur de cette propriété.

StillExecuting

Renvoie une valeur qui spécifie si le contrôle Internet Transfer est occupé. Le contrôle renvoie la valeur True lorsqu'il est engagé dans une opération telle que la récupération d'un fichier sur Internet ; il ne répondra pas à d'autres demandes tant qu'il est occupé. Cette propriété est indispensable lors de l'utilisation de la méthode 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 définit le temps, en secondes, avant l'expiration d'un délai d'attente. Si une demande faite avec la méthode OpenURL (synchrone), ne répond pas dans le temps imparti, une erreur est générée ; si la demande a été faite à l'aide de la méthode Execute, l'événement StateChanged est déclenché avec un code d'erreur. La valeur 0 affectée à cette propriété 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 propriété n'est pas utilisée lors d'accès au contrôle à partir de Visual Basic.

Document

Renvoie ou définit le fichier ou le document qui sera utilisé avec la méthode Execute. Si cette propriété n'est pas spécifiée, le document par défaut en provenance du serveur est renvoyé. Pour les opérations d'écriture, une erreur se produit si aucun document n'est spécifié.

ResponseCode

Renvoie le code d'erreur en provenance de la connexion lorsque l'état icError (11) se produit dans l'événement StateChanged. Vérifiez la propriété 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 définit une valeur qui spécifie le protocole qui sera utilisé avec la méthode Execute.

LocalIP

[????] Renvoie l'adresse IP de l'ordinateur local dans le format d'adresse IP chaîne ponctuée (xxx.xxx.xxx.xxx). Cette propriété, en lecture seule, n'est pas disponible au moment de la création.

Proxy

Si vous prévoyez utiliser un proxy autre que ceux indiqués dans la boîte de dialogue, attribuez à la propriété AccessType la valeur icNamedProxy (2). Attribuez ensuite à la propriété 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 défaut vous convient (tel que déterminé par la base de registres de votre ordinateur), ne tenez pas compte de la propriété Proxy et attribuez simplement à la propriété AccessType la valeur icUseDefault (0). Une fois que vous avez défini la propriété AccessType, l’opération de base consiste à utiliser la méthode OpenURL avec un URL valide.  

AccessType

• icUseDefault    0       Par défaut. Le contrôle utilise les valeurs par défaut se trouvant dans la base de registre, pour accéder à Internet.
• icDirect        1       Accès direct à Internet. Le contrôle réalise une connexion directe à Internet.

RemoteHost

Renvoie ou définit l'ordinateur distant sur lequel un contrôle envoie ou reçoit des données. Vous pouvez fournir soit un nom d'hôte, par exemple "FTP://ftp.microsoft.com", soit une adresse IP sous forme de chaîne ponctuée, 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 décrits 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 méthode OpenURL ou Execute, il n’est pas nécessaire de définir la propriété Protocol. Le contrôle Internet Transfer active automatiquement le protocole approprié, tel que déterminé par la partie protocole de l’URL.

Dim strURL As String

Dim bData() As Byte             ' Variable de données

Dim intFile As Integer  ' Variable FreeFile

strURL = _

"ftp://ftp.microsoft.com/Softlib/Softlib.exe"

intFile = FreeFile()            ' Attribue à intFile un

                                                                ' fichier inutilisé.

' Le résultat de la méthode 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            ' Chaîne 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 méthode OpenURL donne une transmission de données synchrone. Dans ce contexte, synchrone signifie que l’opération de transfert est exécutée avant toute autre procédure. Par conséquent, le transfert de données doit être effectué avant l’exécution de tout autre code. En revanche, la méthode Execute donne une transmission asynchrone.

 En bref, l’utilisation de la méthode OpenURL donne un flux direct de données que vous pouvez enregistrer sur disque (comme dans l’exemple ci-dessus) ou afficher directement dans un contrôle TextBox (si les données correspondent à du texte). En revanche, si vous utilisez la méthode Execute pour extraire des données, vous devez contrôler l’état de connexion du contrôle à l’aide de l’événement StateChanged. Lorsque l’état approprié est atteint, invoquez la méthode GetChunk pour récupérer les données du tampon du contrôle. Cette opération est décrite de façon détaillée ci-dessous.

La méthode OpenURL revient à invoquer la méthode Execute avec une opération GET, suivie d'un appel de la méthode GetChunk dans l'événement StateChanged. Toutefois, le résultat de la méthode OpenURL est le renvoi d'un flot synchrone de données en provenance du site.

Si vous récupérez un fichier binaire, vérifiez 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

' Définit 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

Exécute une demande vers un serveur distant. Seules des demandes valides pour le protocole particulier peuvent être envoyées.

• Commandes HTTP prises en compte: GET, HEAD, POST, PUT
• Commandes FTP prises en charge: CD, CDUP, CLOSE, DELETE, DIR, GET, LS, MKDIR, PUT, PWD, QUIT, RECV, RENAME, RMDIR, SEND, SIZE

La méthode Execute prend en charge les commandes FTP communes, telles que CD et GET. Elle prend quatre arguments : url, operation, data et requestHeaders. Les opérations 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 chaîne unique qui inclut le nom de l'opération et tous les autres paramètres nécessaires à cette opération. En d'autres termes, les arguments data et requestHeaders ne sont pas utilisés ; l'opération avec ses paramètres est intégralement passée sous forme d'une chaîne unique dans l'argument operation. Les paramètres sont séparés 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 prévoyez le renvoi d’un résultat d’un serveur (comme dans l’exemple ci-dessus), vous devez utiliser la méthode GetChunk pour récupérer le document HTML résultant.

Lorsque vous téléchargez des données d’un ordinateur distant, une connexion asynchrone est établie. Par exemple, en utilisant la méthode Execute avec l’opération « GET », le serveur récupère le fichier demandé. Une fois la totalité du fichier récupérée, l’argument State renvoie icResponseCompleted (12). À ce stade, vous pouvez utiliser la méthode GetChunk pour récupérer les données du tampon.

Private Sub Inet1_StateChanged(ByVal State As Integer)

        Dim vtData As Variant ' Variable de données.

        Select Case State

        ' ... Autres cas non présentés.

        Case icResponseCompleted ' 12

                ' Ouvre un fichier pour y écrire.

                Open txtOperation For Binary Access _

                Write As #intFile

 

                ' Obtient le premier segment. REMARQUE :

                ' spécifier un tableau Byte (icByteArray) pour

                ' récupérer un fichier binaire.

                vtData = Inet1.GetChunk(1024, icString)

 

                Do While LenB(vtData) > 0

                        Put #intFile, , vtData

                        ' Récupère le segment suivant.

                        vtData = Inet1.GetChunk(1024, icString)

                Loop

                Put #intFile, , vtData

                Close #intFile

        End Select

End Sub

Après l’invocation de la méthode Execute, la connexion reste ouverte. Vous pouvez alors continuer à utiliser la méthode Execute pour effectuer d’autres opérations FTP, telles que CD et GET. Une fois la session terminée, fermez la connexion à l’aide de la méthode Execute avec l’opération CLOSE. Vous pouvez également fermer la connexion automatiquement en changeant la propriété URL et en invoquant la méthode OpenURL ou la méthode Execute ; cette action fermera alors automatiquement la connexion FTP et ouvrira le nouvel URL.

GetHeader

La méthode GetHeader permet de récupérer un texte d'en-tête dans un fichier HTTP. Si un en-tête n'est pas explicitement désigné, tous les en-têtes sont renvoyés.

Cancel

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

Events

StateChanged

Généralement, l'événement StateChanged est utilisé pour déterminer le moment où les données pourront être récupérées à l'aide de la méthode 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 présent si le contrôle a terminé une opération sans que des données soient inscrites dans le tampon. Par exemple, lors d'une connexion à un site FTP, le contrôle réalise avec le site un acquittement qui n'entraîne aucun transfert de données, même si l'état prend la valeur icResponseReceived.

D'autre part, l'état icResponseCompleted se produit dès lors qu'une opération est terminée dans son intégralité. Par exemple, si vous utilisez la méthode Execute avec l'opération GET pour récupérer un fichier, l'événement icResponseCompleted ne se produira qu'une seule fois : après la récupération totale du fichier.

Dans la pratique, l'état icResponseReceived vous permet d'analyser les données jusqu'à ce que vous possédiez les informations qui vous sont nécessaires, (par exemple, seulement des en-têtes lors de la récupération d'un fichier HTML). Vous pouvez interrompre l'opération dès que vous êtes en possession des informations désirées. Si, en revanche, vous voulez récupérer la totalité du fichier, l'état icResponseCompleted vous avertit de la fin du transfert.

Private Sub Inet1_StateChanged(ByVal State As Integer)

        ' Récupère la réponse du serveur à l'aide de

        ' la méthode GetChunk lorsque State = 12.

 

        Dim vtData As Variant ' Variable Data.

        Select Case State

        ' ... Les autres cas ne sont pas décrits 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

• http://www.vbip.com/protocols/ftp/vb-ftp-client-library/tutorials/tutorial-04.asp
• Trappable Errors for the Internet Transfer Control
• Example Using the Internet Transfer ActiveX Control 
• Fairly Simple FTP Upload/Download Control (ocx)
• VBFTP.EXE: Implementing FTP Using WinInet API from VB
• Chapter 11: Transferring Files over the Internet

Useful add-ons

Does the VB5 IDE support the following features?

• Automatic indenting and auto-completion of conditional blocks, ie. if the user type "If A then", the IDE automatically adds a "End If", adds a comment to tell where the conditional block started, indents the next line, and moves the cursor to this line:
  
  If A then
      'Cursor is now waiting here
  End If 'If A
  
• Automatic code formater (either manually, when closing a project, or when typing a block like If)
• Shortcuts for ....
• scrolling through code using the CTRL-Up/Down like UltraEdit
• setting/moving to/removing Bookmarks (instead of hitting Edit | Bookmarks | etc. each time)
• Stopping a program (F5 to start, but no shortcut to stop?)
• Persistent bookmarks http://www.aptrio.com/Development/Visual-Basic/workbench-for-vb-8505.html
• Support for regex in finding pattersn? Using "^$^$" to look for two consecutive empty lines doesn't work
• Collapse source code into some kind of tree like Scintilla so I can see where each conditional block starts and ends (eg. for each event like Form_Load, VB could show the entire code for this section into a tree). For an example of this type of utility, see the excellent Lynx Project Explorer (http://www.zippety.net/)
• Shows the logic of a program from different levels, so as to ease understanding when reading someone else's code
• Saves params like show whole file or only current routine

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

• http://www.axtools.com/
• Single-user $189
• Support shortcuts to add code automatically through its AutoText add-in (eg. ife generates the If/Else/EndIf block), code reformating, etc.
• No code expand/collapse
• Changes from 2001 release: CodeFlow added in the Project Explorer
• How to remove empty lines?

MZTools

• http://www.mztools.com/
• Supports VB5, but requires the VB6 runtime
• Appart from a keyboard shortcut to bookmarks, I didn't see any killer feature in this free add-on
• Unfortunately, the MZ add-in (for VB5 at least) doesn't support Fx, eg. not possible to hit F2 to loop through bookmarks

BDC Software Free AddErrorHandler add-in

• http://www.bdcsoftware.com/development/AddErrorHandler/adderrorhandler.html

SourceCode to FlowChart

• http://www.fatesoft.com/s2f/

Dev4Dev Project Browser+

• http://www.dev4dev.com

Visustin

• Available from Aivosto and Codework
• Single-user $249
• Copy/paste a routine, and have Visustin create a flowchart. Unable to do this for a whole project, unfortunately

Project Analyzer

• Available from Aivosto and Codework
• Areas of interest :
• Report > Lists > Procedure list with details
• Report > Call trees
• Report > Module Diagrams
• View > Call Tree

SourceFormatX

• Code beautifier
• http://www.textrush.com/formatx.htm
• Single user $36.99

Smart Indenter

• http://www.bmsltd.ie/Indenter/indentpage.asp
• Didn't install in IDE

VB Code Auto Indenter

• Free, by Andrew Davey
• Didn't try
• http://www.freevbcode.com/ShowCode.asp?ID=1491

PrettyCode Print

• http://www.prettycode.com
• Formats your code, including Line Bracket Connections and Auto Indent
• As of June 2004, can't print more than 1 page/sheet. A solution I found is to print into FinePrint or PDF Factory, and print the resulting PDF

VBFriend

• Kid brother of CodeSmart
• http://www.aivosto.com/vbfriend.html

TurboVB

• http://www.turbodeveloper.com
• Single-user $250
• Couldn't register the ActiveX DLL in release 3.1.2 on a W2K Pro host with VB5SP3 installed. For VB6 only?
• Supports some form of auto-completion through the Word Complete add-in (ie. a structure is linked to a shortcut, eg. "sel" replaces the shortcut with a complete Select Case block)

VB Friend

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

Zeus

• http://www.zeusedit.com/
• Tried release 3.90, which is supposed to support VB right out of the box, but .VBP wasn't shown in the list of filters, and no documention either on- or off-line on how to set it up to work with VB stuff.
  
  Reply from Zeus: "FWIW to configure the .VBP extension you would need to use the Options Document Types menu, edit the Basic document type and add this extension to the document type. I have added the .VBP to the Zeus installation."

SlickEdit

• http://www.slickedit.com
• No code collapse, not meant for VB developers, etc.

CodeWright

• http://www.codewright.com/
• No code collapse, not meant for VB developers, etc.

Multi-Edit

• http://www.multieditsoftware.com
• No code collapse, not meant for VB developers, etc.

jEdit

• http://www.jedit.org/
• Java...

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?

• Vb6 Unicode ActiveX Controls for Programmers and Developers
• Unicode and VB6
• Internationalization with Visual Basic by Michael S. Kaplan
• Why do strings appear as ???
• UniToolbox - Controls for Unicode development in Visual Basic
• Display Japanese in VB6 on Any Computer Regardless of Locale and Unicode Visual Basic Examples
• Chilkat Charset ActiveX
• VB6 isn't using Unicode, most of the time
• VB6 Unicode Tutorial (aka "Ton's O VB6 & Unicode Fun")
• Classic VB - Does Visual Basic 6 support Unicode?
• Office 2000 activeX controls, a.k.a. Forms 2.0 (FM20.dll) (download)
• Unicode Controls for VB6 2.0

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:

• If VarType(vOutput) > vbArray Then
• If (Not vOutput) = -1 Then 'Incompatible type
• If UBound(vOutput, 1) = 0

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?

• Standard EXE : stand-alone EXE (as usual, requires the VB run-time)
• ActiveX EXE : Out-of-context (ie. runs in its own process) OCX with GUI?
• ActiveX DLL : In-context (ie. runs in the same process as the calling EXE) OCX without GUI?
• ActiveX Control : Object used in a web page?
• Add-in : Items that show up in the IDE menu bar
• VB xxx Edition Control : Standard EXE project with a bunch of additional controls available in the toolbox
• ActiveX Document EXE or DLL (.dob): Forms-like objects that can be displayed in a web page (deprecated now that we have VB.Net?)

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?

• Grid.ocx: shipped with older versions of VB
• MSFlexGrid.ocx: replaced grid.ocx in more recent versions of VB, but still not as useful as commercial alternatives
• VSFlexGrid.ocx: full-featured, commercial alternative
• DBGrid
• DBGrid2
• Data
• DBList
• TrueDBGrid
• Farpoint's Spread

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

• How to add a string in MySQL? This doesn't work, and I have to use 'toto' instead:
            Dim sTemp As String
            sTemp = "toto"
            For iCounter = 1 To 20000
                Call Query(db_ID, "INSERT INTO table2 VALUES (sTemp, 'B','C', 'D','E','F','G', '', '', '', '', '', '', '', '')")
            Next iCounter

• The IDE doesn't allow using the "_" sign to split a long instruction into more than one line if the _ sign is located inside a string:

'This doesn't work

Call Query(db_ID, "create table table2 _

    (champ1 VARCHAR(20), champ2 VARCHAR(20))")

• When calling such instruction locating the _ sign outside the string part, even if VB accepts it, MySQL won't:

'Why doesn't this work, while the same instruction on one line works

Call Query(db_ID, _

    "CREATE TABLE table2 (champ1 VARCHAR(20))")

• A form that is hidden is automatically shown if referenced.

• Here, Form1 and Form2 are set to Visible = False at design time. The very simple act of setting Form2 properties result in showing it without even using Form2.Show !

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

• The IDE isn't as good as we should expect considering it's already release 5 ans M$ isn't particularly hard up for $:
• no support for a wheel-mouse
• no support for in-place scrolling (ie. scrolling with CTRL to avoid having to scroll the cursor up or down)
• No Sleep() statement, handy when you need to pause a few seconds for a task to terminate
• Can't do Dim myarray()="Item1", "Item2" as String
• Bookmarkings
• No short-cuts
• Not saved when closing file
• Poor project viewer: wished I could see all the procedures listed in the tree for all obejcts (eg. Form1 | Command1, Command2), and even logical blocks as well (eg. If/Else/End If)
• No automatic indentic with auto-completion (ie. If the user types "If (A = 1) then" and hits carriage return, the IDE should add "End If" and move the cursor automatically to the line that follows the conditional statement and indent this line automatically)
• no support for instructions to either get out of a IF/ELSE/END IF block, or resume a FOR/DO-LOOP (ie. skip the current iteration and go on to the next, without having to use ugly GOTO statements right before the NEXT or LOOP statement)

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

• ComGuard ("ComGuard will help you build reliable programs in a number of ways.")
• XP-style taskpane widgets: ExplorerBar ($199), Xceed SmartUI ($750), TeeBo ExplorerBarXP ($60), Codejock Xtreme TaskPanel ($99), vbAccelerator ExplorerBar (free but not updated since 2003), Exocontrol eXPlorerBar ($159), XP style Explorer Bar (Win32/MFC; Free; Last updated 2004), VbKeys Explorer Bar (nice, but groups below don't move up when the group above is collapsed), axExplorer (no longer developped; part of the $250 axComponent Suite)
• Controls resizing/repositionning: Resize Xtra, ActiveResize

Source code

• Free VB Code
• Planet Source Code
• Code Guru - VB Section
• VB Code - Code snippets and files

Documentation

• Visual Basic Error Codes and Messages
• (Expert Exchange) Error Code Listing
• MSDN - Visual Basic section
• MSDN DLL Help Database
• Using the Winsock Control
• A Basic Winsock TCP/IP Chat Program
• VBAccelerator Source Depot
• VB World
• VB Information
• What is the History of VB?
• Why Visual Basic 6 was frozen
• Why I am called "the Father of Visual Basic"
• Outlook-like bars: XPressSideBar, ActiveBar
• Code Explorers: AxTools, Scintilla
• VB Diamond
• Code formatter: VBFriend, VBAssistant
• (Online) Hardcore Visual Basic by Bruce McKinney
• Visual Basic Tutorials
• Printing with VB
• Dev Articles on VB
• Tutorial: Database Capabilities Overview
• ADO Connection Strings
• Site to fetch missing DLLs and OCXs
• Downloads for VB 6
• MyODBC - the MySQL ODBC driver
• VB/MySQL.com (including VB Without Data Binding; A Better Way By Robert Rowe)
• Updates from Microsoft for VB5
• Thirteen ways to loathe VB (and its aftermath)
• Visual Fred ("Following are the bullets you will not see on the side of the box or the marketeer's glossy.")
• AllAPI
• Connection Strings
• Visual Studio Magazine (lots of tips)
• Offering the new VB6 string functions in VB5
• Desaware's VersionStamper: Solving the Installation Problem
• Step by Step COM Tutorial by Saurabh Dasgupta
• Rebasing Win32 DLLs: The Whole Story
• Component Base Addresses
• Step-by-step "howto" lessons ("Creating .DLL's", "Creating .OCX's", etc.)
• Process Viewer  for Windows (displays detailed information about processes running under Windows. For each process it displays memory, threads and module usage. For each DLL  it shows full path and version information.)
• Leverage COM Through the Registry by Francesco Balena
• Visual Basic Tutorial by James Laferriere
• Calendar widgets
• Lebans Holdings MonthCalendar
• CCRP Date/Time Picker
• DameWare Cal32 OCX
• NeoCalendarIII
• DBi Calendar Tools
• DBi Solutions::Schedule 7.0
• DBi Solutions::PIM Professional 3.0
• Threaded xFtp - Free, general-purpose, high-speed, and high quality, 32 bit Ftp client ActiveX control for Windows 95/98 (25 July 2000)
• Jaz Lichy's Visual Basic Tips
• Tabbed Dialog Control (TBGDialogCTL)
• VBVision - Code Samples, Tips, Tricks and other Neat Stuff for the VB developer
• Download missing DLL's from DLL-Files.com
• API Viewer
• Component Checker: Diagnose Problems and Reconfigure MDAC Installations
• Visual Basic Coding Standards by Phil Fresle
• Printer Object - A Primer
• Fifty Ways to Improve Your Visual Basic Programs by J. P. Hamilton
• The End of DLL Hell by Rick Anderson

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