中如何将图层导出CAD的DWG格式,急 ( 积分: 50 )

请教高手ARC OBJECT中如何将图层导出成CAD,DWG望答复

请教高手ARC OBJECT中如何将图层导出成CAD,DWG望答复

调用ArcCatalog的接口。GxLayerExport,GxFile

接受答案了.

谢谢回复,能不能给一个调用的例子，未能发现GxLayerExport接口

给你一个VB版的代码，希望对你有帮助

GxInterchangeObject
GxInterchangeObject.cls
Option Explicit

Implements esriCatalog.IGxObject
Implements esriCatalog.IGxObjectUI
Implements esriCatalog.IGxObjectEdit
Implements esriCatalog.IGxObjectProperties
Implements esriGeodatabase.IMetadata
Implements esriGeodatabase.IMetadataEdit

' Type required for GetVersionX API call.
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type

' Win32 API calls to get OS information.
Private Declare Function GetVersionExA Lib "kernel32"
(lpVersionInformation As OSVERSIONINFO) As Integer
Private Declare Function GetComputerName Lib "kernel32"
Alias "GetComputerNameA"
(ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetLocaleInfo Lib "kernel32"
Alias "GetLocaleInfoA"
(ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long

' To get the system lang information
Private Const LOCALE_SISO639LANGNAME As Long = &H59
Private Const LOCALE_USER_DEFAULT = &H400

' To determine running process.
Private Declare Function GetModuleHandle Lib "kernel32"
Alias "GetModuleHandleA"
(ByVal lpModuleName As String) As Long


Private m_pParent As esriCatalog.IGxObject
Private m_pCatalog As esriCatalog.IGxCatalog
Private m_pCtxMenu As esriFramework.ICommandBar
Private m_pFileSystemObject As Object
Private m_pBitmapSmall As IPictureDisp
Private m_pBitmapLarge As IPictureDisp
Private m_sFullName As String
Private m_sName As String
Private m_sBaseName As String
Private m_bExists As Boolean
Private m_bReadOnly As Boolean

' Error Codes
Private Const S_FALSE = &H1
Private Const E_FAIL = &H80004005
Private Const E_INVALIDARG = &H80070057


Private Sub Class_Initialize()
' Set up the file system object and the icons.
Set m_pFileSystemObject = CreateObject("Scripting.FileSystemObject&quot

Set m_pBitmapLarge = LoadResPicture(101, 0)
Set m_pBitmapSmall = LoadResPicture(102, 0)
End Sub

Private Property Get IGxObject_Name() As String
IGxObject_Name = m_sName
End Property

Friend Property Let Name(sName As String)
'do
file name proceessing here since this code executes before attach
' Not required butdo
ne for optimization
If sName <> &quot;&quot;
then

If Not (m_pFileSystemObject Is Nothing) then

If (UCase(m_pFileSystemObject.GetExtensionName(sName)) = &quot;E00&quot then

m_sFullName = sName ' Full name of object
m_sName = m_pFileSystemObject.GetFileName(sName) ' No path with ext
m_sBaseName = m_pFileSystemObject.GetBaseName(sName) ' No path no ext
End If
End If
End If
End Property

Private Property Get IGxObject_FullName() As String
' Full file path with extension.
IGxObject_FullName = m_sFullName
End Property

Private Property Get IGxObject_BaseName() As String
' No file path or extension.
IGxObject_BaseName = m_sBaseName
End Property

Private Property Get IGxObject_Category() As String
' Used Catalog's Contents View.
IGxObject_Category = &quot;Interchange (.e00) File&quot;
End Property

Private Property Get IGxObject_Parent() As esriCatalog.IGxObject
' Parent GxObject.
Set IGxObject_Parent = m_pParent
End Property

Private Property Get IGxObject_ClassID() As esriSystem.IUID
' ClassID of this GxObject.
Dim pUID As New esriSystem.UID
pUID.value = &quot;GxInterchangeVB.GxInterchangeObject&quot;
If Not pUID Is Nothing then

Set IGxObject_ClassID = pUID
End If
End Property

Private Property Get IGxObject_InternalObjectName() As esriSystem.IName
' Note: using IFileName insterad of IName::Namestring
Dim pName As esriSystem.IFileName
Set pName = New esriSystem.FileName
pName.Path = m_sFullName
Set IGxObject_InternalObjectName = pName
End Property

Private Property Get IGxObject_IsValid() As Boolean
If Not (m_pParent Is Nothing) then

If Not (m_pCatalog Is Nothing) then

IGxObject_IsValid = True
End If
End If
End Property

Private Sub IGxObject_Attach(ByVal Parent As esriCatalog.IGxObject, ByVal pCatalog As esriCatalog.IGxCatalog)
' Attaches this GxObject to it's Parent.
Set m_pParent = Parent
Set m_pCatalog = pCatalog
End Sub

Private Sub IGxObject_Detach()
' Detaches the object and cleans up refernces
Set m_pParent = Nothing
Set m_pCatalog = Nothing
End Sub

Private Sub IGxObject_Refresh()
'Not required here since is is no view to refresh with this class.
End Sub

Private Property Get IGxObjectUI_SmallImage() As esriSystem.OLE_HANDLE
' Not used since this sample uses the default icon
IGxObjectUI_SmallImage = m_pBitmapSmall
End Property

Private Property Get IGxObjectUI_SmallSelectedImage() As esriSystem.OLE_HANDLE
' Not used since this sample uses the default icon
IGxObjectUI_SmallSelectedImage = m_pBitmapSmall
End Property

Private Property Get IGxObjectUI_LargeImage() As esriSystem.OLE_HANDLE
' Not used since this sample uses the default icon
IGxObjectUI_LargeImage = m_pBitmapLarge
End Property

Private Property Get IGxObjectUI_LargeSelectedImage() As esriSystem.OLE_HANDLE
' Not used since this sample uses the default icon
IGxObjectUI_LargeSelectedImage = m_pBitmapLarge
End Property

Private Property Get IGxObjectUI_ContextMenu() As esriSystem.IUID
If m_pCtxMenu Is Nothing then

' Check the application we are running in.
Dim lErr As Long, lHandle As Long, sName As String
Dim pApp As esriFramework.IApplication
sName = &quot;ArcCatalog.EXE&quot;
lHandle = GetModuleHandle(sName)
If lHandle <> 0 then

' We're in ArcCatalog and can therefore get the Application.
Set pApp = New esriFramework.AppRef
else

Exit Property
End If

' Find the command bars collection.
Dim pCmdBars As esriFramework.ICommandBars
Set pCmdBars = pApp.Document.CommandBars

' Create a new context menu for this GxObject.
Set m_pCtxMenu = pCmdBars.Create(&quot;InterchangeMenu&quot;, esriSystemUI.esriCmdBarType.esriCmdBarTypeShortcutMenu)

' Add required Menu items to the context menu.
Dim pUID As esriSystem.IUID
Set pUID = New esriSystem.UID
pUID.value = &quot;{C637B93D-0FA5-11D3-9F4F-00C04F6BC69E}&quot;
' CopyMenuItem

Dim pCmdItem As esriFramework.ICommandItem
Set pCmdItem = m_pCtxMenu.Add(pUID)

pUID.value = &quot;{25C0E6C1-CD06-11D2-9F40-00C04F6BC626}&quot;
' DeleteMenuItem
Set pCmdItem = m_pCtxMenu.Add(pUID)

pUID.value = &quot;{25C0E6C3-CD06-11D2-9F40-00C04F6BC626}&quot;
' RenameMenuItem
Set pCmdItem = m_pCtxMenu.Add(pUID)

' Add the custom command to use the Import geoprocessing tool.
pUID.value = &quot;{1CD666C0-BFB1-4010-A17C-86D424B3C9ED}&quot;
Set pCmdItem = m_pCtxMenu.Add(pUID)
pCmdItem.Group = True

pUID.value = &quot;{20724105-BAB8-11D1-9ABA-080009EC734B}&quot;
' PropertiesMenuItem
Set pCmdItem = m_pCtxMenu.Add(pUID)
pCmdItem.Group = True
End If

' Now display the new context menu
If Not m_pCtxMenu Is Nothing then

m_pCtxMenu.Popup

' Report the chosen item
Dim pSelected_CmdItem As esriFramework.ICommandItem
Set pSelected_CmdItem = m_pCtxMenu
Set IGxObjectUI_ContextMenu = pSelected_CmdItem.ID
End If
End Property

Private Property Get IGxObjectUI_NewMenu() As esriSystem.IUID
' GxIntechangeObjectdo
es not have a NewMenu.
End Property



' IGxObjectEdit members.
Private Function IGxObjectEdit_CanRename() As Boolean
CheckAttributes
IGxObjectEdit_CanRename = m_bExists And Not (m_bReadOnly) 'True
End Function

Private Sub IGxObjectEdit_Rename(ByVal newShortName As String)
CheckAttributes
If m_bExists And Not m_bReadOnly then

If Not m_pFileSystemObject Is Nothing then

' Check for the correct extension, or add it to the new filename
Dim sTemp As String
If InStr(1, UCase(newShortName), &quot;E00&quot = (Len(newShortName) - 2) then

sTemp = m_pParent.FullName &amp;
&quot;/&quot;
&amp;
newShortName
else

sTemp = m_pParent.FullName &amp;
&quot;/&quot;
&amp;
newShortName &amp;
&quot;.e00&quot;
End If

' Method requires filename that has no path with ext
If Not (m_pFileSystemObject.FileExists(sTemp)) then

m_pFileSystemObject.CopyFile m_sFullName, sTemp
m_pFileSystemObject.DeleteFile (m_sFullName)

'do
n't forget to rename the metadata if it is present.
If m_pFileSystemObject.FileExists(m_sFullName &amp;
&quot;.xml&quot then

m_pFileSystemObject.CopyFile m_sFullName &amp;
&quot;.xml&quot;, sTemp &amp;
&quot;.xml&quot;
m_pFileSystemObject.DeleteFile m_sFullName &amp;
&quot;.xml&quot;
End If

' Rename the current object
Me.Name = sTemp

End If
End If
End If
End Sub

Private Function IGxObjectEdit_CanDelete() As Boolean
CheckAttributes
IGxObjectEdit_CanDelete = m_bExists And Not (m_bReadOnly) 'True
End Function

Private Sub IGxObjectEdit_Delete()
' This method uses the FileSystemObject to delete the file
CheckAttributes
If m_bExists And Not m_bReadOnly then

If Not m_pFileSystemObject Is Nothing then

m_pFileSystemObject.DeleteFile (m_sFullName)

'do
n't forget to delete the metadata if it is present.
If m_pFileSystemObject.FileExists(m_sFullName &amp;
&quot;.xml&quot then

m_pFileSystemObject.DeleteFile m_sFullName &amp;
&quot;.xml&quot;
End If

Dim pContainer As esriCatalog.IGxObjectContainer
Set pContainer = m_pParent
pContainer.DeleteChild Me
End If
End If
End Sub

Private Sub IGxObjectEdit_EditProperties(ByVal hParent As esriSystem.OLE_HANDLE)
' This display the generic file properties window
Dim pGxFile As esriCatalog.IGxFile
Set pGxFile = New esriCatalog.GxFile
pGxFile.Path = m_sFullName

Dim pGxObjEdit As esriCatalog.IGxObjectEdit
Set pGxObjEdit = pGxFile
pGxObjEdit.EditProperties hParent
End Sub

Private Function IGxObjectEdit_CanCopy() As Boolean
CheckAttributes
IGxObjectEdit_CanCopy = m_bExists
End Function

Private Sub CheckAttributes()
If Not m_pFileSystemObject Is Nothing then

m_bExists = m_pFileSystemObject.FileExists(m_sFullName)
If m_bExists then

Dim file As Object
Set file = m_pFileSystemObject.GetFile(m_sFullName)
If file.Attributes And 1 then

m_bReadOnly = True
else

m_bReadOnly = False
End If
End If
End If
End Sub



' IGxObjectProperties members
Private Sub IGxObjectProperties_GetPropByIndex(ByVal index As Long, pName As String, pValue As Variant)
If (index > 5) Or (index < 0) then

Err.Raise E_INVALIDARG
else

Select Case index
Case 0
pName = &quot;ESRI_GxObject_Name&quot;
Case 1
pName = &quot;ESRI_GxObject_Type&quot;
Case 2
pName = &quot;ESRI_GxObject_FileSize&quot;
Case 3
pName = &quot;ESRI_GxObject_FileTime&quot;
Case 4
pName = &quot;ESRI_GxObject_FileMode&quot;
Case else

Err.Raise E_INVALIDARG
Exit Sub
End Select
pValue = IGxObjectProperties_GetProperty(pName)
End If
End Sub

Private Function IGxObjectProperties_GetProperty(ByVal Name As String) As Variant
' Identify the property and return the correct value.
Select Case Name
Case &quot;ESRI_GxObject_Name&quot;
IGxObjectProperties_GetProperty = IGxObject_Name
Case &quot;ESRI_GxObject_Type&quot;
IGxObjectProperties_GetProperty = IGxObject_Category
Case else

Dim file As Object
Set file = m_pFileSystemObject.GetFile(m_sFullName)
Select Case Name
Case &quot;ESRI_GxObject_FileSize&quot;
' FGDC Standard expectS file size written in MB.
IGxObjectProperties_GetProperty = Format(file.Size / 1048576, &quot;0.000&quot
Case &quot;ESRI_GxObject_FileTime&quot;
' Format of filetime is standard.
IGxObjectProperties_GetProperty = file.DateLastModified 'Format(file.DateLastModified, &quot;Long Date&quot
Case &quot;ESRI_GxObject_FileMode&quot;
IGxObjectProperties_GetProperty = &quot;R/W&quot;
If file.Attributes And 1 then
IGxObjectProperties_GetProperty = &quot;R&quot;

Case else

Err.Raise E_INVALIDARG
Exit Function
End Select
End Select
End Function

Private Property Get IGxObjectProperties_PropertyCount() As Long
' A GxInterchangeObject has 5 supported properties.
IGxObjectProperties_PropertyCount = 5
End Property

Private Sub IGxObjectProperties_SetProperty(ByVal Name As String, ByVal value As Variant)
' A GxInterchageObject has no properties which can be set by clients
Err.Raise E_FAIL
End Sub



' IMetadata properties.
Private Property Let IMetadata_Metadata(ByVal RHS As esriSystem.IPropertySet)
' To allow the Metadata to be set, you can make use of the GxMetadata class,
' which represents an XML file.
' First check if the file already exists.
Dim sFilename As String
sFilename = m_sFullName &amp;
&quot;.xml&quot;
If Not ExistsMetadata(sFilename) then

' If the metadata filedo
es not already exist, create it now.
Dim newFile As Object
Set newFile = m_pFileSystemObject.CreateTextFile(sFilename, True)
newFile.Close
End If

' First create a GxMetadata object, representing the XML file of metadata.
Dim pGxFile As esriCatalog.IGxFile
Set pGxFile = New esriCatalog.GxMetadata
pGxFile.Path = sFilename

' Save the metadata
Dim pMetadata As esriGeodatabase.IMetadata
Set pMetadata = pGxFile
pMetadata.Metadata = RHS
End Property

Private Property Get IMetadata_Metadata() As esriSystem.IPropertySet
' Return the property set of the Metadata.
Dim pProp As esriSystem.IPropertySet

' Check if the metadata already exists,
If ExistsMetadata(m_sFullName &amp;
&quot;.xml&quot then

' Get the metadata via the GxObject.
' First, create a new metadatafactory.
Dim pGxObjectFactory As esriCatalog.IGxObjectFactoryMetadata
Set pGxObjectFactory = New esriCatalog.GxMetadataFactory

Dim pGxObject As esriCatalog.IGxObject
Set pGxObject = pGxObjectFactory.GetGxObjectFromMetadata(m_sFullName &amp;
&quot;.xml&quot

Dim pMetadata As esriGeodatabase.IMetadata
Set pMetadata = pGxObject
Set pProp = pMetadata.Metadata
else

' If the metadatado
es not exist already, create a new property set.
Set pProp = New esriGeodatabase.XmlPropertySet
End If

Set IMetadata_Metadata = pProp
End Property

Private Sub IMetadata_Synchronize(ByVal Action As esriGeodatabase.esriMetadataSyncAction, ByVal Interval As Long)
' Need to get the current metadata and QI to IXMLPropertySet.
Dim pXMLPropertySet As esriGeodatabase.IXmlPropertySet2
Set pXMLPropertySet = IMetadata_Metadata

' Create a new FGDCSynchronizationHelper, and get ISynchronizationHelper.
Dim pSynchronizationHelper As esriGeodatabase.ISynchronizationHelper
Set pSynchronizationHelper = New esriGeodatabase.FGDCSynchronizationHelper

' Decide whether or not to Synchronize.
Dim bSynchronize As Boolean
bSynchronize = False
pSynchronizationHelper.StartSynchronization pXMLPropertySet, Action, Interval, bSynchronize
' If synchronization was successful.
If Not bSynchronize then

Err.Raise S_FALSE
else


' Get the Name and NativeForm (Type) of the dataset
Dim sDataSetName As String, sNativeForm As String
sDataSetName = IGxObject_Name
sNativeForm = IGxObject_Category

' Build a string representing the UNC path for DataSetLocation
Dim lFullName As Long, lSlash As Long
lFullName = Len(m_sFullName)
lSlash = InStr(m_sFullName, &quot;/&quot
Dim sDataSetLocation As String
sDataSetLocation = &quot;//&quot;
&amp;
ComputerName() &amp;
Mid(m_sFullName, lSlash, lFullName)

' Get the Environment. Generally the Boilerplate information added to most
' GxObjects will include both OS and ArcGIS software version for Environment.
' For the GxInterchangeFile we just get the OS.
Dim sEnvironment As String
sEnvironment = GetVersion()

' Get the system language, returned as ISO 2 characters
Dim sLangBuffer As String * 100
GetLocaleInfo LOCALE_USER_DEFAULT, LOCALE_SISO639LANGNAME, sLangBuffer, 99

' Get the Object size
Dim sSize As String
sSize = IGxObjectProperties_GetProperty(&quot;ESRI_GxObject_FileSize&quot

' Also create a new MetadataSynchronizer. This is a singleton - as well
' as being a synchronizer for basic information, it also acts as the
' synchronization manager.
Dim pMetadataSynchronizer As esriGeodatabase.IMetadataSynchronizer
Set pMetadataSynchronizer = New esriGeodatabase.MetadataSynchronizer

' Call the Update method for each bit of metadata.
' Put the name in the &quot;DatasetName&quot;
metadata element using pXMLPropertySet
pMetadataSynchronizer.Update pXMLPropertySet, &quot;DatasetName&quot;, sDataSetName

' Put the Type in the &quot;NativeType&quot;
metadata element using pXMLPropertySet
pMetadataSynchronizer.Update pXMLPropertySet, &quot;NativeForm&quot;, sNativeForm

' Put the Location in the correct metadata element using pXMLPropertySet
pMetadataSynchronizer.Update pXMLPropertySet, &quot;DatasetLocation&quot;, sDataSetLocation

' Put the operating system information in the &quot;Environment&quot;
metadata element using pXMLPropertySet.
' This would generally include the ArcGIS version too.
pMetadataSynchronizer.Update pXMLPropertySet, &quot;Environment&quot;, sEnvironment

'put the Language in the correct metadata element using pXMLPropertySet
pMetadataSynchronizer.Update pXMLPropertySet, &quot;Language&quot;, sLangBuffer

' Put the Object Size in the &quot;DatasetSize&quot;
metadata element using pXMLPropertySet
pMetadataSynchronizer.Update pXMLPropertySet, &quot;DatasetSize&quot;, sSize

' If IXmlPropertySet::IsNew is True, set the SyncOnce element to False at
' the end of your Synchronize method to indicate the metadata has been
' synchronized.
If pXMLPropertySet.IsNew then

pXMLPropertySet.SetPropertyX &quot;Esri/SyncOnce&quot;, &quot;FALSE&quot;, esriXPTText, _
esriXSPAAddOrReplace, False
End If

pSynchronizationHelper.FinishSynchronization pXMLPropertySet

'Write out the metadata using the Let Method from IMetadata.Metadata
IMetadata_Metadata = pXMLPropertySet

End If
End Sub

Private Property Get IMetadataEdit_CanEditMetadata() As Boolean
IMetadataEdit_CanEditMetadata = False
' Return true if the file is editable.
If ExistsMetadata(m_sFullName) then

Dim file As Object
Set file = m_pFileSystemObject.GetFile(m_sFullName)
If Not file.Attributes = 1 then

IMetadataEdit_CanEditMetadata = True
End If
End If
End Property

Private Function CanEditMetadata(m_sFullName As String)
If ExistsMetadata(m_sFullName) then

Dim file As Object
Set file = m_pFileSystemObject.GetFile(m_sFullName)
If Not file.Attributes = 1 then

CanEditMetadata = True
else

CanEditMetadata = False
End If
End If
End Function

Private Function ExistsMetadata(m_sName_XML As String)
Set m_pFileSystemObject = CreateObject(&quot;Scripting.FileSystemObject&quot
ExistsMetadata = m_pFileSystemObject.FileExists(m_sName_XML)
End Function


Public Function ComputerName() As String
' Returns the name of the local computer.
Dim buffer As String * 512, Length As Long
Length = Len(buffer)
If GetComputerName(buffer, Length) then

' this API returns non-zero if successful,
' and modifies the length argument
ComputerName = Left(buffer, Length)
End If
End Function

Public Function GetVersion() As String
' Returns the version of the OS
Dim osinfo As OSVERSIONINFO
osinfo.dwOSVersionInfoSize = 148
osinfo.szCSDVersion = Space$(128)

Dim retvalue As Integer
retvalue = GetVersionExA(osinfo)

'Get the Build Number
Dim BuildNum As Integer
Dim strBuildNum As String
BuildNum = osinfo.dwBuildNumber
If Not BuildNum then

strBuildNum = &quot;(Build &quot;
&amp;
CStr(BuildNum) &amp;
&quot&quot;
else

strBuildNum = &quot;&quot;
End If

'Get the Version
Dim intMajor As Integer, intMinor As Integer
intMajor = osinfo.dwMajorVersion
intMinor = osinfo.dwMinorVersion

Dim strMajor As String, strMinor As String
If Not intMajor then
strMajor = &quot;Version &quot;
&amp;
CStr(intMajor) &amp;
&quot;.&quot;
If Not intMinor then
strMinor = CStr(intMinor)

Dim strVersion As String
strVersion = strMajor &amp;
strMinor

Dim strServicePack As String
strServicePack = Trim(osinfo.szCSDVersion)

With osinfo
Select Case .dwPlatformId
' This is for Win32_windows
Case 1
Select Case .dwMinorVersion
Case 0
GetVersion = &quot;Windows 95 &quot;
&amp;
strVersion &amp;
&quot;
&quot;
&amp;
strBuildNum &amp;
&quot;
&quot;
&amp;
strServicePack &amp;
&quot;;&quot;
&amp;
vbNewLine
Case 10
GetVersion = &quot;Windows 98 &quot;
&amp;
strVersion &amp;
&quot;
&quot;
&amp;
strBuildNum &amp;
&quot;
&quot;
&amp;
strServicePack &amp;
&quot;;&quot;
&amp;
vbNewLine
Case 90
GetVersion = &quot;Windows Millennium &quot;
&amp;
strVersion &amp;
&quot;
&quot;
&amp;
strBuildNum &amp;
&quot;
&quot;
&amp;
strServicePack &amp;
&quot;;&quot;
&amp;
vbNewLine
End Select
'THis is for NT
Case 2
Select Case .dwMajorVersion
Case 3
GetVersion = &quot;Windows NT 3.51 &quot;
&amp;
strVersion &amp;
&quot;
&quot;
&amp;
strBuildNum &amp;
&quot;
&quot;
&amp;
strServicePack &amp;
&quot;;&quot;
&amp;
vbNewLine
Case 4
GetVersion = &quot;Windows NT 4.0 &quot;
&amp;
strVersion &amp;
&quot;
&quot;
&amp;
strBuildNum &amp;
&quot;
&quot;
&amp;
strServicePack &amp;
&quot;;&quot;
&amp;
vbNewLine
Case 5
If .dwMinorVersion = 0 then

GetVersion = &quot;Windows 2000 &quot;
&amp;
strVersion &amp;
&quot;
&quot;
&amp;
strBuildNum &amp;
&quot;
&quot;
&amp;
strServicePack &amp;
&quot;;&quot;
&amp;
vbNewLine
else

GetVersion = &quot;Windows XP &quot;
&amp;
strVersion &amp;
&quot;
&quot;
&amp;
strBuildNum &amp;
&quot;
&quot;
&amp;
strServicePack &amp;
&quot;;&quot;
&amp;
vbNewLine
End If
End Select
Case else

GetVersion = &quot;Failed&quot;
End Select
End With
End Function