Why Use COM?
First of all, why on earth would we want to use a class module or its logical extension, a compiled COM dll or exe? I'm sure at least one of you all is asking that question. I've been steeped in MS doctrine for so many years I don't even question that I will use COM, but for someone who is new to this all, I'd hazard big "whys?" are floating around.
Let's say you've been asked to write a utility application that will provide basic Operating System information, such as platform, major and minor versions, service packs, etc. You know this is possible to do because, hey, VB has a form template for doing that, but it just calls some executable that brings up a window with far more information than your client needs. A search through the Appleman book on the Win32 API gives you the Windows function you need to call, GetVersionExA. So, you're ready to write your utility. You create a form with a text box (txtSystemInfo) and a command button (cmdSystemInfo) and the code probably looks something like this:
Option Explicit
Private Declare Function GetVersionEx Lib "kernel32" _
Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFOEX) _
As Long
Private Type OSVERSIONINFOEX
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
wServicePackMajor As Integer
wServicePackMinor As Integer
wSuiteMask As Integer
wProductType As Byte
wReserved As Byte
End Type
' used for dwPlatformId
Private Const VER_PLATFORM_WIN32s = 0
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32_NT = 2
' used for wSuiteMask
Private Const VER_SUITE_BACKOFFICE = 4
Private Const VER_SUITE_DATACENTER = 128
Private Const VER_SUITE_ENTERPRISE = 2
Private Const VER_SUITE_SMALLBUSINESS = 1
Private Const VER_SUITE_SMALLBUSINESS_RESTRICTED = 32
Private Const VER_SUITE_TERMINAL = 16
' used for wProductType
Private Const VER_NT_WORKSTATION = 1
Private Const VER_NT_DOMAIN_CONTROLLER = 2
Private Const VER_NT_SERVER = 3
Private strSystemInfo As String
Private Function GetSystemInfo() As Boolean
Dim osvi As OSVERSIONINFOEX
Dim lngReturn As Long
Dim intNullPos As Integer
Dim colProdSuites As Collection
Dim varCurrProdSuite As Variant
With osvi
' define the size of the structure
.dwOSVersionInfoSize = Len(osvi)
' pad the szCSDVersion variable with spaces
.szCSDVersion = Space$(128)
' call GetVersionEx
lngReturn = GetVersionEx(osvi)
If lngReturn = 0 Then
MsgBox "Error calling GetVersionEx"
GetSystemInfo = False
Exit Function
End If
' parse the osvi structure
' major version
strSystemInfo = "Major Version: " & Str(.dwMajorVersion) & vbCrLf
' minor version
strSystemInfo = strSystemInfo + "Minor Version: " & Str(.dwMinorVersion) & vbCrLf
' build number
strSystemInfo = strSystemInfo + "Build Number: " & Str(.dwBuildNumber) & vbCrLf
' platform ID
strSystemInfo = strSystemInfo + "Platform: "
Select Case .dwPlatformId
Case VER_PLATFORM_WIN32s
strSystemInfo = strSystemInfo & "Win32s on Windows 3.1" & vbCrLf
Case VER_PLATFORM_WIN32_WINDOWS
strSystemInfo = strSystemInfo & _
IIf(.dwBuildNumber = 0, "Windows 98", "Windows 95") _
& vbCrLf
Case VER_PLATFORM_WIN32_NT
strSystemInfo = strSystemInfo & _
IIf(.dwMajorVersion < 5, "Windows NT", "Windows 2000") _
& vbCrLf
End Select
' service pack
Select Case .dwPlatformId
Case VER_PLATFORM_WIN32s
strSystemInfo = strSystemInfo & _
"No additional info in on Win32s on Windows 3.1." _
& vbCrLf
Case VER_PLATFORM_WIN32_WINDOWS
strSystemInfo = strSystemInfo & "Additional OS Info: " & _
.szCSDVersion & vbCrLf
Case VER_PLATFORM_WIN32_NT
If Asc(Left$(.szCSDVersion, 1)) = 0 Then
' leftmost char = null, this is an empty string
strSystemInfo = strSystemInfo & _
"Service Pack Install Info: No Service Pack Installed" _
& vbCrLf
Else
' find the null char in the string
intNullPos = InStr(.szCSDVersion, Chr(0))
strSystemInfo = strSystemInfo & "Service Pack Install Info: " & _
Left$(.szCSDVersion, intNullPos - 1) & _
vbCrLf
End If
End Select
' service pack version
strSystemInfo = strSystemInfo & "Service Pack Version: "
strSystemInfo = strSystemInfo & CStr(.wServicePackMajor) & "." & _
CStr(.wServicePackMinor) & vbCrLf
' product suite components
' This this value is a set of bit flags. Test against each
' bit mask, add found items to a VB collection
Set colProdSuites = New Collection
If (.wSuiteMask And VER_SUITE_BACKOFFICE) = VER_SUITE_BACKOFFICE Then
colProdSuites.Add "Microsoft BackOffice components are installed."
End If
If (.wSuiteMask And VER_SUITE_DATACENTER) = VER_SUITE_DATACENTER Then
colProdSuites.Add "Windows 2000 Datacenter Server is installed."
End If
If (.wSuiteMask And VER_SUITE_ENTERPRISE) = VER_SUITE_ENTERPRISE Then
colProdSuites.Add "Windows 2000 Advanced Server is installed."
End If
If (.wSuiteMask And VER_SUITE_SMALLBUSINESS) = VER_SUITE_SMALLBUSINESS Then
colProdSuites.Add "Microsoft Small Business Server is installed."
End If
If (.wSuiteMask And VER_SUITE_SMALLBUSINESS_RESTRICTED) = _
VER_SUITE_SMALLBUSINESS_RESTRICTED Then
colProdSuites.Add "Microsoft Small Business Server is installed " & _
"with the restrictive client license in force."
End If
If (.wSuiteMask And VER_SUITE_TERMINAL) = VER_SUITE_TERMINAL Then
colProdSuites.Add "Terminal Services is installed."
End If
' list all product suites available
' that were added to the collection object
strSystemInfo = strSystemInfo & "Product Suites: " & vbCrLf
For Each varCurrProdSuite In colProdSuites
strSystemInfo = strSystemInfo & vbCrLf & vbTab & varCurrProdSuite
Next
' product type
strSystemInfo = strSystemInfo & "ProductType: "
Select Case .wProductType
Case VER_NT_WORKSTATION
strSystemInfo = strSystemInfo & "Windows 2000 Professional"
Case VER_NT_DOMAIN_CONTROLLER
strSystemInfo = strSystemInfo & "Windows 2000 domain controller"
Case VER_NT_SERVER
strSystemInfo = strSystemInfo & "Windows 2000 Server"
End Select
End With
GetSystemInfo = True
End Function
Private Sub cmdSystemInfo_Click()
Dim blnResult As Boolean
blnResult = GetSystemInfo()
If blnResult = True Then
txtSystemInfo = strSystemInfo
Else
txtSystemInfo = "Nothing to return at this time"
End If
End Sub
You test it and it runs just great. Package it up and distribute away. Right? Well...maybe...
The client emails back and says the app works great, but the Sydney office needs a Web-based solution and the Prague office wants to experiment with Windows Scripting Host. Oh, and could you change one little thing with the spacing in the text box?
Then, one of your coworkers - Trevor, the new hire who barely knows how to spell VB - comes to you in a panic because he's been asked to incorporate system info into the company's proprietary email client and could you possibly tell him how it's done?? By lunch time? (It's 11am, incidentally).
OK. Well, for Sydney, create an ActiveX document out of the form - those run on the Web, right? Oh, what was that? The Sydney office uses Netscape only? ActiveX documents only run in IE unless you have the NCompass plugin and wouldn't that be a deployment nightmare? Scratch that idea. Hmmm. Well, you do ASP, too - it will just have to be a server side solution. You change your code to be happy as VBScript, add an HTML front end and give to Sydney. Whew.
Since Prague doesn't have to worry about browser issues you can take your VBScripted ASP code and turn it into a VBScript text file (.vbs - you know, those virus thingees...) for them. Send off the file. There, solved that problem.
Prague calls 15 minutes later - someone accidentally modified the code in the text file and the script doesn't work. No, they don't have a backup and the email the file was attached to got deleted because they just installed a virus checker on the mail server and the attachment registered as a virus. And what about that weird spacing formatting? Can you take care of that?
Sigh. Sure. You make the change and send them a new file, extended as .txt with instructions on how to change the extension. Just when you think it's safe to go back to the vending machine [for your 50th Coca-cola of the morning], your pager goes off. It's Sydney. The processing overhead of the ASP page - all that interpreted code - has forced the servers to a crawl. They've got to take the page offline and when can you fix it? Why they can't just use the form interface, you wonder to yourself. Hi, Trevor, you're looking a bit freaked. Oh, yeah, that thing I was going to show you how to do...sure you need it by lunch? Oh. Well, yeah, if the CEO needs to show it off to the Venture Capitalist group then I guess it can't wait...here, just take my project files and use those - I'll explain later how it works...
11:55am. Hey, Trev - get that app done? It won't compile? Well, it works just fine for me. Let me see what you did... Trevor, please stop the whimpering...
And far above the city, Bruce Wayne sits in his mansion lamenting the chaos...er, oops, wrong story...
Hopefully by this point you can see how one little COM component would have made that morning much easier: a form can call a COM dll, an ASP page (that bothers me - it's like saying ATM Machine or PIN Number, but what else can one do?...) can call a compiled, efficient COM dll, and a Windows Scripting Host routine can call an efficient and protected-from-casual-updating COM dll. And, since all your client's offices are networked together, that COM dll can be in one place - just one file to update the next time someone takes exception to your style of spacing.
Perhaps most important, though, poor Trevor can call a COM dll....
With the processing code moved into the class WhyUseCOM.SystemInfo, Trevor's form code becomes quite simple:
Private mySystemInfo As WhyUseCOM.SystemInfo
Private Sub cmdSystemInfo_Click()
txtSystemInfo = mySystemInfo.TheSystemInfo
End Sub
Private Sub Form_Load()
Set mySystemInfo = New WhyUseCOM.SystemInfo
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set mySystemInfo = Nothing
End SubHere's the code for the class module SystemInfo, in the ActiveX DLL project WhyUseCOM:
Option Explicit
Private Declare Function GetVersionEx Lib "kernel32" _
Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFOEX) _
As Long
Private Type OSVERSIONINFOEX
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
wServicePackMajor As Integer
wServicePackMinor As Integer
wSuiteMask As Integer
wProductType As Byte
wReserved As Byte
End Type
' used for dwPlatformId
Private Const VER_PLATFORM_WIN32s = 0
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32_NT = 2
' used for wSuiteMask
Private Const VER_SUITE_BACKOFFICE = 4
Private Const VER_SUITE_DATACENTER = 128
Private Const VER_SUITE_ENTERPRISE = 2
Private Const VER_SUITE_SMALLBUSINESS = 1
Private Const VER_SUITE_SMALLBUSINESS_RESTRICTED = 32
Private Const VER_SUITE_TERMINAL = 16
' used for wProductType
Private Const VER_NT_WORKSTATION = 1
Private Const VER_NT_DOMAIN_CONTROLLER = 2
Private Const VER_NT_SERVER = 3
Private strSystemInfo As String
Private Function GetSystemInfo() As Boolean
Dim osvi As OSVERSIONINFOEX
Dim lngReturn As Long
Dim intNullPos As Integer
Dim colProdSuites As Collection
Dim varCurrProdSuite As Variant
With osvi
' define the size of the structure
.dwOSVersionInfoSize = Len(osvi)
' pad the szCSDVersion variable with spaces
.szCSDVersion = Space$(128)
' call GetVersionEx
lngReturn = GetVersionEx(osvi)
If lngReturn = 0 Then
MsgBox "Error calling GetVersionEx"
GetSystemInfo = False
Exit Function
End If
' parse the osvi structure
' major version
strSystemInfo = "Major Version: " & Str(.dwMajorVersion) & vbCrLf
' minor version
strSystemInfo = strSystemInfo + "Minor Version: " & Str(.dwMinorVersion) & vbCrLf
' build number
strSystemInfo = strSystemInfo + "Build Number: " & Str(.dwBuildNumber) & vbCrLf
' platform ID
strSystemInfo = strSystemInfo + "Platform: "
Select Case .dwPlatformId
Case VER_PLATFORM_WIN32s
strSystemInfo = strSystemInfo & "Win32s on Windows 3.1" & vbCrLf
Case VER_PLATFORM_WIN32_WINDOWS
strSystemInfo = strSystemInfo & _
IIf(.dwBuildNumber = 0, "Windows 98", "Windows 95") _
& vbCrLf
Case VER_PLATFORM_WIN32_NT
strSystemInfo = strSystemInfo & _
IIf(.dwMajorVersion < 5, "Windows NT", "Windows 2000") _
& vbCrLf
End Select
' service pack
Select Case .dwPlatformId
Case VER_PLATFORM_WIN32s
strSystemInfo = strSystemInfo & _
"No additional info in on Win32s on Windows 3.1." _
& vbCrLf
Case VER_PLATFORM_WIN32_WINDOWS
strSystemInfo = strSystemInfo & "Additional OS Info: " & _
.szCSDVersion & vbCrLf
Case VER_PLATFORM_WIN32_NT
If Asc(Left$(.szCSDVersion, 1)) = 0 Then
' leftmost char = null, this is an empty string
strSystemInfo = strSystemInfo & _
"Service Pack Install Info: No Service Pack Installed" _
& vbCrLf
Else
' find the null char in the string
intNullPos = InStr(.szCSDVersion, Chr(0))
strSystemInfo = strSystemInfo & "Service Pack Install Info: " & _
Left$(.szCSDVersion, intNullPos - 1) & _
vbCrLf
End If
End Select
' service pack version
strSystemInfo = strSystemInfo & "Service Pack Version: "
strSystemInfo = strSystemInfo & CStr(.wServicePackMajor) & "." & _
CStr(.wServicePackMinor) & vbCrLf
' product suite components
' This this value is a set of bit flags. Test against each
' bit mask, add found items to a VB collection
Set colProdSuites = New Collection
If (.wSuiteMask And VER_SUITE_BACKOFFICE) = VER_SUITE_BACKOFFICE Then
colProdSuites.Add "Microsoft BackOffice components are installed."
End If
If (.wSuiteMask And VER_SUITE_DATACENTER) = VER_SUITE_DATACENTER Then
colProdSuites.Add "Windows 2000 Datacenter Server is installed."
End If
If (.wSuiteMask And VER_SUITE_ENTERPRISE) = VER_SUITE_ENTERPRISE Then
colProdSuites.Add "Windows 2000 Advanced Server is installed."
End If
If (.wSuiteMask And VER_SUITE_SMALLBUSINESS) = VER_SUITE_SMALLBUSINESS Then
colProdSuites.Add "Microsoft Small Business Server is installed."
End If
If (.wSuiteMask And VER_SUITE_SMALLBUSINESS_RESTRICTED) = _
VER_SUITE_SMALLBUSINESS_RESTRICTED Then
colProdSuites.Add "Microsoft Small Business Server is installed " & _
"with the restrictive client license in force."
End If
If (.wSuiteMask And VER_SUITE_TERMINAL) = VER_SUITE_TERMINAL Then
colProdSuites.Add "Terminal Services is installed."
End If
' list all product suites available
' that were added to the collection object
strSystemInfo = strSystemInfo & "Product Suites: " & vbCrLf
For Each varCurrProdSuite In colProdSuites
strSystemInfo = strSystemInfo & vbCrLf & vbTab & varCurrProdSuite
Next
' product type
strSystemInfo = strSystemInfo & "ProductType: "
Select Case .wProductType
Case VER_NT_WORKSTATION
strSystemInfo = strSystemInfo & "Windows 2000 Professional"
Case VER_NT_DOMAIN_CONTROLLER
strSystemInfo = strSystemInfo & "Windows 2000 domain controller"
Case VER_NT_SERVER
strSystemInfo = strSystemInfo & "Windows 2000 Server"
End Select
End With
GetSystemInfo = True
End Function
Public Property Get TheSystemInfo() As String
Dim blnResult As Boolean
blnResult = GetSystemInfo()
If blnResult = True Then
TheSystemInfo = strSystemInfo
Else
TheSystemInfo = "Nothing to return at this time"
End If
End Property
Alrak's Course Resources ©2002-2007 Karla Carter. All rights reserved. This material (including, but not limited to, Mini-lectures and Challenge Labs) may not be reproduced, displayed, modified or distributed without the express prior written permission of the copyright holder. For permission, contact Karla.