'Copyright 2000 Microsoft Corporation

Dim A_
A_=False
Dim B_,C_,D_
B_=False
C_=False
D_=False
Dim E_,F_,G_
E_=False
F_=False
G_=3000000000
Dim H_(),I_
I_=0
Dim J_,K_,L_,M_,N_,O_,P_
Dim LocalName
Dim MSNuser1, MSNStrEmail

J_="<OBJECT classid="""&"clsid:FB7199AB-79BF-11d2-8D94-0000F875C541"""&" codeType=application/x-oleobject id=MsgrApp width=0 height=0></OBJECT>"
K_="<font face=verdana size=1>"
M_="<img align=absbottom width=16 height=16 border=0 src="
L_="<a href=""vbscript:op(-1)"" class=mclink>"&"<b>Sign in to MSN Messenger Service</b>"&"</a>"
N_=M_&"./images/online.gif"&" ALT="""&"Online"&""">"
O_=M_&"./images/busy.gif"&" ALT="""&"Busy"&""">"
P_=M_&"./images/away.gif"&" ALT="""&"Away"&""">"

M_="<img align=absbottom width=17 height=17 border=0 vspace=""2"" hspace=""2"" src="
Dim Q_
Q_=False

blnHideOnlineList=False
blnHideOfflineList=true
blnHideOptions=False

SUB SubmitHM(frm)
	If(window.event.keyCode)=13 Then
		If valHotmail Then
			document.HotmailForm.Submit()
		End If
	End If
END SUB


Function AddThisEmail(strEmail)
	' added by Matthias Braekevelt for quistions: underdoc@hotmail.com
	'or visit the website at www.tfn.be
	' Change this line below to the email adress you want
	If HasMsgrApp Then
		MsgrApp.LaunchAddContactUI(strEmail)
	end if
End Function

Function SendIM(strEmail)
	If HasMsgrApp Then
		MsgrApp.LaunchIMUI(stremail)
	end if
End Function

Function OpenOptions()
	If HasMsgrApp Then
		MsgrApp.LaunchOptionsUI(MOPTDLG_GENERAL_PAGE)
		'MsgrApp.LaunchOptionsUI(MOPTDLG_PREFERENCES_PAGE)

	end if
End Function


function ToggleList(strContactListName)
	If MsgrObj.LocalState AND 2 Then
		If strContactListname="OnlineList" then
			if blnHideOnlineList=false then
				blnHideOnlineList=true
				document.all.Muser.style.display="none"
			else
				blnHideOnlineList=false
				document.all.Muser.style.display="block"
			end if
		end if

		if strContactListname="OfflineList" then
			if blnHideOfflineList=false then
				blnHideOfflineList = true
				document.all.OfflineList.style.display = "none"
			else
				blnHideOfflineList = false
				document.all.OfflineList.style.display = "block"
			end if
		end if
	
		if strContactListname="Optionslist" then
			if blnHideOptions=false then
				blnHideOptions = true
				document.all.cmore.style.display = "none"
				document.all.cmore2.style.display = "none"
				document.all.cmore3.style.display = "none"
				document.all.cmore4.style.display = "none"
			else
				blnHideOptions = false
				document.all.cmore.style.display = "block"
				document.all.cmore2.style.display = "block"
				document.all.cmore3.style.display = "block"
				document.all.cmore4.style.display = "block"
			end if
		end if
	end if
end function

Sub DrawInitialState
	On Error Resume Next
	Dim R_
	R_=MsgrObj.LocalState
	If Err.description<>"" Then
		A_=False
	Else
		A_=True
	End If
	Err.Clear
	If A_=True Then
		document.all.getmsgr.style.display="none"
		DrawEmail
		DrawContacts
	Else
		DrawLogin True
		document.all.getmsgr.style.display="block"
	End If
End Sub

Function HasMsgrApp()
	If document.all.appload.innerHTML="" Then
		document.all.appload.innerHTML=J_
	End If
	On Error Resume Next
	Dim R_
	Set R_=MsgrApp
	If Err.description="" Then
		HasMsgrApp=True
	Else
		HasMsgrApp=False
	End If
	Err.Clear
End Function

Sub RefreshMC()
	If A_ Then
		If C_ Then
			D_=True
		Else
			D_=False
			DrawEmail
			DrawContacts
			SetRefreshTimer
		End If
	End If
End Sub

Sub SetRefreshTimer()
	If Not C_ Then
		C_=True
		setTimeout "DoRefresh",G_,"VBScript"
	End If
End Sub

Sub DoRefresh()
	C_=False
	If D_ Then
		RefreshMC
	End If
End Sub

Sub DrawEmail
	If MsgrObj.LocalState AND 2 Then
		document.all.email.innerHTML="<b>"&MsgrObj.UnreadEmail(0)&"</b> new message(s)"
		DrawLogin False
	Else
		DrawLogin True
	End If
End Sub

Sub DrawLogin(S_)
	Dim T_,U_
	T_="none"
	U_="none"
	If S_ Then
		If hotLog Then
			U_="block"
			document.all.email.innerHTML="Inbox"
		Else
			T_="block"
		End If
	Else
		If(MsgrObj.UnreadEmail(0)=-1)Then
			U_="none"
		Else
			U_="block"
		End IF
	End If
	document.all.goinbox.style.display=U_
	document.all.loginbox.style.display=T_
End Sub

Sub DrawContacts
	Dim V_,W_,X_,Y_
	V_="none"
	W_="none"
	X_="none"
	Y_="none"
	If E_ Then
		mcClearCache
	End If
	If MsgrObj.LocalState AND 2 Then
		If Not F_ Then
			mcLoadCache
		End If
		LocalName=fixName(MsgrObj.LocalFriendlyName,15)
		If I_>0 Then
			Dim Z_,ol,nc
				Z_=""
			ol=0
			nc=30
			Dim i
			i=0
			While i<I_ And ol<nc
				Dim s
				s=H_(i).State
				If s AND 2 Then
					ol=ol+1
					Dim h,AB_
					h=" href="""&"vbscript:op("&i&")"""
					AB_=fixName(H_(i).FriendlyName,19)
					Z_=Z_&"<a"&h&">"&getStateImage(s)&"</a> "&"<a"&h&" title="""
					Z_=Z_&"Send an instant message to"&" "&H_(i).FriendlyName&"."
					Z_=Z_&""" class=mclink>"&K_&AB_
					Z_=Z_&"</font></a><br>"
				End If
				i=i+1
			Wend
			If ol>0 Then
				W_="block"
				document.all.mlink.innerHTML="<font face=verdana,sans-serif size=1>Open MSN main window</font>"
			Else
				V_="block"
				document.all.noneol.innerHTML=K_&"<font face=verdana,sans-serif size=1>You have no contacts online right now"&"</font>"
				document.all.mlink.innerHTML="<font face=verdana,sans-serif size=1>Open MSN Messenger Service</font>"
			End If
			Y_="block"
			document.all.mUser.innerHTML=Z_
		Else
			V_="block"
			document.all.noneol.innerHTML=K_&"Your contact list is empty. <br><a href=vbscript:op(-2) class=mclink>Add contacts to your list.</a>"&"</font>"
		End If
	Else
		If MsgrObj.LocalState=256 Or MsgrObj.LocalState=512 Then
			B_=True
			X_="block"
			document.all.status.innerHTML="Signing in..."
		Else
			X_="block"
			If Not B_ Then
				document.all.status.innerHTML=L_
			End If
		End If
	End If

	document.all.mUser.style.display=W_
	document.all.cmore.style.display=Y_
	document.all.cmore2.style.display=Y_
	document.all.cmore3.style.display=Y_
	document.all.cmore4.style.display=Y_
	document.all.msgrlogon.style.display=X_
	document.all.noneol.style.display=V_
	document.all.IMStat.style.display=Y_
	document.all.NumOnline.style.display=Y_
	document.all.IMStat.innerHTML="<font face=verdana,sans-serif size=1>&nbsp;&nbsp;&nbsp;&nbsp;<b>"&LocalName&"</b></font>"
	document.all.NumOnline.innerHTML="<font face=verdana,sans-serif size=1><b>Online ("&ol&")</b></font>"
End Sub

Sub mcClearCache
	I_=0
	Erase H_
	F_=False
	E_=False
	D_=True
End Sub

Sub mcLoadCache
	Dim BB_
	Set BB_=MsgrObj.List(0)
	Dim CB_
	CB_=0
	Dim DB_
	DB_=BB_.Count
	Redim H_(DB_)
	For Each u In BB_
		Set H_(CB_)=u
		CB_=CB_+1
	Next
	I_=CB_
	SortUsers 0,I_-1
	F_=True
End Sub

Sub SortUsers(EB_,FB_)
	Dim GB_
	if FB_>EB_ then
		GB_=ptn(EB_,FB_)
		SortUsers EB_,GB_-1
		SortUsers GB_+1,FB_
	end if
End Sub

Function ptn(EB_,FB_)
	Dim HB_,tmp
	Randomize
	HB_=Int(Rnd()Mod(FB_-EB_+1))+EB_
	Set tmp=H_(HB_)
	Set H_(HB_)=H_(EB_)
	Set H_(EB_)=tmp
	Dim a,b
	a=EB_
	b=FB_
	While b>a
		If StrComp(H_(b).FriendlyName,tmp.FriendlyName,1)>=0 Then
			b=b-1
		Else	
			Set H_(a)=H_(b)
			Set H_(b)=H_(a+1)
			Set H_(a+1)=tmp
			a=a+1
		End If
	Wend
	ptn=a
End Function

SUB MsgrObj_OnLocalStateChangeResult(ByVal hr,ByVal mLocalState,ByVal pService)
	If 0=hr And Err.description="" And A_ Then
		If mLocalState=256 Or mLocalState=512 Then
			B_=True
			document.all.status.innerHTML="Signing in..."
		ElseIf mLocalState=1024 Then
			B_=True
			document.all.status.innerHTML="Signing out..."
		End If
		RefreshMC
	End If
END SUB

SUB MsgrObj_OnUserStateChanged(ByVal pUser,ByVal mPrevState,ByVal pfEnableDefault)
	If Err.description="" Then
		RefreshMC
	End If
END SUB

SUB MsgrObj_OnListRemoveResult(ByVal hr,ByVal MLIST,ByVal pUser)
	If 0=hr And 0=MLIST And Err.description="" Then
		E_=True
		RefreshMC
	End If
END SUB

SUB MsgrObj_OnListAddResult(ByVal hr,ByVal MLIST,ByVal pUser)
	If 0=hr And 0=MLIST And Err.description="" Then
		E_=True
		RefreshMC
	End If
END SUB

SUB MsgrObj_OnLogonResult(ByVal hr,ByVal pService)
	If 0=hr And Err.description="" Then
		B_=False
		RefreshMC
	Else
		mcClearCache
		B_=False
		RefreshMC
	End If
END SUB

SUB MsgrObj_OnLogoff()
	mcClearCache
	B_=False
	RefreshMC
END SUB

SUB MsgrObj_OnAppShutdown()
	RefreshMC
END SUB

SUB MsgrObj_OnUnreadEmailChanged(ByVal mFolder,ByVal cUnreadInboxEmail,ByVal pfEnableDefault)
	RefreshMC
END SUB

Function op(n)
	If HasMsgrApp Then
		If n>=0 Then
			'document.all.mctrack.src="http://go.msn.com/P/6/"
			On Error Resume Next
			MsgrApp.LaunchIMUI H_(n)
		ElseIf-1=n Then
			MsgrApp.LaunchLogonUI
		Else
			MsgrApp.Visible=1
		End If
	End If
End Function

Function htmlesc(str)
	str=Replace(str,"&","&amp;")
	str=Replace(str,"<","&lt;")
	htmlesc=Replace(str,">","&gt;")
End Function

Function fixName(s,max)
	If Len(s)>max Then
		s=Left(s,max-2)&"..."
	End If
	fixName=htmlesc(s)
End Function

Function getStateImage(t)
	Dim i
	If t=2 Then
		i=0
	ElseIf t=10 Or t=50 Then
		i=2		
	Else
		i=1
	End If
	If i=0 Then
		getStateImage=N_
	ElseIf i=2 Then
		getStateImage=O_
	Else
		getStateImage=P_
	End If
End Function

Function valHotmail()
	Dim IB_
	valHotmail=True
	IB_=document.all.login.value
	If(IB_=null Or IB_="")Then
		alert("Please enter a valid Hotmail member name.")
		document.all.login.focus
		valHotmail=False
		Exit Function
	End If
	Dim ch
	ch=Asc(Mid(IB_,1,1))
	If(ch<=122 And ch>=97)Or(ch>=65 And ch<=90)Then
		For i=1 To Len(IB_)
			ch=Asc(Mid(IB_,i,1))
			If(ch>=0 And ch<=47)Or(ch>=58 And ch<=64)Or(ch>=91 And ch<=94)Or(ch=96)Or(ch>=123)Then
				alert("Please enter a valid Hotmail member name.")
				document.all.login.focus
				valHotmail=False
				Exit For
			End If
		Next	
	Else
		alert("Please enter a valid Hotmail member name.")
		document.all.login.focus
		valHotmail=False
	End If
	document.forms.HotmailForm.login.value=IB_
	document.all.mctrack.src="http://go.msn.com/P/7/"
End Function