VBScript仿JQuery
前言
其實這東西根本就是仿JQuery寫的，為什麼要寫呢??因為真的中毒太深，JQuery真的太方便了，
但問題來了，我手上工作有些是前輩寫的，有時客戶要求修改，修改沒問題，但遇到VBScript
，就.....有問題，變的感覺卡卡，小小東西修個老半天，所以就決定讓這東西誕生。
Tips
set obj = jVB("form")
set obj = jVB("#btn1")
set obj = jVB(".btn1")
set obj = jVB("input[name=tt]")
set obj = jVB(name=tt)
set obj = jVB(document.getElementById("btn1"))
set obj = jVB(".btn1,#btn2,.btn3,form")可以次讀取多個
有這幾種收集方式，而且開頭不能用代號向$符號，這是我感到遺憾的。
程式碼
'版本:1.8
'修改日期:1000914
'修改內容:增加搜尋條件
'修改日期:1000915
'修改內容:新增length取出搜尋筆數
'修改日期:1000916
'修改內容:修改搜尋時錯誤
'修改日期:1000917
'修改內容:新增搜尋方式input[name=tt],name=tt,新增index屬性
'修改日期:1000919
'修改內容:增加搜尋精準度，debug jFind方法
'修改日期:1000920
'修改內容:加強toNext toPrev
'修改日期:1000921
'修改內容:新增focus
'修改日期:1000922
'修改內容:新增submit
'使用說明
'搜尋節點方式:tagName,id,class,物件 四種範例如下
'set obj = jVB("form")
'set obj = jVB("#btn1")
'set obj = jVB(".btn1")
'set obj = jVB("input[name=tt]")
'set obj = jVB(name=tt)
'set obj = jVB(document.getElementById("btn1"))
'set obj = jVB(".btn1,#btn2,.btn3,form")可以次讀取多個
'屬性
'obj.text 讀str = obj.text/寫obj.text = str
'obj.html 讀str = obj.html/寫obj.html = str
'obj.value 讀str = obj.value/寫obj.value = str
'obj.index 讀取節點本身位置以0為開頭
'方法
'obj.getXML(argNum) 回傳指定Xml節點物件
'obj.attr(argStr) 屬性設定 讀obj.argStr("id")/寫obj.argStr("title:xxyy,className:aabb")
'obj.removeAttr(argStr) 刪除屬性 寫obj.removeAttr("id")
'obj.css(argStr) style設定 讀obj.argStr("color")/寫obj.argStr("font-size:17pt,color:red;")
'obj.removeCss(argStr) 刪除屬性
'obj.addClass(argStr) class設定 寫obj.addClass("xxyy")
'obj.removeClass(argStr)移除class設定 寫obj.removeClass("xxyy")
'obj.parent() 回到父節點
'obj.parents("id|class|tagName")回到指定父節點
'obj.toNext() '到下一個節點
'obj.toPrev() '道上一個節點
'obj.remove() '清除自己本身
'obj.allEmpty() '清除自己的內容
'obj.children(tagName|id|class|number)'回傳指定子節點
'obj.hide() '物件隱藏
'obj.show() '物件顯示
'obj.disabled(boolean) '物件癱瘓
'jVBPost(sUrl,sData,bSync)sUrl:傳送網址,sData:傳送的資料 "data1:123,data2:456" bSync:true=非同步|false=同步
'obj.jFind("id|class|tagName")在搜尋節點內容
Class controlDOM
private aCore(0)
property get index()
objCore = aCore(0)
set objTarget = objCore(0)
set objList = objTarget.parentNode.firstChild
i = 0
while not objList is objTarget
i = i + 1
set objList = objList.nextSibling
wend
index = i
end property
Property let core(aObj)
aCore(0)= aObj
End Property
property Get text() '取得節點內純文字 as string'
if isArray(aCore(0)) then
objCore = aCore(0)
text = objCore(0).innerText
end if
End property
property let text(argStr) '設定節點內容存文字'
if isArray(aCore(0)) then
for each objTemp in aCore(0)
objTemp.innerText = argStr
next
end if
end property
property Get html() '取得節點內容文字 as string'
if isArray(aCore(0)) then
objCore = aCore(0)
html = objCore(0).innerHTML
end if
End property
property let html(argStr)
if isArray(aCore(0)) then
for each objTemp in aCore(0)
objTemp.innerHTML = argStr'設定節點內容文字'
next
end if
End property
property let value(argStr) '設定val'
On Error Resume Next
if isArray(aCore(0)) then
for each objTemp in aCore(0)
objTemp.value = argStr'設定節點內容文字'
next
end if
end property
property get value() '取得val'
on Error Resume Next
objCore = aCore(0)
value = objCore(0).value
if err.number > 0 then value = ""
end property
' '--------------屬性End------------------------------------'
sub submit()
objCore = aCore(0)
set objTarget = objCore(0)
if LCase(objTarget.tagName) = "form" then
objTarget.submit
end if
end sub
Function focus()
objCore = aCore(0)
set objTarget = objCore(0)
objTarget.focus()
set focus = me
end function
Function length()
length = UBound(aCore(0))
end Function
Function getXML(iArg)
objCore = aCore(0)
if IsNumeric(iArg) then
set getXML = objCore(iArg)
end if
end function
Function attr(arg) '回傳屬性值 as String'
On Error Resume Next
if inStr(arg,":") > 0 then
a = getkeyval(arg)
for each aStr in a
objCore = aCore(0)
for each objTemp in objCore
objTemp.setAttribute aStr(0),aStr(1)
next
next
set attr = me
else
objCore = aCore(0)
if isObject(objCore(0).getAttribute(arg)) then
set attr = objCore(0).getAttribute(arg)
else
attr = objCore(0).getAttribute(arg)
end if
end if
End Function
Function removeAttr(arg)
aKey = split(arg,",")
objCore = aCore(0)
for each str in aKey
for each objTemp in objCore
objTemp.removeAttribute(str)
next
next
set removeAttr = me
end Function
Function css(arg)
on Error Resume Next
if inStr(arg,":") > 0 then
aCondition = getkeyval(arg)
for each aStr in aCondition
objCore = aCore(0)
for each objTemp in objCore
objTemp.getAttribute("style").setAttribute aStr(0),aStr(1)
next
next
set css = me
else
objCore = aCore(0)
css = objCore(0).getAttribute("style").getAttribute(arg)
end if
end Function
function removeCss(arg)
aKey = split(arg,",")
objCore = aCore(0)
for each str in aKey
for each objTemp in objCore
objTemp.getAttribute("style").removeAttribute str
next
next
set removeCss = me
end function
Function addClass(arg)
objCore = aCore(0)
for each objTemp in objCore
sClass = objTemp.getAttribute("className")
sClass = sClass & space(1) & arg
objTemp.setAttribute "className",sClass
next
set addClass = me
end Function
Function removeClass(argStr)
objCore = aCore(0)
for each objTemp in objCore
sClass = objTemp.getAttribute("className")
aClass = split(sClass," ")
sClass = ""
for each str in aClass
if str <> argStr then
sClass = sClass & str & space(1)
end if
next
objTemp.setAttribute "className",sClass
next
set removeClass = me
end Function
Function parent()'傳回上一層節點 as object'
if isArray(aCore(0)) then
objCore = aCore(0)
set objTarget = objCore(0).parentNode
set parent = reFinishObj(objTarget)
end if
end Function
Function parents(arg) '傳回指定父節點 as object'
objCore = aCore(0)
set objTarget = objCore(0)
aKeyVal = checkType(arg)
'do while not UCase(objTarget.getAttribute(aKeyVal(0))) = UCase(aKeyVal(1))
do while not checkCondition(objTarget,aKeyVal)
set objTarget = objTarget.parentNode
if UCase(objTarget.tagName) = objTarget.scopeName then exit do
loop
set parents = reFinishObj(objTarget)
end Function
Function children(arg) '傳回子節點 as object'
objCore = aCore(0)
set objTarget = objCore(0)
ReDim aTarget(objTarget.children.length)
if IsNumeric(arg) then
i = 0
for each objTemp in objTarget.childNodes
if objTemp.nodeName <> "#text" then
set aTarget(i) = objTemp
i = i + 1
end if
next
set objxx = aTarget(arg)
set children = reFinishObj(aTarget(arg))
elseif not IsNumeric(arg) and not isArray(arg) then
aChildren = vbsearch(objTarget,arg)
set children = reFinishObj(aChildren)
end if
end Function
Function toNext()'到下一個節點'
On Error Resume Next
for each objTarget in aCore(0)
do
set objTarget = objTarget.nextSibling
loop while objTarget.nodeName = "#text"
aTemp = ArrayAdd(aTemp,objTarget)
next
set toNext = reFinishObj(aTemp)
if err.number >0 then toNext = nothing
end Function
Function toPrev()'到上一個節點'
On Error Resume Next
for each objTarget in aCore(0)
do
set objTarget = objTarget.previousSibling
loop while objTarget.nodeName = "#text"
aTemp = ArrayAdd(aTemp,objTarget)
next
set toPrev = reFinishObj(aTemp)
if err.number >0 then toPrev = nothing
end Function
Function append(arg)'從物件內容後方插入'
sTarget=""
if isObject(arg) then
sTarget=arg.outerHTML
elseif not isArray(arg) then
sTarget = arg
end if
sTarget = me.html & sTarget
me.html = sTarget
set append = me
End Function
Function prepend(arg)'從物件內容'
sTarget=""
if isObject(arg) then
sTarget=arg.outerHTML
elseif not isArray(arg) then
sTarget = arg
end if
sTarget = sTarget & me.html
me.html = sTarget
set prepend = me
end Function
Function remove()
objCore = aCore(0)
for each objTemp in objCore
objTemp.parentNode.removeChild(objTemp)
next
set remove = me
end Function
Function allEmpty()
me.html = ""
set emptyAll = me
end Function
private Function reFinishObj(objXml)
set tempDOM = new controlDOM
if isArray(objXml) then
tempDOM.core = objXml
else
tempDOM.core = array(objXml)
end if
set reFinishObj = tempDOM
end Function
Private Function IIf(condition,value1,value2)
If condition Then IIf = value1 Else IIf = value2
End Function
Private Function checkType(argStr)'檢查搜尋型態
if Instr(argStr,"#") > 0 then
aTemp = array(array("id",Trim(Right(argStr,len(argStr)-1)),"="))
elseif InStr(argStr,".") > 0 then
aTemp = array(array("ClassName",Trim(Right(argStr,len(argStr)-1)),"="))
elseif InStr(argStr,"[") > 0 then
arg = Replace(Replace(argStr,"["," "),"]","")
aTemp = split(arg," ")
aTemp(0) = array("tagName",Trim(aTemp(0)),"=")
if Instr(aTemp(1),"=") > 0 or Instr(aTemp(1),"<>") > 0 then
sCondition = iif(Instr(aTemp(1),"=") > 0,"=","<>")
aKeyVal = iif(Instr(aTemp(1),"=") > 0,split(aTemp(1),"="),split(aTemp(1),"<>"))
aKeyVal(0) = Replace(LCase(aKeyVal(0)),"class","className")
aTemp(1) =array(Trim(aKeyVal(0)),Trim(aKeyVal(1)),sCondition)
end if
elseif InStr(argStr,"=") > 0 or InStr(argStr,"<>") > 0 then
sCondition = iif(InStr(argStr,"=") > 0,"=","<>")
aKeyVal = iif(InStr(argStr,"=") > 0,split(argStr,"="),split(argStr,"<>"))
aKeyVal(0) = Replace(LCase(aKeyVal(0)),"class","className")
aTemp = array(array(Trim(aKeyVal(0)),Trim(aKeyVal(1)),sCondition))
else
aTemp = array(array("tagName",argStr,"="))
end if
checkType = aTemp
end function
private Function getkeyval(arg)
a = split(arg,",")
for i = 0 to UBound(a)
a(i)=split(a(i),":")
next
getkeyval = a
end function
Function ArrayAdd(oldArray,val)
listNum = 0
oldNum = 0 '舊陣列數
addNum = 0 '追加陣列數
if isArray(oldArray) and isArray(val) then
oldNum = UBound(oldArray)
addNum = UBound(val)
addVal = val
elseif isArray(oldArray) and not isArray(val) then
oldNum = UBound(oldArray)
addNum = 0
addVal = array(val)
elseif not isArray(oldArray) and isArray(val) then
ArrayAdd = val
exit function
elseif not isArray(oldArray) and not isArray(val) then
ArrayAdd = array(val)
exit function
end if
ReDim newArray(oldNum+addNum+1)
'將舊資料寫入新陣列
for each objData in oldArray
if isObject(objData) then
set newArray(listNum) = objData
else
newArray(listNum) = objData
end if
listNum = listNum + 1
next
'將新資料寫入
for each objData in addVal
if isObject(objData) then
set newArray(listNum) = objData
else
newArray(listNum) = objData
end if
listNum = listNum +1
next
ArrayAdd = newArray
End Function
Function vbsearch(objXML,target)'objXML被收尋物件:target搜尋目標
if isObject(target) then
vbsearch = array(target)
exit function
end if
aKeyVal = checkType(target)
isId = iif(UBound(Filter(aKeyVal(0),"id"))=-1,array(""),Filter(aKeyVal(0),"id"))
if isId(0) = "id" then
aVal = aKeyVal(0)
aTemp = array(document.getElementById(aVal(1)))
elseif objXML.hasChildNodes() then '檢查搜尋物件是否有子物件
for each obj in objXML.children '讀取每個子物件
sTempClass = obj.getAttribute(isId(0))'用來確認子物件特定屬性名稱
sTempTagName = obj.tagName
if obj.hasChildNodes() then'查詢有無子物件
aChildXML = vbsearch(obj,target)'回傳符合條件子物件陣列
end if
if checkCondition(obj,aKeyVal) then '查詢物件是否符合條件
aTemp = ArrayAdd(aTemp,ArrayAdd(aChildXML,obj))'
aChildXML = empty
else'不符合條件
if isArray(aChildXML) then'子物件陣列是陣列
aTemp = ArrayAdd(aTemp,aChildXML)
aChildXML = empty
end if
end if
next
end if
vbsearch = aTemp
End Function
Function checkCondition(objXML,KVC)'檢查條件是否吻合
bResult = true
set re = new RegExp
for each aKVC in KVC
sCD = Trim("" & objXML.getAttribute(aKVC(0))) '取出值
'sCD = iif(aKVC(0)="tagName",LCase(sCD),sCD)
re.IgnoreCase = iif(aKVC(0)="tagName",true,false)
re.Pattern=aKVC(1)'
bAns = eval(true & aKVC(2) & re.test(sCD))
bResult = bResult And bAns
next
checkCondition = bResult
end function
Function show()
me.removeCss("display")
set show = me
end function
function hide()
me.css("display:none")
set hide = me
end function
function disabled(bArg)
if bArg then
me.attr("disabled:disabled")
else
me.removeAttr("disabled")
end if
set disabled = me
end function
function jFind(arg)
aVal = split(arg,",")
for each str in aVal
for each objXML in aCore(0)
if isObject(objXML) then
aTemp = vbsearch(objXML,str)'尋找到特定物件後
end if
if isArray(aTemp) then aFind = ArrayAdd(aFind,aTemp)'只要有搜尋到都放入aFind
next
next
set jFind = reFinishObj(aFind)
end function
End Class
Function jVB(target)
set objDOM = new controlDOM '繳活controlDOM'
if not isObject(target) then aTarget = split(target,",") else aTarget = array(target)
for each sTarget in aTarget
aTemp = objDOM.ArrayAdd(aTemp,objDOM.vbsearch(document.body,sTarget))
next
objDOM.core = aTemp
set jVB = objDOM
end Function
function jVBPost(sUrl,dataStr,bSync) '網址,傳送資料串
dataStr = Replace(dataStr,",","&")
dataStr = Replace(dataStr,":","=")
set xmlHttp =CreateObject("Microsoft.XMLHTTP")
xmlHttp.open "POST",sUrl,bSync 'false同步true非同步
xmlHttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
xmlHttp.send dataStr
jVBPost = xmlHttp.responseText
end function
檔案下載
載點:jVB.rar
結語
雖然只寫了幾樣，但在使用上幫助我減少很多困擾，畫面也乾淨了，如果各位高手有使用
並且發現有錯誤，或有更好的提議，請不要吝嗇指教謝謝。
Louis的標籤: VBScript
