ydk_NAME=InputBox("请输入卡组名:")
msgbox "请等待几秒钟直到finished弹框出现"
set fso=createobject("scripting.filesystemobject")
set file=fso.opentextfile(ydk_NAME)
set f_input = fso.OpenTextFile(ydk_NAME&".txt", 8, true)
function getHTTPPage(Url)
dim Http
set Http=createobject("MSXML2.XMLHTTP")
Http.open "GET",Url,false
Http.send()
if Http.readystate <> 4 then
exit function
end if
getHTTPPage=bytesToBSTR(Http.responseBody,"utf-8")
set http=nothing
if err.number <> 0 then err.Clear
end function
Function BytesToBstr(body,Cset)
dim objstream
set objstream = CreateObject("adodb.stream")
objstream.Type = 1
objstream.Mode =3
objstream.Open
objstream.Write body
objstream.Position = 0
objstream.Type = 2
objstream.Charset = Cset
BytesToBstr = objstream.ReadText
objstream.Close
set objstream = nothing
End Function
Function getStrBetween(Str,StartStr,EndStr)
StartStrPos = Instr(Str, StartStr)+Len(StartStr)
EndStrPos = Instr(Str,EndStr)
Length = EndStrPos - StartStrPos
Res= Mid(Str,StartStrPos,Length)
getStrBetween = Res
End Function
Function RegExpTest(patrn, strng)
Dim regEx, Match, Matches
Set regEx = New RegExp
regEx.Pattern = patrn
regEx.IgnoreCase = True
regEx.Global = True
Set Matches = regEx.Execute(strng)
For Each Match in Matches
RetStr=Match.Value
Next
RegExpTest = RetStr
End Function
Function ReplaceTest(patrn, replStr)
Dim regEx, str1
str1 = base_info
Set regEx = New RegExp
regEx.Pattern = patrn
regEx.IgnoreCase = True
ReplaceTest = regEx.Replace(str1, replStr)
End Function
sa=file.readall
strarry=split(sa,vbcrlf)
for each card_code in strarry
isnum = isnumeric(card_code)
if isnum = true then
Url="
http://www.ourocg.cn/S.aspx?key="&card_code
Dim Html
Html = getHTTPPage(Url)
Str = Html
StartStr_base ="/figure"
EndStr_base ="p><div class=""hidden-xs"""
On Error Resume Next
base_info = getStrBetween(Str,StartStr_base,EndStr_base)
if err.number =5 then
name_info="找不到卡"&card_code
f_input.WriteLine(name_info)
elseif err.number <> 0 then
msgbox "error:"&err.number
else
effect_arr = Split(base_info, "effect")
StartStr_name ="查看["
EndStr_name ="]的效果调整"
name_info = getStrBetween(base_info,StartStr_name,EndStr_name)
ATK_base = ReplaceTest("ATK: </span><span>", "ATK:")
DEF_base = ReplaceTest("DEF: </span><span>", "DEF:")
card_tp_arr = split(base_info,"sCardType:")
card_tp_arr1 = split(card_tp_arr(1),")")
card_tp = card_tp_arr1(0)
if InStr(card_tp,"怪兽") <> 0 Then
level = RegExpTest ("level:[1-9][0-9]*",Html)
tribe_arr = split(base_info,"tribe:")
tribe_arr1 = split(tribe_arr(1),")")
tribe = tribe_arr1(0)
element_arr = split(base_info,"element:")
element_arr1 = split(element_arr(1),")")
element = element_arr1(0)
ATK = RegExpTest ("ATK:[0-9][0-9]*",ATK_base)
DEF = RegExpTest ("DEf:[0-9][0-9]*",DEF_base)
'msgbox name_info
'msgbox level
'msgbox ATK
'msgbox DEF
'msgbox card_tp
'msgbox tribe
'msgbox element
'msgbox effect_arr(1)
f_input.WriteLine(name_info)
else
'msgbox name_info
'msgbox card_tp
'msgbox effect_arr(1)
f_input.WriteLine(name_info)
end if
end if
set fso=createobject("scripting.filesystemobject")
fso.createtextfile("d:\1.txt").write base_info
else
f_input.WriteLine(card_code)
end if
next
f_input.close
file.close
msgbox "finished"
壮哉我大VB家族
