'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_=3000
Dim H_(),I_
I_=0
Dim J_,K_,L_,M_,N_,O_,P_
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=17 border=0 src="
L_="<a href=""vbscript:op(-1)"" class=mclink>"&"Sign in to MSN Messenger Service"&"</a>"
N_=M_&"http://msimg.com/w/msgr/online1.gif"&" ALT="""&"Online"&""">"
O_=M_&"http://msimg.com/w/msgr/busy1.gif"&" ALT="""&"Busy"&""">"
P_=M_&"http://msimg.com/w/msgr/idle1.gif"&" ALT="""&"Away"&""">"
M_="<img align=absbottom width=16 height=17 border=0 src="
Dim Q_
Q_=False
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> Nuovi Messaggi"
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_
document.all.emailhdr.style.display=U_
document.all.emailsep.style.display=U_
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
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,130)
Z_=Z_&"<a"&h&">"&getStateImage(s)&"</a> "&"<a"&h&" title="""
Z_=Z_&"Invia Messaggio instantaneo a"&" "&AB_&"."
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><b><i>Apri MSN Messenger in una nuova finestra</i></b></font>"
Else
V_="block"
document.all.noneol.innerHTML=K_&"Non ci sono persone nei tuoi contatti on line"&"</font>"
document.all.mlink.innerHTML="<font face=verdana,sans-serif size=1>Apri 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.msgrlogon.style.display=X_
document.all.noneol.style.display=V_
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("Inserire un Membro Hotmail Valido.")
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("Inserire il nome del Membro Hotmail.")
document.all.login.focus
valHotmail=False
Exit For
End If
Next
Else
alert("Inserire il nome del Membro Hotmail.")
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