作者：5jscript 时间：2004-2-26 文档类型：原创 来自：蓝色理想浏览统计 year:9265 | Quarter:753 | Month:44 | Week:64 | today:8
[Ctrl+A 全部选择 提示：你可先修改部分代码，再按运行]
运行代码框<script language="Javascript"> function ShowMessenger() { if (messengerUI.object != null) { var MsgrWindow if (messengerUI.myStatus == 2) { MsgrWindow = messengerUI.window; MsgrWindow.show(); } else messengerUI.Signin(0,"",""); } } function ShowElement(element) { element.style.display=""; document.msn.offline.value="ON"; } function HideElement(element) { //rowShow.style.visibility="hidden"; element.style.display="none"; document.msn.offline.value="OFF"; } function ShowHide(element) { if (document.msn.offline.value=="ON") { HideElement(element); } else { ShowElement(element); } } </script> <style type="text/css"> <!-- .small { font-size: 11px; font-family: Verdana, Arial, Helvetica, sans-serif} body { font-family: Verdana, Arial, Helvetica, sans-serif} a { color:#3D55C4 ; text-decoration: none} a:link { color:#3D55C4 ; text-decoration: none} a:hover { color:#000000 ; text-decoration: none} --> </style> </head> <body bgcolor="#FFFFFF" text="#000000" vlink="##3D55C4" onclick="(mUser.innerHTML)"> <table cellpadding="1" cellspacing="1" bgcolor="#3D55C4" width="150" id="abc"> <script language="VBScript" id="mcvbs"> ' this script is loosely based on the original script from Microsoft. ' Various flags and such for god-knows what... Dim A_ A_=False Dim B_,C_,D_ B_=False C_=False D_=False Dim E_,F_,G_ E_=False F_=False G_=3000 ' Ooohhh! I know what this is! This is the amount of milliseconds for refresh Dim H_(),I_ ' H_() is an object array of users. This is also the cache I_=0 ' Variables for different links to different images representing state in Messenger... I think Dim J_,K_,L_,M_,N_,O_,P_,OffL J_="<OBJECT classid="""&"clsid:FB7199AB-79BF-11d2-8D94-0000F875C541"""&" codeType=application/x-oleobject id=MsgrApp width=0 height=0></OBJECT>" K_="<font class=""small"">" M_="<img align=absbottom width=16 height=17 border=0 src=" L_="<br><b> <a href=""vbscript:op(-1)"" class=""color""><img src='msn_icons/msn_ppl.gif' border='0' alt=''>"&" Sign in now... "&"</a></b>" N_=M_&"msn_icons/online1.gif"&" ALT="""&"Online"&""">" O_=M_&"msn_icons/busy1.gif"&" ALT="""&"Busy"&""">" P_=M_&"msn_icons/idle1.gif"&" ALT="""&"Away"&""">" 'Added by JH OffL = M_&"msn_icons/offline1.gif"&" ALT="""&"Offline"&""">" M_="<img align=absbottom width=16 height=17 border=0 src=" Dim Q_ Q_=False Dim ttl ttl=0 ' added arrays for online and offline contacts Dim OnA() ' online contacts Dim OffA() ' offline contacts ' counters for amount of online and offline Dim OnCtr OnCtr=0 Dim OffCtr OffCtr=0 ' Online/Offline? Sub DrawInitialState On Error Resume Next Dim R_ R_=MsgrObj.LocalState If Err Then A_=False Else A_=True End If Err.Clear If A_=True Then document.all.getmsgr.style.display="none" DrawContacts Else document.all.getmsgr.style.display="block" End If End Sub Function HasMsgrApp() appload.innerHTML = J_ 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 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 DrawContacts '******************************************************************** ' Modified by JH ' DrawContacts: ' On Error Resume Next ' new list of contacts to iterate thru ' ctr for list loop Dim i i = 0 ' strings for output Dim z, zz z="" zz="" ' for div visibility Dim mU,mO,msgL,noneL,notOn,onli mU="none" mO="none" msgL="none" noneL="none" notOn="block" onli="block" If E_ Then mcClearCache End If ' The heart of the matter If MsgrObj.LocalState And 2 Then 'Online If Not F_ Then mcLoadCache End If If I_>0 Then For i = 0 To ttl select case H_(i).State case 1 OffCtr = OffCtr + 1 case else OnCtr = OnCtr + 1 end select Next ReDim OnA(OnCtr) ReDim OffA(OffCtr) OnCtr = 0 OffCtr = 0 ' loop to get FriendlyNames of contacts and put them in their respective arrays For i = 0 To ttl If H_(i).State=1 then Set OffA(OffCtr)=H_(i) OffCtr = OffCtr + 1 Else Set OnA(OnCtr) = H_(i) OnCtr = OnCtr + 1 End If Next ' sort online users SortUsers2 0,OnCtr-1,True For i = 0 to OnCtr-1 Dim onl Dim h onl="" h="" h = " href='VBScript:op(" & i & ")'" onl = fixName(OnA(i).FriendlyName,17) z = z & "<a" & h & " class=""color"">" & getStateImage(OnA(i).State) & "</a> " & "<a " & h & " title=""" z = z & "Send an instant message to " & onl & "." z = z & """ class=""color"">" & K_ & onl z = z & "</font></a><br>" Next ' sort offline users SortUsers2 0,OffCtr-1,False For i = 0 to OffCtr-1 Dim ofn ofn="" ofn = fixName(OffA(i).FriendlyName,17) zz = zz & getStateImage(OffA(i).State) & " " zz = zz & K_ & ofn & "<br>" Next if OnCtr > 0 Then mU="block" mO="block" document.all.mUser.innerHTML=z document.all.mOff.innerHTML=zz else mU="block" mO="block" document.all.mUser.innerHTML="<font class=""small"">None</font>" document.all.mOff.innerHTML=zz end if Else noneL="block" document.all.noneol.innerHTML=K_&"Your contact list is empty. <br><a href=vbscript:op(-2) class=""color"">Add contacts to your list.</a>"&"</font>" end if Else If MsgrObj.LocalState=256 Or MsgrObj.LocalState=512 Then msgL="block" notOn="none" onli="none" B_ = True document.all.statu.innerHTML = "<br> <img src='msn_icons/msn_ppl.gif' border='0' alt=''> <b>Connecting...</b></div>" Else msgL="block" notOn="none" onli="none" if Not B_ Then document.all.statu.innerHTML = L_ End If End If End If document.all.Online.style.display=onli document.all.mUser.style.display=mU document.all.notOnline.style.display=notOn document.all.mOff.style.display=mO document.all.msgrlogon.style.display=msgL document.all.noneol.style.display=noneL End Sub Sub mcClearCache I_=0 Erase H_ Erase OnA Erase OffA 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 ttl=DB_ -1 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 ' Added by JH ' Sorts Online/Offline users Sub SortUsers2(EB_,FB_,IsOn) Dim GB_ if(IsOn) then if FB_>EB_ then GB_=ptnOn(EB_,FB_) SortUsers2 EB_,GB_-1,True SortUsers2 GB_+1,FB_,True end if else if FB_>EB_ then GB_=ptnOff(EB_,FB_) SortUsers2 EB_,GB_-1,False SortUsers2 GB_+1,FB_,False end if end if 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 ' Added by JH ' Function ptnOn(EB_,FB_) Dim HB_,tmp Randomize HB_=Int(Rnd()Mod(FB_-EB_+1))+EB_ Set tmp=OnA(HB_) Set OnA(HB_)=OnA(EB_) Set OnA(EB_)=tmp Dim a,b a=EB_ b=FB_ While b>a If StrComp(OnA(b).FriendlyName,tmp.FriendlyName,1)>=0 Then b=b-1 Else Set OnA(a)=OnA(b) Set OnA(b)=OnA(a+1) Set OnA(a+1)=tmp a=a+1 End If Wend ptnOn=a End Function ' Added by JH ' Function ptnOff(EB_,FB_) Dim HB_,tmp Randomize HB_=Int(Rnd()Mod(FB_-EB_+1))+EB_ Set tmp=OffA(HB_) Set OffA(HB_)=OffA(EB_) Set OffA(EB_)=tmp Dim a,b a=EB_ b=FB_ While b>a If StrComp(OffA(b).FriendlyName,tmp.FriendlyName,1)>=0 Then b=b-1 Else Set OffA(a)=OffA(b) Set OffA(b)=OffA(a+1) Set OffA(a+1)=tmp a=a+1 End If Wend ptnOff=a End Function SUB MsgrObj_OnLocalStateChangeResult(ByVal hr,ByVal mLocalState,pService) If 0=hr And Err.description="" And A_ Then If mLocalState=256 Or mLocalState=512 Then B_=True document.all.statu.innerHTML="Signing in..." ElseIf mLocalState=1024 Then B_=True document.all.statu.innerHTML="Signing out..." ElseIf mLocalState=1 then B_=True document.all.statu.innerHTML=L_ End If RefreshMC End If END SUB SUB MsgrObj_OnUserStateChanged(pUser,ByVal mPrevState,pfEnableDefault) 'If Err.description="" Then mcClearCache B_=False 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 mcClearCache 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 ' Launches chat window for a given user, or ' launches the logon window, or simply brings up ' Messenger to show all contacts. Function op(n) If HasMsgrApp Then If n>=0 Then document.all.mctrack.src="P/6/" On Error Resume Next MsgrApp.LaunchIMUI OnA(n) ElseIf-1=n Then MsgrApp.LaunchLogonUI Else MsgrApp.Visible=1 End If End If End Function Function htmlesc(str) str=Replace(str,"&","&") str=Replace(str,"<","<") htmlesc=Replace(str,">",">") 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) Select Case t Case 1 getStateImage=OffL 'Offline Case 2 getStateImage=N_ 'Online Case 10 getStateImage=O_ 'Busy Case 14 getStateImage=P_ 'BRB Case 18 getStateImage=P_ 'Away Case 34 getStateImage=P_ 'Away... as well....... Case 50 getStateImage=O_ 'On The Phone Case 66 getStateImage=O_ 'Out To Lunch End Select End Function </script> <OBJECT id=MsgrObj height=0 codeType=application/x-oleobject width=0 classid=clsid:F3A614DC-ABE0-11d2-A441-00C04F795683> <span style="display:none;"> </span> </OBJECT> <script language="VBScript" event="onReadyStateChange" for="mcvbs"> If mcvbs.readyState="complete" And Not isDrawn_ Then isDrawn_=True DrawInitialState End If </script> <script language="VBScript" event="onload" for="window"> If Not isDrawn_ Then isDrawn_=True DrawInitialState call HideElement(mOff) End If </script> <tr bgcolor="#3D55C4"> <td class="small"> <div class="small" align=center id="msngrheading" style="width:100%; color: #eff7ff; background-color:#3D55C4; padding:3px; padding-left:0px;"><b>MSN Messenger</b></div> </td> </tr> <tr> <td bgcolor="#EFF7FF" class="small"> <div id="getmsgr" class="small" align=center style="DISPLAY:none;color:#000000;"><br>Download<br><a href="http://messenger.msn.com/">Windows Messenger</a> <img id="mctrack" height="1" alt width="1"> </div> <div id="msgrlogon" class="small" style="DISPLAY:none"> <div id="statu" class="small" style="color:#000000"></div> </div> <!--ONLINE--> <div id="Online" class="small" style="DISPLAY:none;color:#000000"></div> <div id="noneol" class="small" style="DISPLAY:none;color:#000000"></div> <div id="mUser" class="small" style="DISPLAY:none;color:#000000"></div> <br> <!--OFFLINE--> <div id="notOnline" class="small" style="DISPLAY:none;color:#000000"> <b><a href="javascript:void(null)" onclick="ShowHide(mOff)" class="small"><img border="0" src="msn_icons/icon_messenger6.gif" WIDTH="16" HEIGHT="16"> Buddies offline</a></b> </div> <div id="mOff" class="small" style="DISPLAY:none; color:#000000"></div> <span id="appload" class="small" style="DISPLAY: none"></span> </td> <form name="msn"> <input type="hidden" value="ON" name="offline"> </form> </tr> </table> <br> [Ctrl+A 全部选择 提示：你可先修改部分代码，再按运行]具体参见这里
蓝色理想版权申明：除部分特别声明不要转载，或者授权我站独家播发的文章外，大家可以自由转载我站点的原创文章，但原作者和来自我站的链接必须保留（非我站原创的，按照原来自一节，自行链接）。文章版权归我站和作者共有。
转载要求：转载之图片、文件，链接请不要盗链到本站，且不准打上各自站点的水印，亦不能抹去我站点水印。
特别注意：本站所提供的摄影照片，插画，设计作品，如需使用，请与原作者联系，版权归原作者所有
本文总共有 9 条评论，现在显示最新的 5 条。
查看全部评论