批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程
[批处理文件精品]批处理版照片整理器[批处理文件精品]纯批处理备份&还原驱动在线第三方下载
返回列表 发帖

已解决,30元求助用于筛选整理,替换邮箱账号的脚本

本帖最后由 ws1870 于 2019-12-7 14:20 编辑

联系qq2017427822
支付方式可 支付宝,微信,QQ
具体报酬30元,也可具体谈

要求是,从同文件夹的所有txt里顺序处理内容。
1. 没有@的行后面加上@youxiang.com
2. aa.替换成qy.
3.  .con替换为.com
4重复账号只保留一个
然后顺序保存到一个目录下,每200个账号新存一个txt,命名规则是当天日期-起始数字-结束数字.txt 如:20191207-201-400.txt

希望可以添加注释以供学习

本帖最后由 a20150604 于 2019-12-7 15:15 编辑

回复 1# ws1870
  1. ' 调试信息控制开关
  2. Const DEBUG_SW = False
  3. ' 分组数
  4. Const GROUP_NUMBER = 200
  5. ' 输出目录名称, 不要加 \
  6. Const OUTPUT_DIR_NAME = "output"
  7. ' 没有 @ 的行后面要加上的 域名
  8. Const SUPPLEMENT_DOMAIN = "@youxiang.com"
  9. Const ForReading = 1, ForWriting = 2
  10. Public output_path
  11. Public fso, input_file, output_file
  12. Public arr_replace_src, arr_replace_dest, arr_replace_ubound
  13. Public all_files_text
  14. Public dic_account
  15. Public yyyyMMdd
  16. Public vbLf, vbCr, vbCrLf
  17. CALL main
  18. Sub main()
  19.     vbLf = Chr(10)
  20.     vbCr = Chr(13)
  21.     vbCrLf = vbCr & vbLf
  22.    
  23.     ' 分隔字符, 勿改
  24.     GAP_CHR = Chr(30)
  25.    
  26.     ' 替换表, 一行一个, 最后一行结尾不要有 ,
  27.     arr_replace_rule = Array( _
  28.         "aa." & GAP_CHR & "qy.", _
  29.         ".con" & GAP_CHR & ".com" _
  30.         )
  31.    
  32.     ' 将替换规则解析为 两个数组 替换源字符串数组 和 替换目标字符串数组
  33.     replace_src_strs = ""
  34.     replace_dest_strs = ""
  35.     For Each ele In arr_replace_rule
  36.         arr = Split(ele, GAP_CHR)
  37.         replace_src_strs = replace_src_strs & GAP_CHR & arr(0)
  38.         replace_dest_strs = replace_dest_strs & GAP_CHR & arr(1)
  39.     Next
  40.     arr_replace_src = Split(Mid(replace_src_strs, 2), GAP_CHR)
  41.     arr_replace_dest = Split(Mid(replace_dest_strs, 2), GAP_CHR)
  42.     arr_replace_ubound = UBound(arr_replace_src)
  43.    
  44.    
  45.     ' 账号字典, 用于去除重复账号
  46.     Set dic_account = CreateObject("Scripting.Dictionary")
  47.    
  48.     ' 用于计时的变量
  49.     Dim dttm1, dttm2
  50.     dttm1 = Now
  51.    
  52.     ' 当前日期时间
  53.     dttm = Now
  54.     yyyyMMdd = Year(dttm) & "" & Right("0" & Month(dttm), 2) & "" & Right("0" & Day(dttm), 2)
  55.    
  56.     ' 文件系统对象
  57.    
  58.    
  59.     Set fso = CreateObject("Scripting.FileSystemObject")
  60.    
  61.     ' 脚本对象 和 当前目录
  62.     Set obj_wsc_shell = CreateObject("wscript.shell")
  63.     HostFolder = obj_wsc_shell.CurrentDirectory & "\"
  64.    
  65.     ' 自动建立输出目录, 如果其不存在的话
  66.     output_path = HostFolder & OUTPUT_DIR_NAME & "\"
  67.     If (Not fso.FolderExists(output_path)) Then
  68.         fso.CreateFolder (output_path)
  69.     End If
  70.    
  71.    
  72.     DOUBLE_QUOTES = Chr(34)
  73.     obj_wsc_shell.Run "cmd /c mshta vbscript:msgbox(" & DOUBLE_QUOTES & "运行中, 请等待..." & DOUBLE_QUOTES & "," & vbOKOnly & "," & DOUBLE_QUOTES & "提示" & DOUBLE_QUOTES & ")(window.close)", 0
  74.    
  75.    
  76.     ' 用于读取所有源文件的数据合并保存在内存中, 以待处理
  77.     all_files_text = ""
  78.    
  79.     sum_files = 0
  80.     cnt_file = 0
  81.     last_percent = 0
  82.    
  83.     ' 遍历目录 读取所有源文件
  84.     do_count_files = False
  85.     Call DoFolder(fso.GetFolder(HostFolder), sum_files, do_count_files)
  86.    
  87.    
  88.     ' 处理并输出数据
  89.     Call process_and_output
  90.    
  91.     ' 关闭 等待 对话框
  92.     obj_wsc_shell.Run "taskkill /f /im cmd.exe", 0
  93.     obj_wsc_shell.Run "taskkill /f /im mshta.exe", 0
  94.    
  95.    
  96.     dttm2 = Now
  97.     WScript.Echo "DONE, 用时 " & DateDiff("s", dttm1, dttm2) & " 秒"
  98.     ' Debug.Print "DONE, 用时 " & DateDiff("s", dttm1, dttm2) & " 秒"
  99.     WScript.Quit
  100.    
  101. End Sub
  102. Sub process_and_output()
  103.     Dim regEx_CRLF
  104.     Set regEx_CRLF = New RegExp
  105.     regEx_CRLF.Pattern = "[\n\r]+"
  106.     regEx_CRLF.IgnoreCase = True
  107.     regEx_CRLF.Global = True
  108.    
  109.     ' 将合并在一起的所有源数据, 按行分解到一个数组
  110.     all_files_text = regEx_CRLF.Replace(all_files_text, vbLf)
  111.     arr_lines = Split(all_files_text, vbLf)
  112.    
  113.    
  114.     ' 要求是,从同文件夹的所有txt里顺序处理内容。
  115.     ' 1. 没有@的行后面加上@youxiang.com
  116.     ' 2. aa.替换成qy.
  117.     ' 3.  .con替换为.com
  118.     ' 4重复账号只保留一个
  119.     ' 然后顺序保存到一个目录下,每200个账号新存一个txt,命名规则是当天日期-起始数字-结束数字.txt 如:20191207-201-400.txt
  120.     cnt_account = 0
  121.     For i = LBound(arr_lines) To UBound(arr_lines)
  122.         account = Trim(arr_lines(i))
  123.         If account <> "" Then
  124.             
  125.             ' 执行替换规则
  126.             For j = 0 To arr_replace_ubound
  127.                 account = Replace(account, arr_replace_src(j), arr_replace_dest(j))
  128.             Next
  129.             ' 自动补充域名
  130.             If Not (InStr(account, "@") > 0) Then
  131.                 account = account & SUPPLEMENT_DOMAIN
  132.             End If
  133.             
  134.             ' 去重
  135.             If Not dic_account.exists(account) Then
  136.                 dic_account.Add account, ""
  137.                 cnt_account = cnt_account + 1
  138.                 If cnt_account Mod GROUP_NUMBER = 1 Then
  139.                     output_txt = account & vbCrLf
  140.                 Else
  141.                     output_txt = output_txt & account & vbCrLf
  142.                 End If
  143.             End If
  144.             ' 分组输出到文件
  145.             If ((cnt_account > 0) And (cnt_account Mod GROUP_NUMBER = 0) Or (i >= UBound(arr_lines))) Then
  146.                 ind_s = ((cnt_account \ GROUP_NUMBER - 1) * GROUP_NUMBER) + 1
  147.                 output_file_path = output_path & yyyyMMdd & "-" & ind_s & "-" & cnt_account & ".txt"
  148.                 Set output_file = fso.OpenTextFile(output_file_path, ForWriting, True)
  149.                 output_file.Write output_txt
  150.                 output_file.Close
  151.             End If
  152.         End If
  153.     Next
  154.    
  155.     ' 分组输出到文件, 最后一个组, 数量不足分组标准数
  156.     If ((cnt_account > 0) And (cnt_account Mod GROUP_NUMBER <> 0)) Then
  157.         ind_s = ((cnt_account \ GROUP_NUMBER) * GROUP_NUMBER) + 1
  158.         output_file_path = output_path & yyyyMMdd & "-" & ind_s & "-" & cnt_account & ".txt"
  159.         Set output_file = fso.OpenTextFile(output_file_path, ForWriting, True)
  160.         output_file.Write output_txt
  161.         output_file.Close
  162.     End If
  163.    
  164. End Sub
  165. Sub DoFolder(Folder, ByRef sum_files, ByVal do_count_files)
  166.     If output_path = Folder.Path & "\" Then Exit Sub
  167.     ' 在子目录中递归调用
  168.     Dim SubFolder
  169.     For Each SubFolder In Folder.SubFolders
  170.         Call DoFolder(SubFolder, sum_files, do_count_files)
  171.     Next
  172.     Dim file
  173.     For Each file In Folder.Files
  174.         Call doFile(file, sum_files, do_count_files)
  175.     Next
  176. End Sub
  177. Sub doFile(ByRef input_file, ByRef sum_files, ByVal do_count_files)
  178.     ' 分解获取 文件名 和 扩展名
  179.     If InStr(input_file.Name, ".") > 0 Then
  180.         arr = Split(input_file.Name, ".")
  181.         ext_name = UCase(arr(UBound(arr)))
  182.         dot_ext_name = "." & ext_name
  183.     Else
  184.         ext_name = ""
  185.         dot_ext_name = ""
  186.     End If
  187.     ' 跳过 非 txt 文件
  188.     If Not ("TXT" = ext_name) Then
  189.         Exit Sub
  190.     End If
  191.    
  192.     If do_count_files Then
  193.         sum_files = sum_files + 1
  194.         Exit Sub
  195.     End If
  196.     ' cnt_file = cnt_file + 1
  197.     ' Percent = Int(cnt_file * 100 / sum_files)
  198.     file_name = Left(input_file.Name, Len(input_file.Name) - Len(dot_ext_name))
  199.     Set input_file_OTF = fso.OpenTextFile(input_file.Path, ForReading)
  200.     all_files_text = all_files_text & input_file_OTF.Readall & vbCrLf
  201.    
  202. End Sub
  203. Sub debug_WriteLine(output_file, debug_txt)
  204.     If Not DEBUG_SW Then Exit Sub
  205.     output_file.WriteLine debug_txt
  206. End Sub
复制代码

TOP

回复 2# a20150604


    谢谢您了,您加我QQ吧

TOP

返回列表