- Set FSO = CreateObject("Scripting.FileSystemObject")
- If Not FSO.FolderExists("New") Then FSO.CreateFolder("New")
- For Each File in FSO.GetFolder(".").Files
- Ext = FSO.GetExtensionName(File)
- Name = FSO.GetBaseName(File)
- If LCase(Ext) = "txt" Then
- fDir = "New\" & Name
- If Not FSO.FolderExists(fDir) Then FSO.CreateFolder(fDir)
- Open_File FSO.OpenTextFile(File)
- End If
- Next
-
- FSO.DeleteFolder "New", True
-
- Sub Open_File(f)
- Do Until f.AtEndOfStream
- Text = f.ReadLine
- If RegEx(Text) <> "" Then GetStr Split(RegEx(Text)," ")
- Loop
- End Sub
-
- Sub GetStr(ar)
- Dim A(9)
- For i = 0 to 9 :A(i) = 0 :Next
- For i = 1 to UBound(ar) - 1
- For j = i + 1 to UBound(ar)
- s1 = Right(CInt(ar(i)) + CInt(ar(j)),1) :A(s1) = A(s1) + 1
- s2 = Right(CInt(ar(i)) - CInt(ar(j)),1) :A(s2) = A(s2) + 1
- s3 = Right(CInt(ar(i)) * CInt(ar(j)),1) :A(s3) = A(s3) + 1
- Next
- Next
-
- For i = 1 to 6
- For j = i + 1 to 7
- For k = j + 1 to 8
- For L = k + 1 to 9
- ReDim PreServe B(n)
- B(n) = A(i) + A(j) + A(k) + A(L) + A(0)
- n = n + 1
- Next
- Next
- Next
- Next
-
- n = 1
- For i = 1 to UBound(B) + 1
- Str = Str & " " & B(i-1)
- If i Mod 126 = 0 Then
- FSO.OpenTextFile(fDir&"\"&Name&"_"&n&".txt",8,True).WriteLine Str
- Str = "" :n = n + 1
- End If
- Next
- End Sub
-
- Function RegEx(Text)
- Set Re = New RegExp
- Re.Pattern = "\s+"
- Re.Global = True
- RegEx = Trim(Re.Replace(Text," "))
- End Function
复制代码
|