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

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

去年在公司推动上线了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 NotesSessionPublic Notes_Default_Password As StringPublic 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 FunctionErrHandle:     Err.Raise -1,"getNotesDir","获取Notes数据库位置失败" & vbCrLf & path & vbCrLf & Err.DescriptionEnd 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,"Version","6.0")    aszTemp = Split(szVersion,".")    If UBound(aszTemp) >= 1 Then        getIEVersion = "IE" & aszTemp(0)    Else        getIEVersion = "ie6"    End If    Exit FunctionErrHandle:      Err.Raise -1,"getIEVersion","获取IE版本失败" & Err.DescriptionEnd FunctionPublic Function getosversion() As StringEnd 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,"SOFTWARE0Chrome\Chrome","last_install_path","")    path = Replace(sztemp & "0Chrome\Chrome\Application0Chrome.exe","\","\",vbTextCompare)    If sztemp = "" Or Dir(sztemp) = "" Then        sztemp = objReg.GetRegistryValue(HKEY_LOCAL_MACHINE,"SOFTWARE\Microsoft\windows\CurrentVersion\App Paths0Chrome.exe","","")        path = sztemp    End If    If sztemp = "" Or Dir(sztemp) = "" Then        sztemp = objReg.GetRegistryValue(HKEY_CURRENT_USER,"")        path = sztemp    End If    '2、360se    If sztemp = "" Or Dir(sztemp) = "" Then        sztemp = objReg.GetRegistryValue(HKEY_CURRENT_USER,"SOFTWARE00se8\Chrome","")        path = Replace(sztemp & "0se8\Application0se.exe",vbTextCompare)    End If    If sztemp = "" Or Dir(sztemp) = "" Then        sztemp = objReg.GetRegistryValue(HKEY_CURRENT_USER,"SOFTWARE00se7\Chrome","")        path = Replace(sztemp & "0se7\Application0se.exe","SOFTWARE00se6\Chrome","")        path = Replace(sztemp & "0se6\Application0se.exe","SOFTWARE00se5\Chrome","")        path = Replace(sztemp & "0se5\Application0se.exe","SOFTWARE00se4\Chrome","")        path = Replace(sztemp & "0se4\Application0se.exe",vbTextCompare)    End If    If sztemp = "" Or Dir(sztemp) = "" Then        sztemp = objReg.GetRegistryValue(HKEY_LOCAL_MACHINE,"SOFTWARE\Microsoft\windows\CurrentVersion\App Paths0se4.exe","")        path = sztemp    End If    If sztemp = "" Or Dir(sztemp) = "" Then        sztemp = objReg.GetRegistryValue(HKEY_LOCAL_MACHINE,"SOFTWARE\Microsoft\windows\CurrentVersion\App Paths0se5.exe","SOFTWARE\Microsoft\windows\CurrentVersion\App Paths0se6.exe","SOFTWARE\Microsoft\windows\CurrentVersion\App Paths0se7.exe","SOFTWARE\Microsoft\windows\CurrentVersion\App Paths0se8.exe","SOFTWARE\Microsoft\windows\CurrentVersion\App Paths0se.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","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","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","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    '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    '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 Functionerrorhandle:        Err.Raise -1,"getWebbrowser","获取浏览器路径失败" & Err.DescriptionEnd 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)    Wendstart:    Set doc = nothing    Set NotesVIEw = nothing    Set NotesDatabase = nothing    Exit Functionerrorhandle:        Err.Raise -1,"setCurrentbrowser","设置当前浏览器配置失败" & Err.DescriptionEnd Function'获取Notes SessionPublic 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 Thenstart1:            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 Functionerrorhandle:        Err.Raise -1,"获取Session失败" & Err.DescriptionEnd 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 #FEnd Sub'登录NotesPublic Function Loginon() As String    Dim frm As New frmmain    frm.Show 1    Loginon = frm.password    'Unload frm    Set frm = nothingEnd FunctionPublic 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 Suberrorhandle:    MsgBox Err.Description    WriteLog Err.Description & ">>" & Err.sourceEnd Sub

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

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

总结

以上是内存溢出为你收集整理的VB修改Louts Notes默认浏览器设置全部内容，希望文章能够帮你解决VB修改Louts Notes默认浏览器设置所遇到的程序开发问题。

如果觉得内存溢出网站内容还不错，欢迎将内存溢出网站推荐给程序员好友。