你知道吗

[水如烟]

你知道吗

在这个贴子里，将例举一些比较偏门的问题：平时少用，但有时确实的需要。

如果各位知道有一个东西叫“头脑风暴法”，就不要过分挑剔那些问题和那些方法。大家可以补充。

还是那句老话：仅供参考。

[水如烟]

我们知道，桌面应用程序一般有两种类型，一是Windows应用程序，二是控制台应用程序。
如何判断调用自己所在Dll的主程序是Windows还是控制台应用程序呢？

解决这个问题，基点是ApplicationBase，ConsoleApplicationBase和WindowsFormsApplicationBase，
攻击的地方，当然是Application了。

[CloneCenter]

老大夜里还在这里辛勤耕耘，佩服一个！

我也来贴一个，比较两个相同类型的类实例，有哪些数据不相同。

    ' 获得两个相同类型类对象的不同属性值，并将这个差异分别记录到 Data1 和 Data2 属性中。
    Public Sub GetDiffrent(ByRef AData1 As Object, ByRef AData2 As Object)
        Me.Data1 = String.Empty : Me.Data2 = String.Empty
        Dim t As Type = AData1.GetType(), v1 As Object, v2 As Object
        Dim pr As System.Reflection.PropertyInfo
        Dim prArray As System.Reflection.PropertyInfo()
        prArray = t.GetProperties(BindingFlags.Public Or BindingFlags.Instance)
        For Each pr In prArray
            If Array.IndexOf(Me.NoCompareArray, pr.Name.ToUpper) < 0 Then  ' 这里的 NoCompareArray 是自定义的一个数组，放置的是不需要比较的属性名称。
                v1 = t.InvokeMember(pr.Name, BindingFlags.GetField Or BindingFlags.GetProperty, Nothing, AData1, New Object() {})
                v2 = t.InvokeMember(pr.Name, BindingFlags.GetField Or BindingFlags.GetProperty, Nothing, AData2, New Object() {})
                If v1 <> v2 Then
                    Me.Data1 &= pr.Name & "=" & v1 & ControlChars.CrLf
                    Me.Data2 &= pr.Name & "=" & v2 & ControlChars.CrLf
                End If
            End If
        Next
    End Sub
' 代码里面其实还有一些问题，如果类属性里面包含了一些不能自动转换为 String 的属性，则会产生错误。

[水如烟]

关于不确定参数的传递,使用ParamArray

注意事项请参考文档.

示例

    Private Sub ButtonTest_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ButtonTest.Click

        ExcuteShell("cmd /k", "dir", "c:\", "/s")

    End Sub

    Private Sub ExcuteShell(ByVal ParamArray paras() As String)
        Dim pathName As String = String.Join(" ", paras)

        Microsoft.VisualBasic.Shell(pathName, AppWinStyle.NormalNoFocus, True)
    End Sub

[新鲜鱼排]

如何在JAVA程序中使用Struct一次传入多条数据给Oracle的存储过程。
大家可以尝试在.NET中实现类型的功能。
http://blog.csdn.net/dutguoyi/archive/2007/11/11/1879416.aspx

为了减少连接Oracle数据库的数量，需要将多条数据作为变量一次传入Oracle的存储过程中。方法如下：

步骤一：定义对象类型。

CREATE TYPE department_type AS OBJECT (
DNO NUMBER (10),
NAME VARCHAR2 (50),
LOCATION VARCHAR2 (50)
);

步骤二：定义一个对象类型的数组对象。

CREATE TYPE dept_array AS TABLE OF department_type;
步骤三：定义存储过程来插入数据。

CREATE OR REPLACE PACKAGE objecttype AS
PROCEDURE insert_object (d dept_array);
END objecttype;

CREATE OR REPLACE PACKAGE BODY objecttype
AS
PROCEDURE insert_object (d dept_array)
AS
BEGIN
FOR i IN d.FIRST..d.LAST
LOOP
INSERT INTO department_teststruct
VALUES (d(i).dno,d(i).name,d(i).location);
END LOOP;
END insert_object;
END objecttype;

步骤四（可选步骤，即可以不做）：定义一个Java class来映射对象中类型。
步骤五：定义Java方法来调用存储过程。

import java.sql.Connection;
import java.sql.DriverManager;
import oracle.jdbc.OracleCallableStatement;
import oracle.sql.ARRAY;
import oracle.sql.ArrayDescriptor;
import oracle.sql.STRUCT;
import oracle.sql.StructDescriptor;

public class TestStruct ...{
public static void main(String[] args)
...{
sendStruct();
}
public static void sendStruct()
...{
Connection dbConn = null;
try...{
Object[] so1 = ...{"10","Accounts","LHR"};
Object[] so2 = ...{"20","HR","ISB"};
OracleCallableStatement callStatement = null;
Class.forName("oracle.jdbc.driver.OracleDriver");
dbConn = DriverManager.getConnection("jdbc:oracle:thin:@ServerName:Port:ORa", "UserName", "Password");
StructDescriptor st = new StructDescriptor("DEPARTMENT_TYPE",dbConn);
STRUCT s1 = new STRUCT(st,dbConn,so1);
STRUCT s2 = new STRUCT(st,dbConn,so2);
STRUCT[] deptArray = ...{s1,s2};
ArrayDescriptor arrayDept = ArrayDescriptor.createDescriptor("DEPT_ARRAY", dbConn);
ARRAY deptArrayObject = new ARRAY(arrayDept, dbConn, deptArray);
callStatement = (OracleCallableStatement)dbConn.prepareCall("{call insert_object(?)}");
((OracleCallableStatement)callStatement).setArray(1, deptArrayObject);
callStatement.executeUpdate();
dbConn.commit();
callStatement.close();
}
catch(Exception e)...{
System.out.println(e.toString());
}
}
}

jdbc:oracle:thin: --Oracle数据库驱动标识

ServerName: --Oracle数据库所有机器名或IP地址

1521: --数据库所使用的端口号

ORa --Oracle服务名


注意事项：

1． 首先一个操作是手动连接Oracle建立对象，接下来的操作是通过JAVA程序建立数据库连接来使用对象。如果两个操作使用同一个用户就没有问题，如果是不同的用户那么要确保第二个操作（即通过Java程序）的用户有权限来操作第一个用户建立的对象。第一个用户为它添加权限的方法是：在每个对象中大家可以找到权限一项，找到对应用户添加执行权限即可。而在程序中就需要做一些修改。存储过程同理。
StructDescriptor st = new StructDescriptor("第一个UserName.DEPARTMENT_TYPE",dbConn);
ArrayDescriptor arrayDept = ArrayDescriptor.createDescriptor("第一个UserName.DEPT_ARRAY", dbConn);
callStatement = (OracleCallableStatement)dbConn.prepareCall("{call 第一个UserName.insert_object(?)}");
结果是Java中虽然只是一次执行连接数据库，但是却一次插入两条数据。希望能够给寻找类似解决方案的兄弟姐妹提供一点帮助。有什么建议或者意见尽管留言，谢谢。

参考资料：

1. 大家可以在下面的链接中找到javadoc文件来进行下载，这是一个非常有用的说明文档，这次我主要用到了DriverManager.getConnection的定义方法。

http://download.oracle.com/otn/utilities_drivers/jdbc/101020/javadoc.zip
http://www.oracle.com/technology/software/tech/java/sqlj_jdbc/htdocs/jdbc101020.html

[水如烟]

处理隐蔽的类或类的隐蔽属性TypeHelper

这个类是用来处理隐蔽的类或类的隐蔽属性。说实话，我并不想将它贴出来。但后面的很多处理，都需要它。所以贴了出来。
不想贴出来，并非是它有什么高深的技术，相反，它非常简单。不想贴的原因是，它反映的“歪道”思路可能影响你对.NET的理解。

我不是编程或者是真正意义上的IT职员，我学习.NET应用.NET仅仅是用来保持自己的脑袋还处于思索状态，不至于因生活而麻木。
况且，我只接触WinForm。我学习.NET的兴趣就来源于走“歪道”。切记，仅供参考。

TypeHelper.vb

Imports System.Reflection

Namespace LzmTW.uSystem.uReflection

    Public Class TypeHelper

        Private gType As Type
        Private gCurrentObjct As Object

        Public ReadOnly Property CurrentType() As Type
            Get
                Return gType
            End Get
        End Property

        Public ReadOnly Property CurrentObject() As Object
            Get
                Return gCurrentObjct
            End Get
        End Property


        Sub New(ByVal referrenceObj As Object)
            Me.gType = referrenceObj.GetType

            If Not Me.IsType(referrenceObj) Then Me.gCurrentObjct = referrenceObj
        End Sub

        Sub New(ByVal assembly As Assembly, ByVal fullTypeName As String)
            Me.InternalCreate(assembly, fullTypeName)

            Me.InternalCheckIsValid(fullTypeName, True)
        End Sub

        Sub New(ByVal referrenceType As Type, ByVal typeName As String, Optional ByVal isNestedType As Boolean = False)

            Dim mAssembly As Assembly = referrenceType.Assembly

            Me.InternalCreate(mAssembly, typeName)

            If Me.InternalCheckIsValid(typeName, False) Then Return

            Dim mFullTypeName As String = GetFullTypeName(referrenceType, typeName, isNestedType)

            Me.InternalCreate(mAssembly, mFullTypeName)

            Me.InternalCheckIsValid(mFullTypeName, True)
        End Sub

        Private Sub InternalCreate(ByVal ass As Assembly, ByVal fulltypename As String)
            gType = ass.GetType(fulltypename, False, True)
        End Sub

        Private Function InternalCheckIsValid(ByVal typename As String, ByVal throwOnError As Boolean) As Boolean
            If gType Is Nothing Then
                If throwOnError Then
                    Throw New ArgumentException(String.Format("typeName: {0} 不存在", typename))
                Else
                    Return False
                End If
            End If

            Return True
        End Function

        Private Function GetFullTypeName(ByVal referrenceType As Type, ByVal typeName As String, ByVal isNestedType As Boolean) As String
            Dim mFullName As String = Nothing

            Dim mRefFullName As String = referrenceType.FullName

            If isNestedType Then

                mFullName = String.Concat(mRefFullName, "+", typeName)
            Else

                Dim mLastIndex As Integer = mRefFullName.LastIndexOf(referrenceType.Name)

                mFullName = String.Concat(mRefFullName.Substring(0, mLastIndex), typeName)
            End If

            Return mFullName
        End Function

        Private Function IsType(ByVal instance As Object) As Boolean
            Return instance.GetType.IsSubclassOf(GetType(Type))
        End Function

        Public Const Binding As BindingFlags = _
            BindingFlags.Instance Or _
            BindingFlags.Public Or _
            BindingFlags.NonPublic Or _
            BindingFlags.Static Or _
            BindingFlags.CreateInstance Or _
            BindingFlags.IgnoreCase


    End Class

End Namespace

TypeHelper.Methods.vb

Imports System.Reflection

Namespace LzmTW.uSystem.uReflection

    Partial Class TypeHelper

        Public Sub SetCurrentObj(ByVal obj As Object)
            If Not Me.CurrentType.IsInstanceOfType(obj) Then
                Throw New ArgumentException("实例类型与内部类型不相符")
            End If

            Me.gCurrentObjct = obj
        End Sub

        Public Function GetMemberValue(ByVal name As String, ByVal ParamArray args() As Object) As Object
            Return Me.CurrentType.InvokeMember( _
                name, _
                MemberGetBinding, _
                Nothing, _
                Me.CurrentObject, _
                args)
        End Function


        Public Sub SetMemberValue(ByVal name As String, ByVal ParamArray args() As Object)
            Me.CurrentType.InvokeMember( _
                name, _
                MemberSetBinding, _
                Nothing, _
                Me.CurrentObject, _
                args)
        End Sub

        Public Function MethodInvoke(ByVal name As String, ByVal ParamArray args() As Object) As Object
            Return Me.CurrentType.InvokeMember( _
                name, _
                MethodBinding, _
                Nothing, _
                Me.CurrentObject, _
                args)
        End Function

        Public Function NewInstance(ByVal ParamArray args() As Object) As Object
            Dim mParaCount As Integer = args.Length
            Dim mCtors As ConstructorInfo() = Me.CurrentType.GetConstructors(MethodBinding)

            For Each ctro As ConstructorInfo In mCtors
                If ctro.GetParameters.Length = mParaCount Then
                    Return ctro.Invoke(args)
                End If
            Next

            Return Nothing
        End Function

        Public Function FindMember(ByVal name As String) As MemberInfo()
            If String.IsNullOrEmpty(name) OrElse name = "*" OrElse name = "%" Then
                Return Me.CurrentType.GetMembers(Binding)
            End If

            Dim mArray As MemberInfo() = Me.CurrentType.GetMember(name, Binding)

            Return mArray
        End Function


        Private MemberGetBinding As BindingFlags = _
                BindingFlags.Instance Or _
                BindingFlags.Public Or _
                BindingFlags.NonPublic Or _
                BindingFlags.Static Or _
                BindingFlags.GetField Or _
                BindingFlags.GetProperty Or _
                BindingFlags.IgnoreCase

        Private MemberSetBinding As BindingFlags = _
                BindingFlags.Instance Or _
                BindingFlags.Public Or _
                BindingFlags.NonPublic Or _
                BindingFlags.Static Or _
                BindingFlags.SetField Or _
                BindingFlags.SetProperty Or _
                BindingFlags.IgnoreCase

        Private MethodBinding As BindingFlags = _
                BindingFlags.Instance Or _
                BindingFlags.Public Or _
                BindingFlags.NonPublic Or _
                BindingFlags.Static Or _
                BindingFlags.InvokeMethod Or _
                BindingFlags.IgnoreCase
    End Class

End Namespace

[水如烟]

判断调用自己所在Dll的主程序是Windows还是控制台应用程序

我观察了一下,有三种情形

Public Enum ApplicationType
WindowsForms '这是Form启动的Windows应用程序
ConsoleForms '这是Main启动且含代码Application.Run(New Form)的控制台应用程序
Console '这是Main启动无窗体的控制台应用程序,就算是Form.ShowDialog也列于此项
End Enum

对于控制台应用程序,如Main代码是这样的话:

Public Class Program
    Shared Sub Main()
        Console.WriteLine((New LzmTW.uSystem.uForms.MyApplicationBase).CurrentType.ToString)
        Application.Run(New Form1)
        Console.WriteLine((New LzmTW.uSystem.uForms.MyApplicationBase).CurrentType.ToString)
        Console.Read()
    End Sub
End Class

而Form1中有一个按钮也来测试

    Private Sub ButtonTest_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ButtonTest.Click
        Console.WriteLine((New LzmTW.uSystem.uForms.MyApplicationBase).CurrentType.ToString)
    End Sub

那么,显示的结果,先是Console,后是ConsoleForms,最后是Console。

MyApplicationBase.vb

Imports Microsoft.VisualBasic.ApplicationServices

Namespace LzmTW.uSystem.uForms

    Public Class MyApplicationBase

        'System.Windows.Forms.Application+ThreadContext
        Private Shared gThreadContextType As uReflection.TypeHelper

        'Microsoft.VisualBasic.ApplicationServices.WindowsFormsApplicationBase+WinFormsAppContext
        Private Shared gWinFormsAppContext As uReflection.TypeHelper

        Private gAppContext As Object = Nothing 'ApplicationContext or WinFormsAppContext

        Private gWindowsFormsApplicationBase As WindowsFormsApplicationBase = Nothing

        Private gCurrentType As ApplicationType

        Shared Sub New()
            gThreadContextType = New uReflection.TypeHelper(GetType(Application), "ThreadContext", True)
            gWinFormsAppContext = New uReflection.TypeHelper(GetType(WindowsFormsApplicationBase), "WinFormsAppContext", True)
        End Sub

        Sub New()
            GetApplicationContext()

            GetWindowsFormsApplicationBase()

            gCurrentType = GetApplcationType()
        End Sub

        Private Sub GetApplicationContext()
            Dim mCurrentThreadContext As Object
            mCurrentThreadContext = gThreadContextType.MethodInvoke("FromCurrent")
            gThreadContextType.SetCurrentObj(mCurrentThreadContext)

            gAppContext = gThreadContextType.GetMemberValue("ApplicationContext")
        End Sub

        Private Sub GetWindowsFormsApplicationBase()
            If Not gWinFormsAppContext.CurrentType.IsInstanceOfType(gAppContext) Then Return

            gWinFormsAppContext.SetCurrentObj(gAppContext)

            gWindowsFormsApplicationBase = CType(gWinFormsAppContext.GetMemberValue("m_App"), WindowsFormsApplicationBase)
        End Sub

        Private Function GetApplcationType() As ApplicationType
            If gAppContext Is Nothing Then
                Return ApplicationType.Console
            End If

            If gWindowsFormsApplicationBase Is Nothing Then
                Return ApplicationType.ConsoleForms
            End If

            Return ApplicationType.WindowsForms
        End Function

        Public ReadOnly Property ApplicationContext() As ApplicationContext
            Get
                Return CType(gAppContext, ApplicationContext)
            End Get
        End Property

        Public ReadOnly Property WindowsFormsApplicationBase() As WindowsFormsApplicationBase
            Get
                Return gWindowsFormsApplicationBase
            End Get
        End Property


        Public ReadOnly Property CurrentType() As ApplicationType
            Get
                Return gCurrentType
            End Get
        End Property

        Public Enum ApplicationType
            WindowsForms
            ConsoleForms
            Console
        End Enum

    End Class
End Namespace

[水如烟]

MyApplicationBase有没有用?

这当然看自己的需求。
举例来说，如果有一个类需要输出信息，如是控制台应用程序，就输出到控制台，如是WinForm程序，就以Form的形式显示，
这个时候，就需要MyApplicationBase来判定的了。

另，如果是WinForm应用程序，MyApplicationBase.WindowsFormsApplicationBase其实就是My.Application，
这里有大量的信息供自己使用。

个人感觉，这个类可能还是蛮有用的。

[水如烟]

变量的安全问题我曾经想过“研究”一番，可最后还是没研下来，因为我觉得那些东西太费脑了，有点吃力。

示例:怎么保证User的信息安全

Imports System.Security
Imports System.Runtime.InteropServices

Public Class User
    Private gName As String
    Private gPassword As SecureString

    Sub New(ByVal name As String, ByVal password As String)
        Me.gName = name

        Me.gPassword = New SecureString
        For Each c As Char In password.ToCharArray
            Me.gPassword.AppendChar(c)
        Next

        Me.gPassword.MakeReadOnly()
    End Sub

    Public ReadOnly Property Name() As String
        Get
            Return gName
        End Get
    End Property

    Public ReadOnly Property Password() As String
        Get
            Return Marshal.PtrToStringAuto(Marshal.SecureStringToBSTR(gPassword))
        End Get
    End Property

    Public Overloads Function ToString()
        Return String.Format("my name is {0}, pass is {1} ", Me.Name, Me.Password)
    End Function
End Class

测试：

Public Class Form1

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Dim t As New User("LzmTW", "bybyMycsdn")

        Login(t)

        'changed
        Dim helper As New LzmTW.uSystem.uReflection.TypeHelper(t)

        Console.WriteLine("name changed!")
        helper.SetMemberValue("gname", "lzm")
        Login(t)

        Dim tmp As New Security.SecureString
        tmp.AppendChar("h")
        tmp.AppendChar("e")
        tmp.AppendChar("h")
        tmp.AppendChar("e")

        Console.WriteLine("pass changed!")
        helper.SetMemberValue("gPassword", tmp)
        Login(t)


    End Sub

    Private Sub Login(ByVal user As User)
        Console.WriteLine(user.ToString)
        Console.WriteLine()
    End Sub
End Class

结果：

my name is LzmTW, pass is bybyMycsdn 

name changed!
my name is lzm, pass is bybyMycsdn 

pass changed!
my name is lzm, pass is hehe 

[水如烟]

对于构造函数是私有的类，我们也能实例化。

示例：

Imports System.Security
Imports System.Runtime.InteropServices

Public Class User
    Private gName As String
    Private gPassword As SecureString

    '注意构造函数是私有的
    Private Sub New(ByVal name As String, ByVal password As String)
        Me.gName = name

        Me.gPassword = New SecureString
        For Each c As Char In password.ToCharArray
            Me.gPassword.AppendChar(c)
        Next

        Me.gPassword.MakeReadOnly()
    End Sub

    Public ReadOnly Property Name() As String
        Get
            Return gName
        End Get
    End Property

    Public ReadOnly Property Password() As String
        Get
            Return Marshal.PtrToStringAuto(Marshal.SecureStringToBSTR(gPassword))
        End Get
    End Property

    Public Overloads Function ToString()
        Return String.Format("my name is {0}, pass is {1} ", Me.Name, Me.Password)
    End Function
End Class

测试：

Public Class Form1

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Dim t As User

        Dim helper As New LzmTW.uSystem.uReflection.TypeHelper(GetType(User))

        'create insatance
        t = CType(helper.NewInstance("LzmTW", "Hello"), User)

        Login(t)


    End Sub

    Private Sub Login(ByVal user As User)
        Console.WriteLine(user.ToString)
        Console.WriteLine()
    End Sub
End Class

结果：

my name is LzmTW, pass is Hello 

[水如烟]

下面所说的话是基于我不成熟的理解或说是孤陋寡闻的见识.

由于引入了反射,变量以及其它成员都不安全,这.NET是知道的。
在思考解决取得任意应用程序有关配置文件这个问题的过程中，我曾考虑按自己的需要来修改当前程序域(AppDomain.CurrentDomain)的配置信息,动手时才发现，这个极其关键的类，居然极少变量，多是用函数并且是内部函数（现在我没办法取到的函数）来充当变量的。Property值，也多是New 新实例的。所以对它我是无可奈何，这个问题也暂且罢手。要做，也只好重新实现它的代码的了。

[水如烟]

打算再说一下控件默认事件链这个问题,止贴.要说再另开贴吧,不过打算止住了.
因为想学学写写有关质量管理活动的东东。QC或TQC，你们应该少有接触这玩意，这是一般生产企业才有的，IT企业估计少有。

[wuyi8808]

好贴。可惜我是用C#的，不过.NET的道理是相通的。

[水如烟]

如何判断当前Office应用程序的版本信息

[水如烟]

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
            Dim mVer As String = String.Concat(ver.Major, ".", ver.Minor)
            Return String.Format(REGKEY_OFFICE_COMMON_VER, mVer)
        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 UILanguge() As CultureInfo
            Get
                Return CType(gInfos("UILanguge"), 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("UILanguage"), Integer)
            If mLcid = 0 Then
                mLcid = CType(mCommonKey.OpenSubKey("LanguageResources").GetValue("InstallLanguage"), Integer)
            End If
            gInfos("UILanguge") = 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

End Namespace

[水如烟]

测试

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", .UILanguge.Name & "(" & .UILanguge.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 Files\Microsoft Office\OFFICE11\
           UILanguge :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~1\MICROS~1\OFFICE11\EXCEL.EXE /automation
    Versions :11.0.0.0 12.0.0.0 

              OFFICE :
         InstallRoot :C:\Program Files\Microsoft Office\Office12\
           UILanguge :en-US(1033)
      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 Files\Microsoft Office\OFFICE11\
           UILanguge :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 Files\Microsoft Office\Office12\
           UILanguge :en-US(1033)
      ProductVersion :12.0.4017.1006
             Company :FKDL
            UserName :LzmTW


 ProductName :PowerPoint2007
       CLSID :91493441-5a91-11cf-8700-00aa0060263b
      ProgID :PowerPoint.Application.12
 LocalServer :C:\PROGRA~1\MICROS~1\OFFICE11\POWERPNT.EXE /AUTOMATION
    Versions :11.0.0.0 12.0.0.0 

              OFFICE :
         InstallRoot :C:\Program Files\Microsoft Office\Office12\
           UILanguge :en-US(1033)
      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 Files\Microsoft Office\Office12\
           UILanguge :en-US(1033)
      ProductVersion :12.0.4017.1006
             Company :FKDL
            UserName :LzmTW

[水如烟]

看上去Access2003有问题.

[水如烟]

注册表还真是如此,奇怪

[水如烟]

此项源码下载OfficeApplicationInfo