推荐订阅源

'注释:

Sub eb_Sheng_CloseUp()

  dim Arr,Dic

  eb_shi.Clear

  StrSql = "Select 城市 From 邮编区号 Where 省份 = '"+eb_Sheng.Text+"'"

  StrRet = DBEngine.WebFunction("SqlQuery",StrSql,"")

GetArrFromXML Dic,Arr,strRet

  FOR i=0 TO UBound(Arr,2)

    eb_Shi.AddItem Arr(0,i)

  NEXT

End Sub

Function GetArrFromXML(ByRef FieldArr, ByRef Arr1, Xml1)

Dim i, j, lsXml, lsChar, liStar, liEnd, lsStar, lsEnd, liLen,Dic1

lsStar = "<FieldName>"

lsEnd = "</FieldName>"

liLen = Len(lsStar)

i = InStr(1,Xml1, "<FieldInfoArray>",1)

If i <> 0 Then

lsXml = Mid(Xml1, i, Len(Xml1))

Else

Exit Function

End If

liStar = InStr(1, lsXml, lsStar, 1)

liEnd = InStr(1, lsXml, lsEnd, 1)

Do While liEnd > 0

If IsArray(FieldArr) Then

ReDim Preserve FieldArr(UBound(FieldArr) + 1)

Else

ReDim FieldArr(0)

End If

FieldArr(UBound(FieldArr)) = Mid(lsXml, liStar + liLen, liEnd - liStar - liLen)

liStar = InStr(liEnd+1, lsXml, lsStar, 1)

liEnd = InStr(liEnd+1, lsXml, lsEnd, 1)

Loop

Set Dic1 = CreateObject("Scripting.Dictionary")

For i = 0 To UBound(FieldArr, 1)

Dic1.Add FieldArr(i), CStr(i)

Next

liStar = InStr(1, lsXml, "<RowNum>", 1)

liEnd = InStr(1, lsXml, "</RowNum>", 1)

i = Int(Mid(lsXml,  liStar + Len("<RowNum>"), liEnd - liStar - Len("<RowNum>")))

ReDim Arr1(UBound(FieldArr, 1), i - 1)

For i = 0 To UBound(FieldArr, 1)

lsStar = "<" & FieldArr(i) & ">"

lsEnd = "</" & FieldArr(i) & ">"

liLen = Len(lsStar)

j = 0

liStar = InStr(1, lsXml, lsStar, 1)

liEnd = InStr(1, lsXml, lsEnd, 1)

Do While liEnd > 0  'i =  dic1.key(FieldArr(i))

Arr1(i, j) = Mid(lsXml, liStar + liLen, liEnd - liStar - liLen)

liStar = InStr(liEnd+1, lsXml, lsStar, 1)

liEnd = InStr(liEnd+1, lsXml, lsEnd, 1)

j = j + 1

Loop

Next

End Function