在网页调用 WINDOWS 控件两例

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="http://webdesign.chinaitlab.com/UploadFiles_8014/200605/20060512101438465.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>

上一页  [1] [2] 

Copyright ＠ 2007-2012 敏韬网(敏而好学，文韬武略--MinTao.Net)（学习笔记） Inc All Rights Reserved.
闵涛 E_mail:admin@mintao.net(欢迎提供学习资源)

鄂公网安备 42011102001154号

站长：MinTao ICP备案号：鄂ICP备11006601号-18