在网页调用WINDOWS控件两例

添加时间：2010-1-5

相关阅读: 网页 HTML JavaScript Windows

一、这个是netmting的例子

<html>
<head>
<title>OCX</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<script language="JavaScript">
var flag=true
function showall(){
alist = new Array();
newocx();
list1.value = "";
list2.value = "";
list1.value = ocxtype.outerHTML;
j = 0;
for (i in ocxtype)
{
alist[j] = i;
j++;
}
for (i = 0; i < alist.length; i++)
for (j = (alist.length-1); j > 0; j--)
{
   if (alist[j] < alist[j-1])
   {
    temps = alist[j];
    alist[j] = alist[j-1];
    alist[j-1] = temps;
   }
}
for (i = 0; i < alist.length; i++)
list2.value += alist[i] + "\n";
alert("共有 "+alist.length+" 个属性方法")
}
function newocx()
{
ocxfield.innerHTML = "<OBJECT ID='ocxtype' WIDTH='0px' HEIGHT='0px'" +
     "CLASSID='CLSID:" + ocxid.value + "'></OBJECT>";
}
</script>
</head>

<div align="center">
<p>classid
    <input type="text" id="ocxid" style="width:400" value="F3A614DC-ABE0-11d2-A441-00C04F795683" onchange="jscript:flag=true">
    <input type="button" id="look" value="查看" onclick="showall()">
</p>
<table width="75%" border="1">
    <tr>
      <td height="24">
        <div align="center">html中的写法</div>
      </td>
      <td height="24">
        <div align="center">OCX中的属性事件</div>
      </td>
    </tr>
    <tr>
      <td>
        <textarea id="list1" style="width: 500px; height: 400px;" readonly></textarea>
      </td>
      <td>
        <textarea id="list2" style="width:250px; height:400px;" readonly></textarea>
      </td>
    </tr>
</table>
</div>
<div id="ocxfield">
</div>
</body>
</html>
二、

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">

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

<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>

<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>

<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>

本文作者:

相关在网页调用WINDOWS控件两例

网页制作教程 [2010-1-5]

实现网页制作中“层”精确定位 [2010-1-5]

让IISWeb服务器不再拒认ASP网页 [2010-1-5]

打造美丽新“视”界—无边窗口制作详解 [2010-1-5]

DreamWeaver表格应用(隔距边框的制作) [2010-1-5]

DreamweaverMX2004电子相册制作 [2010-1-5]