VB How To:

ainwood

ainwood

Consultant.
Administrator
Moderator
Joined
Oct 5, 2001
Messages
30,080
The aim of this thread is to include code demonstrating "how to" do various things in VB (or VBA at a stretch). People who know how to program in VB, please contribute (code snippets and pointing out bugs. When pointing out bugs, please do it via PM).

I suggest that short code snippets be posted as text, longer ones posted as attachments.

If anyone has any "how do I ...." type questions, please post them.


And as a starter:


How do I time how long it takes to run code?

There are two (easy) methods. Firstly, you can use the VB "Timer" function.

Dim sgl_StartTime as single
Dim sgl_EndTime as single

sgl_StartTime = Timer

'------------------------------
'Code to time goes here
'------------------------------

sgl_EndTime = Timer

msgbox "Time taken = " & sgl_EndTime - sgl_StartTime & " Seconds."




This will only give you resolution to the nearest second, which is often not that useful for code optimisation. A "better" method is to use a Windows timer function. You will need to declare this function to use it:

Public Declare Function timeGetTime Lib "winmm.dll" () As Long

Dim lng_StartTime as Long
Dim lng_EndTime as Long

lng_StartTime = TimeGetTime

'------------------------------
'Code to time goes here
'------------------------------

lng_EndTime = TimeGetTime

msgbox "Time taken = " & lng_EndTime - lng_StartTime & " milliseconds."
Click to expand...
This code will (usually) give you millisecond resultion (you can actually interrogate windows to find the actual resolution, but that can be the subject of further code!
 
As a moderate VB programmer....I'm happy to contribute. :D

Here are some VERY simple examples: (Most of my other advanced code is from help from other sources. ;))

How To Make a Command Button Enabled ONLY it there is text present in a text box.

Instructions:
Create a text box called Text1, and a Command Button called Command1.

Properties:
Set Command1 Enabled to False
Code: 
Private Sub Text1_Change()
If Text1.Text = "" Then
 Command1.Enabled = False
Else:
 Command1.Enabled = True
End If
End Sub

How To Create Blinking Text/Controls.

Instructions:
Create a Label called Label1. Create a Timer called Timer1.

Properties:
Set Timer1 Interval to 1000 (That is a blink every second or whatever interval you want)

Code: 
If Label1.Caption = "" Then
Label1.Caption = "Welcome To My Blink Program!"
ElseIf Label1.Caption = "Welcome To My Blink Program!" Then
Label1.Caption = ""
End If

Note....This will make the text on the label blink.
To make the entire label blink:
Code: 
If Label1.Visible = True Then
Label1.Visible = False
ElseIf Label1.Visible = False Then
Label1.Visible = True
End If


I'm also working on a scrolling text control....but that is much more complicated that I thought. :(
 
To highlight all the text within a textbox when the user clicks on it or tabs to it.


Code: 
Put a textbox called "TextBox1" on a form.  Put the following code
in the forms' private module:

Sub TextBox1_GotFocus()

   With TextBox1
      .SelStart = 0
      .SelLength = Len(.Text)
   End With

End Sub

This won't work in VBA, as MSForms Textbox's don't appear to have a GotFocus event.

Instead, you will have to put code the code in for both the "mousedown" event (to capture when the user clicks on the box) and the "Enter" event (to capture the user tabbing to the box).

Code: 
Private Sub TextBox1_Click()
   With TextBox1
      .SelStart = 0
      .SelLength = Len(.Text)
   End With

End Sub


Private Sub TextBox1_MouseDown(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    With TextBox1
      .SelStart = 0
      .SelLength = Len(.Text)
   End With
End Sub
 
How to: Check whether a file exists.

The most common way to do this is with the built-in VB DIR() function. This function returns the name of the file at a specific path, and you then need to check the returned string to see if it what you wanted.

Using the windows API, it is easy to set up a function to simply return a boolean indicating whether a file exists or not:

Code: 
Public Const INVALID_HANDLE_VALUE = -1
Public Const MAX_PATH = 260

Public Type FILETIME
   dwLowDateTime As Long
   dwHighDateTime As Long
End Type

Public Type WIN32_FIND_DATA
   dwFileAttributes As Long
   ftCreationTime As FILETIME
   ftLastAccessTime As FILETIME
   ftLastWriteTime As FILETIME
   nFileSizeHigh As Long
   nFileSizeLow As Long
   dwReserved0 As Long
   dwReserved1 As Long
   cFileName As String * MAX_PATH
   cAlternate As String * 14
End Type

Public Declare Function FindFirstFile Lib "kernel32" _
Alias "FindFirstFileA"  (ByVal lpFileName As String, _
lpFindFileData As WIN32_FIND_DATA) As Long

Public Declare Function FindClose Lib "kernel32" _
(ByVal hFindFile As Long) As Long


Public Function FileExists(strFileName As String) As Boolean

   Dim WFD As WIN32_FIND_DATA
   Dim API_ReturnHandle As Long
   
   API_ReturnHandle = FindFirstFile(strFileName, WFD)

    If API_ReturnHandle <> INVALID_HANDLE_VALUE then
	FileExists = True
    Else
            FileExists = False
    End If 

   Call FindClose(API_ReturnHandle)
   
End Function

Note that in this example, the String variable passed should be the full filename and path of the file you are checking.

Once you have included this code in a .bas file somewhere, the function can then be easily called:

eg. boolCheck = FileExists("C:\Windows\Win.Ini")
 
Whoa....whoa...whoa....

There is a much simpler way to check if a file or folder exists!

Code: 
Set fso = CreateObject("Scripting.FileSystemObject") 
If fso.FolderExists("C:\cesplaylists\") Then 
 Msgbox "Folder Exists.", vbinformation, "Folder Exists"
else
 Msgbox "Folder Does Not Exist.", vbcritical, "Folder Does Not Exist"
End if

To do it with a file instead of a folder:

Code: 
Set fso = CreateObject("Scripting.FileSystemObject") 
If fso.FileExists("C:\cesplaylists\playlist.lst") Then 
 Msgbox "File Exists.", vbinformation, "File Exists"
else
 Msgbox "File Does Not Exist.", vbcritical, "File Does Not Exist"
End if
 
How to: Retrieve the user's name.

If you want to get the name of the logged-in user, it can be done quite easily. Again, you have to call a function from the windows API, so you need to decalre it first.

Code: 
Public Declare Function GetUserName Lib "advapi32.dll" _
    Alias "GetUserNameA" _
    (ByVal lpBuffer As String, _
    nSize As Long) As Long

Public Function ReturnUserName() As String
Dim strName As String
    strName = Space$(512)
    GetUserName strName, Len(strName)
    ReturnUserName = Trim$(strName)
End Function

When you want to get the user's name, just call the "ReturnUserName" function, and it will return it to s tring variable.
 
This code is an algorithm for a "QuickSort". It allows a (one-dimensional) array of values to be passed to it, and it will return the values in sorted order, from smallest to largest.

Code: 
[COLOR=blue]Public Function[/COLOR] QuickSort(InputArray [COLOR=blue]As Variant[/COLOR], _
        [COLOR=blue]Optional[/COLOR] iLowBound [COLOR=blue]As Variant[/COLOR], [COLOR=blue]Optional[/COLOR] iUpBound [COLOR=blue]As Variant[/COLOR])
    [color=green]'The Optional parameters are needed, because the recursive part of the function
    'passes different lower and upper bounds to use for the sorting process.  Note that
    'the IsMissing function only works for variant data types!
    
    
    'Declare variables to hold the lower and upper bounds of the array
    'to be sorted.[/color]
    [color=blue]Dim[/color] iLowerBound [color=blue]As Integer[/color]
    [color=blue]Dim[/color] iUpperBound [color=blue]As Integer[/color]     
     
    [color=green]'Check whether the lower and upper bounds have been passed.
    'If so, store them in the declared variables.  If no, set them
    'to the actual upper and lower bounds of the array.[/color]
    [color=blue]If IsMissing([/color]iLowBound[color=blue]) Then[/color]
        iLowerBound = [color=blue]LBound([/color]InputArray[color=blue])
    Else[/color]
        iLowerBound = iLowBound
    [color=blue]End If
    
    If IsMissing([/color]iUpBound[color=blue]) Then[/color]
        iUpperBound = [color=blue]UBound([/color]InputArray[color=blue])
    Else[/color]
        iUpperBound = iUpBound
    [color=blue]End If[/color]
    
    [color=green]'Declare variables to hold actual array values for sorting[/color]
    [color=blue]Dim[/color] X [color=blue]As Double
    Dim[/color] Y [color=blue]As Double[/color]
    
    [color=green]'Declare variables to hold the current array elements to check.[/color]
    [color=blue]Dim[/color] iLower [color=blue]As Integer
    Dim[/color] iUpper [color=blue]As Integer[/color]
    
    [color=green]'Set the variables to start from the lower and upper bounds
    'respectively.[/color]
    iLower = iLowerBound
    iUpper = iUpperBound
    
    [color=green]'Set the initial array value to sort as the middle value.[/color]
    X = InputArray((iLowerBound + iUpperBound) / 2)
  
    [color=green]'Now start the algorithm.  Iterate until the lower array index
    'being checked is equal to the upper.[/color]
    [color=blue]While[/color] (iLower <= iUpper)
  
        [color=green]'Find the first value greater than X (the middle value),
        'starting at the beginning of the array.[/color]
        [color=blue]While[/color] (InputArray(iLower) < X And iLower < iUpperBound)
            iLower = iLower + 1
[color=blue]        Wend[/color]
    
        [color=green]'Find the first value less than X (the middle value),
        'starting at the end of the array.[/color]
        [color=blue]While[/color] (X < InputArray(iUpper) [color=blue]And[/color] iUpper > iLowerBound)
            iUpper = iUpper - 1
        [color=blue]Wend[/color]

        [color=green]'Check whether the values are "in order" - ie the larger one
        'is later in the array than the smaller one.  If not, swap them.[/color]
        [color=blue]If[/color] (iLower <= iUpper) [color=blue]Then[/color]
        
            [color=green]'Store the larger value[/color]
            Y = InputArray(iLower)
            [color=green]'Write the smaller one on top of the larger one.[/color]
            InputArray(iLower) = InputArray(iUpper)
            
            [color=green]'Put the larger value where the smaller one was.[/color]
            InputArray(iUpper) = Y
            
            [color=green]'A swap has been made.  The following allows the Wend loop
            'to exit, if the middle two values were swapped, and carry
            'on if any other values were swapped.[/color]
            iLower = iLower + 1
            iUpper = iUpper - 1
            
        [color=blue]End If
  
    Wend[/color]
    
    [color=green]'This function must be iterated again, as all that has been done on the
    'first run-through is to compare values with the middle value.  You
    'therefore have to iterate again.  This requires you to iterate with the
    '"unsorted" parts of the array.[/color]
    [color=blue]If[/color] (iLowerBound < iUpper) [color=blue]Then[/color] QuickSort InputArray, iLowerBound, iUpper
    [color=blue]If[/color] (iLower < iUpperBound) [color=blue]Then[/color] QuickSort InputArray, iLower, iUpperBound

[color=blue]End Function[/color]



[color=blue]Sub[/color] TestIt()
[color=green]'This code allows the user to test the above algorithm.[/color]
[color=blue]Dim[/color] aAnArray(25) [color=blue]As Double[/color]
[color=blue]Dim[/color] i [color=blue]As Integer[/color]
[color=blue]For[/color] i = 1 To 25
    aAnArray(i) = (Rnd() * 10) + 1
[color=blue]Next[/color] i

[color=blue]For[/color] i = 1 [color=blue]To[/color] 25
    [color=blue]Debug.Print[/color] aAnArray(i)
[color=blue]Next[/color] i

[color=blue]Debug.Print[/color] "--------------------------------------------"

[color=blue]Call[/color] QuickSort(aAnArray)

[color=blue]For[/color] i = 1 [color=blue]To[/color] 25
    [color=blue]Debug.Print[/color] aAnArray(i)
[color=blue]Next[/color] i
[color=blue]End Sub[/color]
 
Here is a question for you. :)

Actually....two.

1) How can I delete the first letter of a textbox (or variable) and record that letter to a variable.

2) How can I make two web browser controls "mirror" each other. This means that when you go somewhere in one....it automatically displays it in the other too.

:)
 
Originally posted by CornMaster
Here is a question for you. :)

Actually....two.

1) How can I delete the first letter of a textbox (or variable) and record that letter to a variable.
Click to expand...

This is one that I can do! You can use the "left", "right" and "len" functions.

Code: 
[color=blue]Dim[/color] sTextString [color=blue]As String
Dim[/color] sFirstLetter [color=blue]As String[/color]

[color=green]'Get text from textbox.[/color]
sTextstring = txtText1.text

[color=green]'Extract first letter.[/color]
sFirstLetter = left(sTextString,1)

[color=green]'Now delete the first letter from the original text string.[/color]
sTextString = Right(sTextString, Len(sTextString) - 1)
:)



Originally posted by CornMaster
2) How can I make two web browser controls "mirror" each other. This means that when you go somewhere in one....it automatically displays it in the other too.

:)
Click to expand...
:confused: Beats me! I've never worked with web browser controls. Maybe someone else browsing here can help?

The only thing I can think of is whether there is some form of _Change event that you can use in one to drive the other.

eg - something of the form:

Code: 
[color=blue]Private Sub[/color] WebBrowser1_change()
    WebBrowser2.WebAddress = webBrowser1.WebAddress
[color=blue]End Sub[/color]
 
This post I will be appending to occasionally. The idea is to list some little idiosyncracies of VB, and show how to work around them.


1. Overflow in multiplication.
The following code will generate an overflow error:

Code: 
[color=blue]Sub[/color] MultiplyIt()
[color=blue]Dim[/color] lngProduct [color=blue] As Long[/color]

lngProduct = 24 * 3600
msgbox lngProduct
[color=blue]End Sub[/color]

Why does this happen? A long variable type can store any integer value between -2,147,483,648 and 2,147,483,647. The product here is only 86400, so it should be able to be stored in the lngProduct variable, right?

The problem is that VB will calculate the product, store it in a temporary variable, then assign "lngProduct" to be equal to that temporary variable. This is where the problem lies: VB looks at the data types being multiplied, and sees that they are both of "integer" data type. It therefore creates the temporary variable of integer type to hold the result of the multiplication. Because an integer data type can only hold values from -32,768 to 32,767, the product is too large for the temporary variable, and the overflow is generated.

So how do you get around this? All you need to do is force VB to create the temporary varible as a "long". This can be done by "declaring" the value of "24" and the value of "3600" to be of Long type. To do this, just append an ampersand to the numbers:

Code: 
[color=blue]Sub[/color] MultiplyIt()
[color=blue]Dim[/color] lngProduct [color=blue] As Long[/color]

lngProduct = 24& * 3600&
msgbox lngProduct
[color=blue]End Sub[/color]

The amersand tells VB that it is multiplying two "long" numbers, rather than two integers, so it creates the correct temporary variable.
 
A short one this time: How to change the desktop wallpaper via code:

Code: 
[color=blue]Private Declare Function[/color] SystemParametersInfo [color=blue]Lib[/color] "user32" [color=blue]Alias[/color] "SystemParametersInfoA" _
    ([color=blue]ByVal uAction [color=blue]As Long, _
    ByVal[/color]  uParam [color=blue]As Long, _
    ByVal[/color]  lpvparam [color=blue]As String, _
    ByVal[/color]  fuWinIni [color=blue]As Long) As Long
    
Const[/color]  SPIF_Updateinifile = &H1
[color=blue]Const[/color]  spi_SetDeskWallpaper = 20
[color=blue]Const[/color]  spif_SendWinIniChange = &H2


[color=blue]Sub[/color]  ChangeTheWallPaper()
[color=blue]Dim[/color]  L
L = SystemParametersInfo(spi_SetDeskWallpaper, 0&, "c:\apps\gi desktop.bmp", SPIF_Updateinifile Or spif_SendWinIniChange)

[color=blue]End Sub[/color]

Simply change the "c:\apps\gi desktop.bmp" to the appropriate pathname of the new wallpapaer. :)
 
This is a cool thread. I don't post much to it because I don't do a lot of VB programming (or really much of any programing) at the moment. But it is very good to read!!!!
 
In a VB function, you can declare an argument to be “optional”. This can be very useful for such things as letting the user supply an initial estimate.
When using an “Optional” variable, you can use the IsMissing function to determine whether or not the user has actually specified the optional value or not.

However, one problem with VB is that this IsMissing function only works for Variant data types. For any other data type, it automatically returns “False” for the IsMissing call.


For Example:

Code: 
[color=blue]Function[/color] Check([color=blue]Optional[/color]  sDefaultString [color=blue]As String[/color])
[color=blue]If IsMissing[/color] (sDefaultString) [color=blue]Then[/color]
    sDefaultString = "Hello"
[color=blue]End If

Debug.Print[/color] sDefaultString

[color=blue]End Function[/color]


[color=blue]Sub[/color] CallIt()
    [color=blue]Call[/color] Check
[color=green]'   Call Check("Goodbye")[/color]
[color=blue]End Sub[/color]

The code above has the Optional argument specified as a string. If the above code is run with the first line commented-out, it will result in “goodbye” being written to the debug window (as expected). However, if the second line is commented out (as shown above), then an empty string will be written to the debug window instead – the IsMissing call will go to the “false” case, even though the optional parameter has not been passed.

This can be “solved” in two ways. Firstly, the optional parameter can be specified as a Variant data type (declare it as variant, or don’t specify the data tyep – it will default to variant).

The other (more elegant) option is to specify the default value in the declaration line:

Code: 
[color=blue]Function[/color] Check([color=blue]Optional[/color]  sDefaultString [color=blue]As String[/color] = “Hello”)
    [color=blue]Debug.Print[/color] sDefaultString
[color=blue]End Function[/color]


The whole "IsMissing" funciton is a bit of a hang-over from earlier versions of visual basic, where optional parameters could not have default values, and had to be variant data types anyway. It is probably "better" not to use IsMissing, but if you do, the above is an issue that you should be aware of. ;)
 
Cool thread...this is all above my head as I have just started learning VB (haven't really learned much besides how to operate the program itself....but I will get there someday). Got some really basic stuff to help guys like me out or would that be better handled in a different thread?
 
You are probably all aware of the Macro virus protection built-in to M$ Office products. If you try and open a document with Macros, you are presented with the little dialog asking you if you want to enable or disable them, or not open the document at all.

What you may not realise, is that this macro protection only appears to work when the document is opened by double-clicking on it, or via the file / open procedure from the main application. This macro protection is circumvented if you open a file via OLE.

For example: Create a word document called “C:\Virus.doc”. In a code module for this document, add the following code:
Code: 
[color=blue]Private Sub[/color] Document_Open()
    MsgBox "Bingo!"
[color=blue]End Sub[/color]

In a VB application (or even Excel for example), put the following code:
Code: 
[color=blue]Sub openword()[/color]
[color=blue]Dim oWordDoc [color=blue]As Object
Set[/color] oWordDoc = CreateObject("word.application")
oWordDoc.Visible = [color=blue]True[/color]
oWordDoc.documents.Open ("C:\virus.doc")
[color=blue]End Sub[/color]

When you run this code, you will see that the code quite happily opens the document and triggers the Document_Open macro.

This behaviour appears to exist with both Office ’97 and Office 2000.
 
The following code will allow you to check whether a number provided is a valid credit-card number. Note that it will not tell you whether the expiry date matches or not, but it may be useful for a first check.

This function returns a simple “true” if the number is valid as a credit card number, or “false” if it is not. Note that that number must be passed to the function as a string.

Code: 
[color=blue]Private Function[/color] IsValid(strCardNumber [color=blue]As String[/color]) [color=blue]As Boolean

Dim[/color] iCharPos [color=blue]As Integer
Dim[/color] iCheckSum [color=blue]As Integer
Dim[/color] strCharCheck [color=blue]As String


For[/color] iCharPos = Len(strCardNumber) [color=blue]To[/color] 2 [color=blue]Step[/color] -2
    iCheckSum = iCheckSum + [color=blue]CInt[/color] (Mid(strCardNumber, iCharPos, 1))
    strCharCheck = [color=blue]CStr[/color] ((Mid(strCardNumber, iCharPos - 1, 1)) * 2)
    iCheckSum = iCheckSum + [color=blue]CInt[/color] (Left(strCharCheck, 1))
    
    [color=blue]If[/color] Len(strCharCheck) > 1 [color=blue]Then[/color] 
        iCheckSum = iCheckSum + CInt(Right(strCharCheck, 1))
    [color=blue]End If[/color]
[color=blue]Next[/color] iCharPos


[color=blue]If[/color] Len(strCardNumber) [color=blue]Mod[/color] 2 = 1 [color=blue]Then[/color] 
    iCheckSum = iCheckSum + [color=blue]CInt[/color] (Left(strCardNumber, 1))
[color=blue]End If[/color]

[color=blue]If[/color] iCheckSum [color=blue]Mod[/color] 10 = 0 [color=blue]Then[/color]
    IsValid = [color=blue]True
Else[/color]
    IsValid = [color=blue]False
End If

End Function[/color]




P.S. PH - A "Basics" thread is a good idea. I may try and start one later in the week / next week. :)
 
If you have an array of values, and you want to set them all to zero, a lot of people simply loop through each item of the array, and set it to zero.

There is a much easier way of achieving the same thing, using the Erase Function.

Code: 
[color=blue]Sub[/color] EraseArray()
[color=blue]Dim[/color] aTestArray(1000) [color=blue]As Long
Dim[/color] i [color=blue]As[/color] Integer

'Fill array with values
[color=blue]For[/color] i = 0 [color=blue]To[/color] 100
    aTestArray(i) = i
[color=blue]Next[/color] i

[color=green]'Now erase it. [/color]
[color=blue]Erase[/color] aTestArray

[color=green]'Check that values are all "0"[/color]
[color=blue]For[/color] i = 0 [color=blue]To[/color] 100
    [color=blue]Debug.Print[/color] aTestArray(i)
[color=blue]Next[/color] i

[color=blue]End Sub[/color]

If your array is a dynamic one, you can clear it by the Erase method, or by redimensioning it.
Code: 
[color=blue]Sub[/color] EraseArray()
[color=blue]Dim[/color] aTestArray() [color=blue]As Long
[color=blue]Redim[/color] aTestArray(100) [color=blue]As Long
Dim[/color] i [color=blue]As[/color] Integer

'Fill array with values
[color=blue]For[/color] i = 0 [color=blue]To[/color] 100
    aTestArray(i) = i
[color=blue]Next[/color] i

[color=green]'Now erase it. [/color]
[color=blue]ReDim[/color] aTestArray(100)

[color=green]'Check that values are all "0"[/color]
[color=blue]For[/color] i = 0 [color=blue]To[/color] 100
    [color=blue]Debug.Print[/color] aTestArray(i)
[color=blue]Next[/color] i

[color=blue]End Sub[/color]


I recently came across an interesting method for clearing out a block of array values. Say you have an array of 10,000 values, and you want to set the values from 8000 to 9000 to zero, you can do this by directly setting the values in memory to zero.


Code: 
[Color=blue]Private Declare Sub[/color] ZeroMemory [Color=blue]Lib[/color] "kernel32" [Color=blue]Alias[/color] "RtlZeroMemory" _
(Destination [Color=blue]As Any, ByVal [/color]Length [Color=blue]As Long[/color])



[color=blue]Function[/color] ClearArray()
[color=blue]Dim[/color] i [color=blue]As Integer[/color]
[color=green]' Declare an array and fill it with data[/color]
[color=blue]Dim[/color] aTestArray(10000) [color=blue]As Long
For[/color] i = 0 [color=blue]To UBound[/color] (aTestArray)
    aTestArray(i) = i
[color=blue]Next[/color] i

[color=green]'Clear the elements from 8000 to 9000 (1001 elements) to zero[/color]
ZeroMemory aTestArray(8000), 1001 * [color=blue]Len[/color] (aTestArray(0))

[color=green]'Check a couple of elements:[/color]
[color=blue]For[/color] i = 7998 [color=blue]To[/color] 8002
   [color=blue] Debug.Print[/color] "Item " & i & " = " & aTestArray(i)
[color=blue]Next[/color] i
[color=blue]For[/color] i = 8998 [color=blue]To[/color] 9002
    [color=blue]Debug.Print[/color] "Item " & i & " = " & aTestArray(i)
[color=blue]Next[/color] i

[color=blue]End Function[/color]


Note: This function requires that the amount of memory allocated to each array element is constant. Therefore, it will not work with variant arryas that contain variable-length strings, nor with string arrays with variable-length strings. In both cases, it will case a General Protection Fault - Save your project before you run it!

Note that it works on the amount of memory allocated to each array item, not what the actual array contains. Long, single, integer, double etc are all allocated a fixed amount of memory, regardless of what they contain. Ie – in a long array, the element storing the value “3” is allocated the same amount of memory as the element containing the value “28569”.
 
Some code requires specific version of windows (especially ones looking for specific registry keys for example). The following code will return a string variable telling you which version of windows the code is being run on. :)

Code: 
[color=blue]Public Declare Function[/color] GetVersionExA [color=blue]Lib[/color] "kernel32" _
(lpVersionInformation [color=blue]As[/color] OSVERSIONINFO) [color=blue]As Integer


Public Type[/color] OSVERSIONINFO
            dwOSVersionInfoSize [color=blue]As Long[/color]
            dwMajorVersion [color=blue]As Long[/color]
            dwMinorVersion [color=blue]As Long[/color]
            dwBuildNumber [color=blue]As Long[/color]
            dwPlatformId [color=blue]As Long[/color]
            szCSDVersion [color=blue]As String[/color] * 128
[color=blue]End Type

Function[/color] GetOS() [color=blue]As String
[color=blue]Dim[/color] osVer [color=blue]As[/color] OSVERSIONINFO
osVer.dwOSVersionInfoSize = Len(osVer)

[color=blue]Dim[/color] lngAPIReturn [color=blue]As Long[/color]
lngAPIReturn = GetVersionExA(osVer)

[color=blue]If[/color] lngAPIReturn = 0 [color=blue]Then[/color]
    [color=green]'Call failed[/color]
    [color=blue]Debug.Print[/color] "Failed API call."
    [color=blue]Exit Function
End If

Dim[/color] strOS [color=blue]As String

Select Case[/color] osVer.dwPlatformId
    [color=blue]Case[/color] 1
        [color=blue]Select Case[/color] osVer.dwMinorVersion
            [color=blue]Case[/color] 0
                strOS = "Win95"
            [color=blue]Case[/color] 10
                strOS = "Win98"
            [color=blue]Case[/color] 90
                strOS = "Win ME"
        [color=blue]End Select
    Case[/color] 2
        [color=blue]Select Case[/color] osVer.dwMajorVersion
            [color=blue]Case[/color] 3
                strOS = "WinNT 3.51"
            [color=blue]Case[/color] 4
                strOS = "WinNT 4.0"
            [color=blue]Case[/color] 5
                [color=blue]Select Case[/color] osVer.dwMinorVersion
                    [color=blue]Case[/color] 0
                        strOS = "Windows 2000"
                    [color=blue]Case[/color] 1
                        strOS = "Windows XP"
                [color=blue]End Select
        End Select
End Select[/color]

strOS = strOS & ", " & osVer.szCSDVersion

GetOS = strOS

[color=blue]End Function[/color]
 
You must log in or register to reply here.

Similar threads

B
How to Get Current Celebration Bonus
Replies
0
Views
783
BobobUnicorn
B
yepzer
[BNW] A new mod with timed wonders
Replies
1
Views
501
yepzer
yepzer
Ja Mes
[BNW] Modding World Congress Votes/Proposals/Resolutions
Replies
0
Views
102
Ja Mes
Ja Mes
rahorvat
How to edit the Civilopedia files (BLURB?.TXT)
Replies
0
Views
285
rahorvat
rahorvat
FredLC
How to divide a quote in multiple parts in current CFC?
Replies
1
Views
670
FredLC
FredLC
Back
Top Bottom