' 發展單位：風禹科技驗證有限公司
' 撰寫人：鄭子璉(Tzu-Lien, Cheng, 璉璉) ，成大水利博肄，微軟最有價值專家
' Web: http://tlcheng.twbbs.org/TLCheng/ E-Mail: qvb3377@ms5.hinet.net
' --------------------------------------------------------------------------------------

Module modShellObject
	Public Enum EnumShellWindows As Integer
		FileExplorer = 1 ' 檔案總管
		InternetExplorer = 2	' IE
		Others = 4
		All = -1
	End Enum

	Private Enum Bits As Integer
		' 對應 EnumShellWindows
		LBound = 0
		UBound = 2
	End Enum

	Private m_Shell As Object
	Private arrEnumWindows() As String = {"explorer.exe", "iexplore.exe", ""}

	Public Function GetUrlFromInternetExplorerObject(Optional ByVal nFlags As EnumShellWindows = EnumShellWindows.All) As String()
		Dim arrIE As Object = GetInternetExplorerObject(nFlags)
		Dim ubu As Integer = UBound(arrIE)
		Dim arrUrl(ubu) As String
		Dim ibu As Integer

		For ibu = 0 To ubu
			arrUrl(ibu) = arrIE(ibu).LocationURL
		Next

		Return arrUrl
	End Function

	Public Function GetInternetExplorerObject(Optional ByVal nFlags As EnumShellWindows = EnumShellWindows.All) As Object()
		Dim oShell As Object = CreateShellObject()
		Dim sw As Object = oShell.Windows()
		Dim ie As Object
		Dim rtnObject(sw.Count) As Object
		Dim nCount As Integer = -1
		Dim ibe As EnumShellWindows

		For Each ie In sw
			ibe = GetInternetObjectFlags(ie)
			If ibe And nFlags Then
				nCount += 1
				rtnObject(nCount) = ie
			End If
		Next

		ReDim Preserve rtnObject(nCount)
		Return rtnObject
	End Function

	Private Function GetInternetObjectFlags(ByVal objIE As Object) As EnumShellWindows
		Dim ibs As Integer
		Dim rtnValue As EnumShellWindows

		For ibs = Bits.LBound To Bits.UBound - 1
			rtnValue = 2 ^ ibs
			If InStr(LCase(objIE.FullName), arrEnumWindows(ibs)) > 0 Then
				Exit For
			End If
		Next

		Return rtnValue
	End Function

	Public Function CreateShellObject()
		If IsNothing(m_Shell) Then
			m_Shell = CreateObject("Shell.Application")
		End If
		Return m_Shell
	End Function

	Public Sub DisposeShellObject()
		If Not IsNothing(m_Shell) Then
			m_Shell = Nothing
		End If
		m_Shell.Dispose()
	End Sub
End Module