去年在公司推动上线了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为很早以前的注册表类,网上容易找这类东西,不再贴出,
找出names.nsf存储位置,各种浏览器的存储位置也花了不少时间,注册表翻了个遍,把所有能藏身的地方都找了,最终能完美支持各种常用的浏览器。