Author:水如煙
從注冊表中取。其它方法未作嘗試。
ApplicationType.vb
Namespace LzmTW.MSOffice
Public Enum ApplicationType
Access
Excel
Word
Outlook
PowerPoint
Publisher
End Enum
End Namespace
Constance.vb
Namespace LzmTW.MSOffice.Info
FrIEnd Class Constance
Public Const REGKEY_APPLICATION_TYPE As String = "{0}.Application\"
Public Const REGKEY_OFFICE_VER As String = "SOFTWARE\Microsoft\Office\{0}\"
Public Const REGKEY_OFFICE_COMMON_VER As String = "SOFTWARE\Microsoft\Office\{0}\Common\"
Public Shared Function GetApplicationKey(ByVal app As ApplicationType) As String
Return String.Format(REGKEY_APPLICATION_TYPE, app.ToString)
End Function
Public Shared Function GetOfficeCommonKey(ByVal ver As Version) As String
Return String.Format(REGKEY_Office_COMMON_VER, GetMasterVer(ver))
End Function
Public Shared Function GetOfficeKey(ByVal ver As Version) As String
Return String.Format(REGKEY_Office_VER, GetMasterVer(ver))
End Function
Public Shared Function GetMasterVer(ByVal ver As Version) As String
Return String.Concat(ver.Major, ".", ver.Minor)
End Function
Public Shared Function GetBinaryValue(ByVal keyvalue As Object) As String
If keyvalue Is Nothing Then Return Nothing
Dim mBytes As Byte() = CType(keyvalue, Byte())
Return System.Text.Encoding.Unicode.GetString(mBytes).Replace(ChrW(0), "")
End Function
Public Shared Function GetProductName(ByVal versionMajor As Integer, ByVal app As ApplicationType) As String
Dim mOther As String
Select Case versionMajor
Case 8
mOther = "98"
Case 9
mOther = "2000"
Case 10
mOther = "XP"
Case 11
mOther = "2003"
Case 12
mOther = "2007"
Case Else
mOther = "XXXX"
End Select
Return String.Concat(app.ToString, mOther)
End Function
End Class
End Namespace
OfficeCommonInfo.vb
Imports System.Globalization
Imports Microsoft.Win32
Namespace LzmTW.MSOffice.Info
''Machine
Public Class OfficeCommonInfo
Private gInfos As New Hashtable
'''''' <summary>
'''''' 安裝語言
'''''' </summary>
Public ReadOnly Property InstallLanguge() As CultureInfo
Get
Return CType(gInfos("InstallLanguge"), CultureInfo)
End Get
End Property
'''''' <summary>
'''''' 版本主號
'''''' </summary>
Public ReadOnly Property MasterVersion() As Version
Get
Return CType(gInfos("MasterVersion"), Version)
End Get
End Property
'''''' <summary>
'''''' 產品版本號
'''''' </summary>
Public ReadOnly Property ProductVersion() As Version
Get
Return CType(gInfos("ProductVersion"), Version)
End Get
End Property
'''''' <summary>
'''''' 安裝路徑
'''''' </summary>
Public ReadOnly Property InstallRoot() As String
Get
Return CType(gInfos("InstallRoot"), String)
End Get
End Property
'''''' <summary>
'''''' 公司
'''''' </summary>
Public ReadOnly Property Company() As String
Get
Return CType(gInfos("Company"), String)
End Get
End Property
'''''' <summary>
'''''' 用戶
'''''' </summary>
Public ReadOnly Property UserName() As String
Get
Return CType(gInfos("UserName"), String)
End Get
End Property
FrIEnd Sub New(ByVal masterVer As Version)
Dim mCommonKey As RegistryKey = Registry.LocalMachine.OpenSubKey(Constance.GetOfficeCommonKey(masterVer))
If mCommonKey Is Nothing Then Return
gInfos("MasterVersion") = New Version(masterVer.Major, masterVer.Minor, 0, 0)
gInfos("InstallRoot") = mCommonKey.OpenSubKey("InstallRoot").GetValue("Path")
Dim msVersion As Object = mCommonKey.OpenSubKey("ProductVersion").GetValue("LastProduct")
gInfos("ProductVersion") = New Version(msVersion.ToString)
mCommonKey = Registry.CurrentUser.OpenSubKey(Constance.GetOfficeCommonKey(masterVer))
Dim mLcid As Integer = CType(mCommonKey.OpenSubKey("LanguageResources").GetValue("InstallLanguage"), Integer)
gInfos("InstallLanguge") = New CultureInfo(mLcid)
Dim mUserInfoKey As RegistryKey = mCommonKey.OpenSubKey("UserInfo")
gInfos("Company") = Constance.GetBinaryValue(mUserInfoKey.GetValue("Company"))
gInfos("UserName") = Constance.GetBinaryValue(mUserInfoKey.GetValue("UserName"))
End Sub
End Class
End Namespace
ApplicationInfo.vb
Imports System.Globalization
Imports Microsoft.Win32
Namespace LzmTW.MSOffice.Info
Public Class ApplicationInfo
Private gInfos As New Hashtable
'''''' <summary>
'''''' 全局唯一標識符
'''''' </summary>
Public ReadOnly Property CLSID() As Guid
Get
Return CType(gInfos("CLSID"), Guid)
End Get
End Property
'''''' <summary>
'''''' 程序俗名,如Excel2003
'''''' </summary>
Public ReadOnly Property ProductName() As String
Get
Return CType(gInfos("ProductName"), String)
End Get
End Property
'''''' <summary>
'''''' 已安裝版本,主版本號
'''''' </summary>
Public ReadOnly Property Verisons() As Version()
Get
Return CType(gInfos("Versions"), Version())
End Get
End Property
Public ReadOnly Property LocalServer() As String
Get
Return CType(gInfos("LocalServers"), String)
End Get
End Property
Public ReadOnly Property ProgID() As String
Get
Return CType(gInfos("ProgID"), String)
End Get
End Property
'''''' <summary>
'''''' Office信息
'''''' </summary>
Public ReadOnly Property CommonInfo() As OfficeCommonInfo
Get
Return CType(gInfos("CommonInfo"), OfficeCommonInfo)
End Get
End Property
Sub New(ByVal app As ApplicationType)
Dim mApplicationKey As RegistryKey = Registry.ClassesRoot.OpenSubKey(Constance.GetApplicationKey(app))
If mApplicationKey Is Nothing Then Return
Dim mGuid As String = mApplicationKey.OpenSubKey("CLSID").GetValue(Nothing).ToString
gInfos("CLSID") = New Guid(mGuid)
Dim mCurVer As String = mApplicationKey.OpenSubKey("CurVer").GetValue(Nothing).ToString
Dim mCurrentVersionMajor As Integer = Integer.Parse(mCurVer.Substring(mCurVer.LastIndexOf(".") + 1))
gInfos("ProductName") = Constance.GetProductName(mCurrentVersionMajor, app)
Dim mGuidKey As RegistryKey = Registry.ClassesRoot.OpenSubKey("CLSID\" & mGuid)
Dim mLocalServersKey As RegistryKey = mGuidKey.OpenSubKey("LocalServer")
If Not mLocalServersKey Is Nothing Then
gInfos("LocalServers") = mGuidKey.OpenSubKey("LocalServer").GetValue(Nothing)
End If
gInfos("ProgID") = mGuidKey.OpenSubKey("ProgID").GetValue(Nothing)
Dim mVersionsKey As RegistryKey = mGuidKey.OpenSubKey("InprocServer32")
Dim mVerCount As Integer = mVersionsKey.SubKeyCount
Dim mVers As New List(Of Version)
For Each ver As String In mVersionsKey.GetSubKeyNames()
mVers.Add(New Version(ver))
Next
gInfos("Versions") = mVers.ToArray
Dim mCommonInfo As New OfficeCommonInfo(New Version(mCurrentVersionMajor, 0, 0, 0))
gInfos("CommonInfo") = mCommonInfo
End Sub
End Class
測試代碼
Public Class TestApplicationInfo
Public Sub Print()
Dim b As New System.Text.StringBuilder
For Each t As LzmTW.MSOffice.ApplicationType In [Enum].GetValues(GetType(LzmTW.MSOffice.ApplicationType))
b.AppendLine(GetOutput(New LzmTW.MSOffice.Info.ApplicationInfo(t)))
b.AppendLine()
Next
My.Computer.FileSystem.WriteAllText("tmp.txt", b.ToString, False)
End Sub
Private Function GetOutput(ByVal info As LzmTW.MSOffice.Info.ApplicationInfo) As String
Dim b As New System.Text.StringBuilder
With info
b.AppendLine(GetString("ProductName", .ProductName))
b.AppendLine(GetString("CLSID", .CLSID.ToString))
b.AppendLine(GetString("ProgID", .ProgID))
b.AppendLine(GetString("LocalServer", .LocalServer))
Dim vers As String = String.Empty
For Each ver As Version In .Verisons
vers &= ver.ToString & " "
Next
b.AppendLine(GetString("Versions", vers))
b.AppendLine()
b.AppendLine(GetString("Office", Nothing, True))
With .CommonInfo
b.AppendLine(GetString("InstallRoot", .InstallRoot, True))
b.AppendLine(GetString("InstallLanguge", .InstallLanguge.Name & "(" & .InstallLanguge.LCID & ")", True))
b.AppendLine(GetString("ProductVersion", .ProductVersion.ToString, True))
b.AppendLine(GetString("Company", .Company, True))
b.AppendLine(GetString("UserName", .UserName, True))
End With
End With
Return b.ToString
End Function
Private Function GetString(ByVal name As String, ByVal value As String, Optional ByVal isCommon As Boolean = False) As String
If isCommon Then
Return String.Format("{0,20} :{1}", name, value)
Else
Return String.Format("{0,10} :{1}", name, value)
End If
End Function
End Class
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
Dim t As New TestApplicationInfo
t.Print()
End Sub
測試的結果輸出到tmp.txt文件,
我的手提安裝了兩個版本,專門用它來測試,結果如下:
注意:有的用2003版本,有的用2007版本的.
ProductName :Access2003
CLSID :73a4c9c1-d68d-11d0-98bf-00a0c90dc8d9
ProgID :Access.Application.12
LocalServer :
Versions :11.0.0.0 12.0.0.0
Office :
InstallRoot :C:Program FilesMicrosoft OfficeOffice11
InstallLanguge :zh-CN(2052)
ProductVersion :11.0.7969.0
Company :FKDL
UserName :LzmTW
ProductName :Excel2007
CLSID :00024500-0000-0000-c000-000000000046
ProgID :Excel.Application.12
LocalServer :C:PROGRA~1MICROS~1Office11Excel.EXE /automation
Versions :11.0.0.0 12.0.0.0
Office :
InstallRoot :C:Program FilesMicrosoft OfficeOffice12
InstallLanguge :zh-CN(2052)
ProductVersion :12.0.4017.1006
Company :FKDL
UserName :LzmTW
ProductName :Word2003
CLSID :000209ff-0000-0000-c000-000000000046
ProgID :Word.Application.11
LocalServer :
Versions :11.0.0.0 12.0.0.0
Office :
InstallRoot :C:Program FilesMicrosoft OfficeOffice11
InstallLanguge :zh-CN(2052)
ProductVersion :11.0.7969.0
Company :FKDL
UserName :LzmTW
ProductName :Outlook2007
CLSID :0006f03a-0000-0000-c000-000000000046
ProgID :Outlook.Application.12
LocalServer :
Versions :12.0.0.0
Office :
InstallRoot :C:Program FilesMicrosoft OfficeOffice12
InstallLanguge :zh-CN(2052)
ProductVersion :12.0.4017.1006
Company :FKDL
UserName :LzmTW
ProductName :PowerPoint2007
CLSID :91493441-5a91-11cf-8700-00aa0060263b
ProgID :PowerPoint.Application.12
LocalServer :C:PROGRA~1MICROS~1Office11POWERPNT.EXE /AUTOMATION
Versions :11.0.0.0 12.0.0.0
Office :
InstallRoot :C:Program FilesMicrosoft OfficeOffice12
InstallLanguge :zh-CN(2052)
ProductVersion :12.0.4017.1006
Company :FKDL
UserName :LzmTW
ProductName :Publisher2007
CLSID :0002123d-0000-0000-c000-000000000046
ProgID :Publisher.Application.12
LocalServer :
Versions :11.0.0.0 12.0.0.0
Office :
InstallRoot :C:Program FilesMicrosoft OfficeOffice12
InstallLanguge :zh-CN(2052)
ProductVersion :12.0.4017.1006
Company :FKDL
UserName :LzmTW
看上去Access2003有問題. 不過注冊表還真是如此,奇怪。
