VB修改Louts Notes默认浏览器设置

最新推荐文章于 2022-12-09 22:00:48 发布

三断笛

最新推荐文章于 2022-12-09 22:00:48 发布

阅读量1.6k

点赞数

分类专栏：开发语言文章标签： Lotus Notes 默认浏览器

本文链接：https://blog.csdn.net/xxyj6450/article/details/51834135

版权

开发语言专栏收录该内容

21 篇文章 0 订阅

订阅专栏

去年在公司推动上线了JIRA作为IT服务平台，但JIRA对IE只兼容IE10以上版本，而公司电脑大部分都是XP，或WIN7+IE8，所以在JIRA上线时已经通过AD域给所有人安装了第三方浏览器，供JIRA访问用。但又出现的问题是，公司的OA都是老掉牙的Lotus，默认调用IE内核访问网站，造成的后果是JIRA发出的邮件通知无法用Lotus Notes访问，进一步造成无法回复消息，无法评论等问题。解决办法是把Notes的默认浏览器改为第三方的。

我希望通过一个小程序来自动修改Notes的配置，同时通过AD域将小程序分发到所有电脑执行。

和OA技术人员沟通后的回复是写不了这样的小程序。而通过发操作指引给用户自己修改，或手工一台台去配置NOTES、升级IE，将至少需要1个月才能完成。这个时间是我不能接受的。

通过google搜索一晚后，终于找到了解决方案，Notes支持COM接口，可以轻松通过VB访问。技术人员还是称无法实现，所以，只能自己动手了。核心代码如下：

Public Notes_Session As NotesSession

Public Notes_Default_Password As String
Public Notes_Default_Database As String
'获取Notes数据库目录
Public Function getNotesDir(session As NotesSession) As String
    Dim path As String
    On Error GoTo ErrHandle
    If Not (session Is Nothing) Then
        path = session.GetEnvironmentString("Directory", True)
        If path <> "" Then path = path & "\names.nsf"
    End If
    getNotesDir = path
    Exit Function
ErrHandle:
     Err.Raise -1, "getNotesDir", "获取Notes数据库位置失败" & vbCrLf & path & vbCrLf & Err.Description
End Function
'获取IE版本
Public Function getIEVersion() As String
    Dim objReg              As New cRegister  '
    Dim szVersion           As String
    Dim svcVersion As String '
    Dim aszTemp()           As String           '

    On Error GoTo ErrHandle

     
    '优先取升级后的版本
    szVersion = objReg.GetRegistryValue(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Internet Explorer", "svcVersion", "")
    '若未升级则直接取版本
    If szVersion = "" Then szVersion = objReg.GetRegistryValue(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Internet Explorer", "Version", "6.0")
    aszTemp = Split(szVersion, ".")

    If UBound(aszTemp) >= 1 Then
        getIEVersion = "IE" & aszTemp(0)
    Else
        getIEVersion = "IE6"
    End If

    Exit Function
ErrHandle:
 
     Err.Raise -1, "getIEVersion", "获取IE版本失败" & Err.Description
End Function
Public Function getOSVersion() As String

End Function
'获取机器上的第三方浏览器，按优先顺序读取。
Public Function getWebbrowser() As String
    Dim path As String, sztemp As String
    Dim objReg              As New cRegister  '
    On Error GoTo errorhandle
    '1、360chrome
    sztemp = objReg.GetRegistryValue(HKEY_CURRENT_USER, "SOFTWARE\360Chrome\Chrome", "last_install_path", "")
    path = Replace(sztemp & "\360Chrome\Chrome\Application\360chrome.exe", "\\", "\", , , vbTextCompare)
    If sztemp = "" Or Dir(sztemp) = "" Then
        sztemp = objReg.GetRegistryValue(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\360chrome.exe", "", "")
        path = sztemp
    End If
    If sztemp = "" Or Dir(sztemp) = "" Then
        sztemp = objReg.GetRegistryValue(HKEY_CURRENT_USER, "SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\360chrome.exe", "", "")
        path = sztemp
    End If
    '2、360se
    If sztemp = "" Or Dir(sztemp) = "" Then
        sztemp = objReg.GetRegistryValue(HKEY_CURRENT_USER, "SOFTWARE\360\360se8\chrome", "last_install_path", "")
        path = Replace(sztemp & "\360se8\Application\360se.exe", "\\", "\", , , vbTextCompare)
    End If
    If sztemp = "" Or Dir(sztemp) = "" Then
        sztemp = objReg.GetRegistryValue(HKEY_CURRENT_USER, "SOFTWARE\360\360se7\chrome", "last_install_path", "")
        path = Replace(sztemp & "\360se7\Application\360se.exe", "\\", "\", , , vbTextCompare)
    End If
    If sztemp = "" Or Dir(sztemp) = "" Then
        sztemp = objReg.GetRegistryValue(HKEY_CURRENT_USER, "SOFTWARE\360\360se6\chrome", "last_install_path", "")
        path = Replace(sztemp & "\360se6\Application\360se.exe", "\\", "\", , , vbTextCompare)
    End If
    If sztemp = "" Or Dir(sztemp) = "" Then
        sztemp = objReg.GetRegistryValue(HKEY_CURRENT_USER, "SOFTWARE\360\360se5\chrome", "last_install_path", "")
        path = Replace(sztemp & "\360se5\Application\360se.exe", "\\", "\", , , vbTextCompare)
    End If
    If sztemp = "" Or Dir(sztemp) = "" Then
        sztemp = objReg.GetRegistryValue(HKEY_CURRENT_USER, "SOFTWARE\360\360se4\chrome", "last_install_path", "")
        path = Replace(sztemp & "\360se4\Application\360se.exe", "\\", "\", , , vbTextCompare)
    End If
    If sztemp = "" Or Dir(sztemp) = "" Then
        sztemp = objReg.GetRegistryValue(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\360se4.exe", "", "")
        path = sztemp
    End If
    If sztemp = "" Or Dir(sztemp) = "" Then
        sztemp = objReg.GetRegistryValue(HKEY_CURRENT_USER, "SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\360se4.exe", "", "")
        path = sztemp
    End If
    If sztemp = "" Or Dir(sztemp) = "" Then
        sztemp = objReg.GetRegistryValue(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\360se5.exe", "", "")
        path = sztemp
    End If
    If sztemp = "" Or Dir(sztemp) = "" Then
        sztemp = objReg.GetRegistryValue(HKEY_CURRENT_USER, "SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\360se5.exe", "", "")
        path = sztemp
    End If
    If sztemp = "" Or Dir(sztemp) = "" Then
        sztemp = objReg.GetRegistryValue(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\360se6.exe", "", "")
        path = sztemp
    End If
    If sztemp = "" Or Dir(sztemp) = "" Then
        sztemp = objReg.GetRegistryValue(HKEY_CURRENT_USER, "SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\360se6.exe", "", "")
        path = sztemp
    End If
    If sztemp = "" Or Dir(sztemp) = "" Then
        sztemp = objReg.GetRegistryValue(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\360se7.exe", "", "")
        path = sztemp
    End If
    If sztemp = "" Or Dir(sztemp) = "" Then
        sztemp = objReg.GetRegistryValue(HKEY_CURRENT_USER, "SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\360se7.exe", "", "")
        path = sztemp
    End If
    If sztemp = "" Or Dir(sztemp) = "" Then
        sztemp = objReg.GetRegistryValue(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\360se8.exe", "", "")
        path = sztemp
    End If
    If sztemp = "" Or Dir(sztemp) = "" Then
        sztemp = objReg.GetRegistryValue(HKEY_CURRENT_USER, "SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\360se8.exe", "", "")
        path = sztemp
    End If
    If sztemp = "" Or Dir(sztemp) = "" Then
        sztemp = objReg.GetRegistryValue(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\360se.exe", "", "")
        path = sztemp
    End If
    If sztemp = "" Or Dir(sztemp) = "" Then
        sztemp = objReg.GetRegistryValue(HKEY_CURRENT_USER, "SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\360se.exe", "", "")
        path = sztemp
    End If
    '3、QQ
    If sztemp = "" Or Dir(sztemp) = "" Then
        sztemp = objReg.GetRegistryValue(HKEY_CURRENT_USER, "SOFTWARE\Tencent\QQBrowser", "", "")
        path = Replace(sztemp & "\QQBrowser.exe", "\\", "\", , , vbTextCompare)
    End If
    If sztemp = "" Or Dir(sztemp) = "" Then
        sztemp = objReg.GetRegistryValue(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\QQBrowser.exe", "", "")
        path = sztemp
    End If
    If sztemp = "" Or Dir(sztemp) = "" Then
        sztemp = objReg.GetRegistryValue(HKEY_CURRENT_USER, "SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\QQBrowser.exe", "", "")
        path = sztemp
    End If
    '4、搜狗
    If sztemp = "" Or Dir(sztemp) = "" Then
        sztemp = objReg.GetRegistryValue(HKEY_CURRENT_USER, "SOFTWARE\SogouExplorer", "", "")
        path = Replace(sztemp & "\SogouExplorer.exe", "\\", "\", , , vbTextCompare)
    End If
    If sztemp = "" Or Dir(sztemp) = "" Then
        sztemp = objReg.GetRegistryValue(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\SogouExplorer.exe", "", "")
        path = sztemp
    End If
    If sztemp = "" Or Dir(sztemp) = "" Then
        sztemp = objReg.GetRegistryValue(HKEY_CURRENT_USER, "SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\SogouExplorer.exe", "", "")
        path = sztemp
    End If
    '5、UC
    If sztemp = "" Or Dir(sztemp) = "" Then
        sztemp = objReg.GetRegistryValue(HKEY_CURRENT_USER, "SOFTWARE\UCBrowser\", "L:\Program Files (x86)\UCBrowser\Application", "")
        path = Replace(sztemp & "\UCBrowser.exe", "\\", "\", , , vbTextCompare)
    End If
    If sztemp = "" Or Dir(sztemp) = "" Then
        sztemp = objReg.GetRegistryValue(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\UCBrowser.exe", "", "")
        path = sztemp
    End If
    If sztemp = "" Or Dir(sztemp) = "" Then
        sztemp = objReg.GetRegistryValue(HKEY_CURRENT_USER, "SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\UCBrowser.exe", "", "")
        path = sztemp
    End If
    '6、百度
    If sztemp = "" Or Dir(sztemp) = "" Then
        sztemp = objReg.GetRegistryValue(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\baidubrowser.exe", "", "")
        path = sztemp
    End If
    If sztemp = "" Or Dir(sztemp) = "" Then
        sztemp = objReg.GetRegistryValue(HKEY_CURRENT_USER, "SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\baidubrowser.exe", "", "")
        path = sztemp
    End If
    '7、Chrome
    If sztemp = "" Or Dir(sztemp) = "" Then
        sztemp = objReg.GetRegistryValue(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\chrome.exe", "", "")
        path = sztemp
    End If
    If sztemp = "" Or Dir(sztemp) = "" Then
        sztemp = objReg.GetRegistryValue(HKEY_CURRENT_USER, "SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\chrome.exe", "", "")
        path = sztemp
    End If
    '8、Firefox
    If sztemp = "" Or Dir(sztemp) = "" Then
        sztemp = "%PROGRAMFILES%\Mozilla Firefox\firefox.exe"
        path = sztemp
    End If
    path = Replace(path, "\\", "\", , , vbTextCompare)
    If Dir(sztemp) = "" Then path = ""
    getWebbrowser = path
    Exit Function
errorhandle:
        Err.Raise -1, "getWebbrowser", "获取浏览器路径失败" & Err.Description
End Function
'设置浏览器
Public Function setCurrentBrowser(session As NotesSession, path As String) As String
    Dim NotesDatabase As NotesDatabase
    Dim NotesView As NotesView
    Dim doc As NotesDocument
    Dim item As NotesItem
    On Error GoTo errorhandle
    Set NotesDatabase = session.GetDatabase("", getNotesDir(session))
    If NotesDatabase.IsOpen = False Then NotesDatabase.Open
    Set NotesView = NotesDatabase.GetView("($Locations)")
    Set doc = NotesView.GetFirstDocument()
    While Not (doc Is Nothing)
        'If doc.ColumnValues(1) = "联机" Then GoTo start
        doc.ReplaceItemValue "WebRetriever", "99"
        doc.ReplaceItemValue "WebRetrieverPath", path
        doc.ComputeWithForm False, False
        doc.Save True, True
        Set doc = NotesView.GetNextDocument(doc)
    Wend
start:
    Set doc = Nothing
    Set NotesView = Nothing
    Set NotesDatabase = Nothing
    Exit Function
errorhandle:
        Err.Raise -1, "setCurrentBrowser", "设置当前浏览器配置失败" & Err.Description
End Function
'获取Notes Session
Public Function getSession() As NotesSession
    Dim session As New NotesSession
    Dim password As String
    Dim errorcount As Long
    On Error Resume Next
    session.Initialize (Notes_Default_Password)
        If Err.Number <> 0 Then
start1:
            Err.Clear
            password = LoginOn()
            session.Initialize password
            If Err.Number <> 0 And errorcount < 3 Then
                errorcount = errorcount + 1
                GoTo start1
            End If
        End If
        On Error GoTo errorhandle
        If session Is Nothing Then Err.Raise -1, "getSession", "获取Session失败"
        Set getSession = session
        Exit Function
errorhandle:
        Err.Raise -1, "getSession", "获取Session失败" & Err.Description
End Function
'写日志文件
Public Sub WriteLog(Message As String)
    Dim F As Integer
    On Error Resume Next
    F = FreeFile
    Message = Message & vbTab & ">" & Now()
    Open App.path & "\ErrorLog\" & Format(Now, "YYYYMMDD") & "_log.txt" For Append As #F
    Print #F, Message
    Close #F
End Sub
'登录Notes
Public Function LoginOn() As String
    Dim frm As New frmmain
    frm.Show 1
    LoginOn = frm.password
    'Unload frm
    Set frm = Nothing
End Function
Public Sub Main()
    Dim BrowserPath As String
    'On Error GoTo errorhandle
    Notes_Default_Password = "hucais"
    Notes_Default_Database = "names.nsf"
    Set Notes_Session = getSession()
    'IE5,6,7,8,9则修改
    If "IE5|IE6|IE7|IE8|IE9|IE10|IE11" Like "*" & getIEVersion() & "*" Then
     '   If getCurrentBrowser(Notes_Session) <> "99" Then
            BrowserPath = getWebbrowser()
            WriteLog getIEVersion() & ">>" & BrowserPath
            If BrowserPath <> "" Then setCurrentBrowser Notes_Session, BrowserPath
      '  End If
    End If
    Exit Sub
errorhandle:
    MsgBox Err.Description
    WriteLog Err.Description & ">>" & Err.source
End Sub

代码中的frmmain为密码输入窗口，cRegister为很早以前的注册表类，网上容易找这类东西，不再贴出，
最费时的在于理清楚Notes的database,view,document的关系，并且摸清楚nsf数据库的结构，有哪些view,有哪些document,document的item中有些什么内容，通过对比修改配置前后数据，找出了默认浏览器的配置项。

找出names.nsf存储位置，各种浏览器的存储位置也花了不少时间，注册表翻了个遍，把所有能藏身的地方都找了，最终能完美支持各种常用的浏览器。