回复 14# hbb
话说，为何顶楼不一次性说清楚呢？修改下vbs，此帖我不再回复- Set fso = Createobject("Scripting.FileSystemObject")
- Set dic1 = CreateObject("Scripting.Dictionary")
- Set dic2 = CreateObject("Scripting.Dictionary")
- Set file = fso.OpenTextFile("List.txt")
-
- Do Until file.AtEndOfStream
- strLine = Trim(file.ReadLine)
- If Left(strLine,1) = "{" and Right(strLine,1) = "}" Then
- strFD = Mid(strLine,2,Len(strLine)-2)
- ElseIf strLine <> "" and strFD <> "" Then
- If Not fso.FolderExists(strFD) Then
- fso.CreateFolder strFD
- End If
-
- strName = Left(strLine,InStr(strLine,",")-1)
- strUrl = Right(strLine,Len(strLine)-InStr(strLine,","))
- strKey = strFD & "\" & strName
-
- If dic1.Exists(strKey) Then
- dic1.Item(strKey) = dic1.Item(strKey) + 1
- Else
- dic1.Add strKey,101
- End If
-
- s = "_源" & Right(dic1.Item(strKey),2)
- s = "<Entry> <Title>" & strName & s & "</Title> <Ref href = "
- s = s & chr(34) & strUrl & chr(34) &"/> </Entry>"
-
- If dic2.Exists(strKey) Then
- dic2.Item(strKey) = dic2.Item(strKey) & vbcrLf & s
- Else
- dic2.Add strKey,"<Asx Version = ""3.0"">" & vbCrLf & s
- End If
- End If
- Loop
-
- For Each a in dic2.Keys
- fso.OpenTextFile(a & ".txt",2,true).Write dic2.Item(a) & vbCrLf & "</Asx>"
- Next
- MsgBox "OK"
| 
发表于 2014-1-3 11:30
| 
