批处理之家 - Powered by Discuz! Board

' 调试信息控制开关
Const DEBUG_SW = False
' 分组数
Const GROUP_NUMBER = 200
' 输出目录名称, 不要加 \
Const OUTPUT_DIR_NAME = "output"
' 没有 @ 的行后面要加上的域名
Const SUPPLEMENT_DOMAIN = "@youxiang.com"
Const ForReading = 1, ForWriting = 2
Public output_path
Public fso, input_file, output_file
Public arr_replace_src, arr_replace_dest, arr_replace_ubound
Public all_files_text
Public dic_account
Public yyyyMMdd
Public vbLf, vbCr, vbCrLf
CALL main
Sub main()
vbLf = Chr(10)
vbCr = Chr(13)
vbCrLf = vbCr & vbLf
' 分隔字符, 勿改
GAP_CHR = Chr(30)
' 替换表, 一行一个, 最后一行结尾不要有 ,
arr_replace_rule = Array( _
"aa." & GAP_CHR & "qy.", _
".con" & GAP_CHR & ".com" _
)
' 将替换规则解析为两个数组替换源字符串数组和替换目标字符串数组
replace_src_strs = ""
replace_dest_strs = ""
For Each ele In arr_replace_rule
arr = Split(ele, GAP_CHR)
replace_src_strs = replace_src_strs & GAP_CHR & arr(0)
replace_dest_strs = replace_dest_strs & GAP_CHR & arr(1)
Next
arr_replace_src = Split(Mid(replace_src_strs, 2), GAP_CHR)
arr_replace_dest = Split(Mid(replace_dest_strs, 2), GAP_CHR)
arr_replace_ubound = UBound(arr_replace_src)
' 账号字典, 用于去除重复账号
Set dic_account = CreateObject("Scripting.Dictionary")
' 用于计时的变量
Dim dttm1, dttm2
dttm1 = Now
' 当前日期时间
dttm = Now
yyyyMMdd = Year(dttm) & "" & Right("0" & Month(dttm), 2) & "" & Right("0" & Day(dttm), 2)
' 文件系统对象
Set fso = CreateObject("Scripting.FileSystemObject")
' 脚本对象和当前目录
Set obj_wsc_shell = CreateObject("wscript.shell")
HostFolder = obj_wsc_shell.CurrentDirectory & "\"
' 自动建立输出目录, 如果其不存在的话
output_path = HostFolder & OUTPUT_DIR_NAME & "\"
If (Not fso.FolderExists(output_path)) Then
fso.CreateFolder (output_path)
End If
DOUBLE_QUOTES = Chr(34)
obj_wsc_shell.Run "cmd /c mshta vbscript:msgbox(" & DOUBLE_QUOTES & "运行中, 请等待..." & DOUBLE_QUOTES & "," & vbOKOnly & "," & DOUBLE_QUOTES & "提示" & DOUBLE_QUOTES & ")(window.close)", 0
' 用于读取所有源文件的数据合并保存在内存中, 以待处理
all_files_text = ""
sum_files = 0
cnt_file = 0
last_percent = 0
' 遍历目录读取所有源文件
do_count_files = False
Call DoFolder(fso.GetFolder(HostFolder), sum_files, do_count_files)
' 处理并输出数据
Call process_and_output
' 关闭等待对话框
obj_wsc_shell.Run "taskkill /f /im cmd.exe", 0
obj_wsc_shell.Run "taskkill /f /im mshta.exe", 0
dttm2 = Now
WScript.Echo "DONE, 用时 " & DateDiff("s", dttm1, dttm2) & " 秒"
' Debug.Print "DONE, 用时 " & DateDiff("s", dttm1, dttm2) & " 秒"
WScript.Quit
End Sub
Sub process_and_output()
Dim regEx_CRLF
Set regEx_CRLF = New RegExp
regEx_CRLF.Pattern = "[\n\r]+"
regEx_CRLF.IgnoreCase = True
regEx_CRLF.Global = True
' 将合并在一起的所有源数据, 按行分解到一个数组
all_files_text = regEx_CRLF.Replace(all_files_text, vbLf)
arr_lines = Split(all_files_text, vbLf)
' 要求是，从同文件夹的所有txt里顺序处理内容。
' 1. 没有@的行后面加上@youxiang.com
' 2. aa.替换成qy.
' 3. .con替换为.com
' 4重复账号只保留一个
' 然后顺序保存到一个目录下，每200个账号新存一个txt，命名规则是当天日期-起始数字-结束数字.txt 如：20191207-201-400.txt
cnt_account = 0
For i = LBound(arr_lines) To UBound(arr_lines)
account = Trim(arr_lines(i))
If account <> "" Then
' 执行替换规则
For j = 0 To arr_replace_ubound
account = Replace(account, arr_replace_src(j), arr_replace_dest(j))
Next
' 自动补充域名
If Not (InStr(account, "@") > 0) Then
account = account & SUPPLEMENT_DOMAIN
End If
' 去重
If Not dic_account.exists(account) Then
dic_account.Add account, ""
cnt_account = cnt_account + 1
If cnt_account Mod GROUP_NUMBER = 1 Then
output_txt = account & vbCrLf
Else
output_txt = output_txt & account & vbCrLf
End If
End If
' 分组输出到文件
If ((cnt_account > 0) And (cnt_account Mod GROUP_NUMBER = 0) Or (i >= UBound(arr_lines))) Then
ind_s = ((cnt_account \ GROUP_NUMBER - 1) * GROUP_NUMBER) + 1
output_file_path = output_path & yyyyMMdd & "-" & ind_s & "-" & cnt_account & ".txt"
Set output_file = fso.OpenTextFile(output_file_path, ForWriting, True)
output_file.Write output_txt
output_file.Close
End If
End If
Next
' 分组输出到文件, 最后一个组, 数量不足分组标准数
If ((cnt_account > 0) And (cnt_account Mod GROUP_NUMBER <> 0)) Then
ind_s = ((cnt_account \ GROUP_NUMBER) * GROUP_NUMBER) + 1
output_file_path = output_path & yyyyMMdd & "-" & ind_s & "-" & cnt_account & ".txt"
Set output_file = fso.OpenTextFile(output_file_path, ForWriting, True)
output_file.Write output_txt
output_file.Close
End If
End Sub
Sub DoFolder(Folder, ByRef sum_files, ByVal do_count_files)
If output_path = Folder.Path & "\" Then Exit Sub
' 在子目录中递归调用
Dim SubFolder
For Each SubFolder In Folder.SubFolders
Call DoFolder(SubFolder, sum_files, do_count_files)
Next
Dim file
For Each file In Folder.Files
Call doFile(file, sum_files, do_count_files)
Next
End Sub
Sub doFile(ByRef input_file, ByRef sum_files, ByVal do_count_files)
' 分解获取文件名和扩展名
If InStr(input_file.Name, ".") > 0 Then
arr = Split(input_file.Name, ".")
ext_name = UCase(arr(UBound(arr)))
dot_ext_name = "." & ext_name
Else
ext_name = ""
dot_ext_name = ""
End If
' 跳过非 txt 文件
If Not ("TXT" = ext_name) Then
Exit Sub
End If
If do_count_files Then
sum_files = sum_files + 1
Exit Sub
End If
' cnt_file = cnt_file + 1
' Percent = Int(cnt_file * 100 / sum_files)
file_name = Left(input_file.Name, Len(input_file.Name) - Len(dot_ext_name))
Set input_file_OTF = fso.OpenTextFile(input_file.Path, ForReading)
all_files_text = all_files_text & input_file_OTF.Readall & vbCrLf
End Sub
Sub debug_WriteLine(output_file, debug_txt)
If Not DEBUG_SW Then Exit Sub
output_file.WriteLine debug_txt
End Sub