200元求助批处理从txt文件截取到网址信息并判断

曾经的你

费用200元（还可追加），1-2天内完成，
请查看我列出的信息，如果能处理的话，可以在帖子留言，我会回复微信

目录结构如图：
需要处理的是，当前路径下的所有文件夹（实际工作中可能文件名不同，数量也不一致）中的所有txt文件中的所有txt内容




一小部分数据
链接：https://pan.baidu.com/s/1oQnnTWvq07Gl-Qe4ULKvLg
提取码：uoav

问题描述：
采集的一些文章导出为txt文件后，存在一些网址信息，在前期处理中不好被处理，导致了现在的问题。


文件中的网址格式不一，这里复制一小部分文件中含有的内容

好运的好名字：http://www.123.com/qiming/</p><h3>人力资源公司名称
课程试听【复制后面链接在浏览器也可打开】：       www.ab.com.cn/school/3dmodel?type=4&amp;zdhhr-11y04r-1991147216662704187   </p><p>在“3d打
百能网（www.ae.cn</p><p>）是一家专注
异议或投诉，请联系：info@aa.cn</p><p>金江
不过当时 www.n1.com已被人注册
口气注册了www.126.com、www.188.com等一批短数
可打开】：       www.h1.com.cn/school/3dmodel?type=2&amp;zdhhr-10y22r-28436431   </p><p>在“3
复制代码

解决方案：
定位到文中的 .com   .cn     .cc   .net   .org  .top   .vip  字符位置
然后向左截取至第一个不是英文且不是英文标点的位置
向右截取至   “</”  或者第一个不是英文且不是英文标点的位置（哪个先满足条件，就以哪个为准作为结束条件）
//我只是这样想的，可能描述上不不流畅
如果有其他剔除方式也可

处理流程：
截取到网址信息后，判断该网址长度，如果大于6个字符（就是仅有.com  .cn等本身的话不需要处理），则将其移除掉，并将移除掉的内容写入到当前路径下的  info.txt日志中（为了查看是否有截取错误等情况）


其他：单次处理一般数据量在10-60万个txt，速度上尽可能的快

jyswjjgdwtdtj

要不你干脆直接把你采集的网址发过来直接采集？

如果这里有一个字符串
aaa.bb.comasdf</
你是要截取aaa.bb.com还是aaa.bb.comasdf?

jyswjjgdwtdtj

要是效率不够还能再提（但是也没太大作用）

set s=createobject("shell.application")
set f=s.namespace(replace(wscript.scriptfullname,wscript.scriptname,""))
set re=new regexp
set fso=createobject("scripting.filesystemobject")
set info=fso.createtextfile("info.log",2,true)
function gettext(fp)
set a=fso.opentextfile(fp,1)
gettext=a.readall
a.close()
end function
sub writetext(fp,t)
on error resume next
set a=fso.createtextfile(fp,true)
if err.number<>0 then msgbox fp:err.clear
a.write t
a.close()
end sub
re.pattern="[a-zA-Z\.\\]+\.(com|cn|cc|net|org|top|vip)[a-zA-Z\.\\]*"
re.global=true
call ft(f)
sub ft(obj)
set fs=obj.items
fs.filter &h20,"*"
set fi=obj.items
fi.filter &h40,"*.txt"
for each f in fs
call ft(f.getfolder)
next
for each f in fi
t=gettext(f.path)
  for each e in re.execute(t)
    if len(e)<6 then
       t=replace(t,e,"")
       info.writeline e
    end if
  next
call writetext(f.path,t)
next
end sub
复制代码

保存为vbs 建议备份文件在运行
嗯……还是ps代码漂亮 可惜我不会

zaqmlp

<# :
cls&echo off&cd /d "%~dp0"&mode con lines=5000
path %SYSTEMROOT%\System32\WindowsPowerShell\v1.0;%path%
set "current=%cd%"
powershell -NoProfile -ExecutionPolicy bypass "Get-Content -literal '%~f0'|Out-String|Invoke-Expression"
pause
exit
#>
$current=($env:current).trimend('\');
$logfile=$current+'\info.txt';
$enc=New-Object System.Text.UTF8Encoding $False;
$fs=New-Object System.IO.FileStream($logfile, [System.IO.FileMode]::Create);
$sw=New-Object System.IO.StreamWriter($fs, $enc);
$reg='[\x21-\x27\x2a-\x3b\x3f-\x7e\x3d]+(\.com|\.cn|\.cc|\.net|\.org|\.top|\.vip)[\x21-\x27\x2a-\x3b\x3f-\x7e\x3d]*';
$folders=@(dir -literal $current|?{$_ -is [System.IO.DirectoryInfo]});
for($i=0;$i -lt $folders.length;$i++){
    write-host $folders[$i].Name;
    $files=@(dir -literal $folders[$i].FullName|?{('.txt' -eq $_.Extension) -and ($_ -is [System.IO.FileInfo])});
    for($j=0;$j -lt $files.length;$j++){
        $filepath=$files[$j].FullName.Substring($current.length);
        $arr=New-Object -TypeName System.Collections.ArrayList;
        $text=[IO.File]::ReadAllText($files[$j].FullName, $enc);
        $text=[regex]::replace($text, $reg, {
            param($m);
            $it=$m.groups[0].value;
            if($it.length -gt 6){
                [void]$arr.add($it);
                return '';
            }else{return $it;}
        });
        if($arr.count -gt 0){
            [IO.File]::WriteAllText($files[$j].FullName, $text, $enc);
            $line=$filepath+"`r`n"+($arr -join "`r`n");
            $sw.WriteLine($line);
            $sw.WriteLine('');
            $sw.Flush();
        }
    }
}
$sw.Close();
$fs.Close();
复制代码

曾经的你

回复 4# zaqmlp


    感谢老哥，暂时尚未发现问题，200已经扫描头像转过去了，如果需要修改到时候我就再追加回复

曾经的你

回复 3# jyswjjgdwtdtj


    首先说声谢谢
执行后原始文件乱码，暂未看到效果，我使用了另外一个老哥的方案了

曾经的你

回复 4# zaqmlp


    老哥，如果能有一个处理进度条就好了

jyswjjgdwtdtj

嗯 改了一下就好了

set s=createobject("shell.application")
set f=s.namespace(createobject("wscript.shell").currentdirectory)
set re=new regexp
set fso=createobject("scripting.filesystemobject")
set info=fso.createtextfile("info.log",2,true)
function gettext(fp)
    Set objStream = CreateObject("ADODB.Stream")
    objStream.CharSet = "utf-8"
    objStream.Open
    objStream.LoadFromFile fp
   gettext=objstream.readtext
end function
sub writetext(fp,t)
    Set objStream = CreateObject("ADODB.Stream")
    objStream.CharSet = "utf-8"
    objStream.Open
objstream.writetext t
    objStream.savetoFile fp,2
end sub
re.pattern="[a-zA-Z\.\\]+\.(com|cn|cc|net|org|top|vip)[a-zA-Z\.\\]*"
re.global=true
call ft(f)
sub ft(obj)
set fs=obj.items
fs.filter &h20,"*"
set fi=obj.items
fi.filter &h40,"*.txt"
for each f in fs
call ft(f.getfolder)
next
for each f in fi
t=gettext(f.path)
msgbox t
  for each e in re.execute(t)
    if len(e)<6 then
       t=replace(t,e,"")
       info.writeline e
    end if
  next
call writetext(f.path,t)
next
end sub
复制代码