在网页调用 WINDOWS 控件两例(2)

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

标签：

版权申明：本站文章部分自网络，如有侵权，请联系：west999com@outlook.com
特别注意：本站所有转载文章言论不代表本站观点，本站所提供的摄影照片，插画，设计作品，如需使用，请与原作者联系，版权归原作者所有