标题: [文件操作] 求助BAT,按垂直分辨率把文件夹内图片复制移动 [打印本页]
作者: ckddd1266 时间: 2019-11-22 18:38 标题: 求助BAT,按垂直分辨率把文件夹内图片复制移动
图片类型都是.tif 或tiff
需求把文件夹包含子文件夹下所有tiff图片,
这些图片有 300dpi 有 200dpi 有150dpi 的,具体制定一种,复制移动到另一个地方。
不胜感激
作者: terse 时间: 2019-11-22 20:27
- $ph = "D:\Image"
- $Directory = "D:\Image\300"
- if (![IO.Directory]::Exists("$Directory"))
- {
- $null = New-Item $Directory -type directory
- }
- $Files = @()
- $extlists = @('.tif','.ttif')
- Foreach ( $ext in $extlists )
- {
- Foreach ($File in [IO.Directory]::EnumerateFiles("$ph","*$ext","TopDirectoryOnly"))
- {
- $img = [System.Drawing.Image]::FromFile($File)
- $dpiX = $img.HorizontalResolution
- $img.Dispose()
- if ($dpiX -eq 300) {
- $Files += $File
- }
- }
- }
-
- $Files | Move-Item -Destination $Directory
复制代码
作者: zaqmlp 时间: 2019-11-22 22:51
本帖最后由 zaqmlp 于 2019-11-23 18:43 编辑
- /*&cls
- @echo off
- set info=互助互利,支付宝扫码头像,感谢打赏
- rem 有问题,可加QQ956535081及时沟通
- title %info%
- set "oldfolder=D:\xxx\源目录"
- set "newfolder=D:\xxx\新目录"
- set vdpi=300
- if not exist "%oldfolder%\" (echo;"%oldfolder%" not found&goto end)
- if not exist "%newfolder%\" md "%newfolder%\"
- cd /d "%oldfolder%\"
- for /f "delims=" %%a in ('dir /a-d/b/s *.tif^|cscript -nologo -e:jscript "%~f0" %vdpi%') do (
- echo;"%%a"
- move /y "%%a" "%newfolder%\"
- )
- :end
- echo;%info%
- pause
- exit
- */
-
- var fso=new ActiveXObject('Scripting.FileSystemObject');
- var sa=new ActiveXObject('Shell.Application');
- var v=0,objFolder=sa.NameSpace(0);
- for(var i=0; i<350; i++){if(/^垂直分[辨辩]率/.test(objFolder.GetDetailsOf(null, i))){v=i;}}
-
- while(!WSH.StdIn.AtEndOfStream){
- var f=fso.GetFile(WSH.StdIn.ReadLine());
- var objFolder=sa.Namespace(f.ParentFolder.Path);
- var objItem=objFolder.ParseName(f.Name);
- var vdpi=objFolder.GetDetailsOf(objItem, v).replace(/\D/g,'');
- if(vdpi==Number(WSH.Arguments(0))){WSH.echo(f.Path);}
- }
复制代码
作者: ckddd1266 时间: 2019-11-22 23:01
回复 2# terse
请大佬再指点下,因为完全看不懂。直接建了个样例,没有搬运成功。
作者: ckddd1266 时间: 2019-11-22 23:10
回复 3# zaqmlp
作者: terse 时间: 2019-11-22 23:11
回复 4# ckddd1266
不是BAT 是powershell 文件后缀是ps1
你什么系统 右键直接运行
作者: ckddd1266 时间: 2019-11-22 23:16
回复 6# terse
2008r2,脚本可以运行了,但没有实现效果
作者: zaqmlp 时间: 2019-11-22 23:37
回复 5# ckddd1266
已改
作者: terse 时间: 2019-11-23 00:24
回复 7# ckddd1266
不确定什么因素 我这边测试可以的 你代码运行提示什么
作者: terse 时间: 2019-11-23 08:26
在D:\Image目录测试 看什么提示- $Directory = "D:\Image\300"
- if (![System.IO.Directory]::Exists($Directory)) {$null = New-Item $Directory -type directory}
- Add-Type -AssemblyName "System.Drawing"
- ls * -Include *.tif,*.ttif |?{$img=[Drawing.Image]::FromFile($_);$img.HorizontalResolution -eq 300; $img.Dispose()}| Move-Item -Destination $Directory
- "按任意键结束"
- $null = [Console]::Readkey()
复制代码
回复 7# ckddd1266
作者: ckddd1266 时间: 2019-11-23 11:37
回复 10# terse
你好,窗口闪现没有提示
作者: ckddd1266 时间: 2019-11-23 11:38
回复 8# zaqmlp
你好,测试少量文件实现了,再去跑一个大概两万多文件的,半个多小时没有移动一个。
作者: flashercs 时间: 2019-11-23 12:32
本帖最后由 flashercs 于 2019-11-23 12:41 编辑
保存为 "按分辨率移动图片.bat" ,先设置路径及扩展名和分辨率,然后双击运行- ' &cls&@cscript -nologo -e:vbscript %0 & pause & exit /b
- Option Explicit
- On Error Resume Next
- Dim srcDir ' As String
- Dim dstDir ' As String
- Dim arrPicExt ' As String()
- Dim HorizontalResolution 'As Double
- ' 源目录
- srcDir = "D:\image"
- ' 目标目录
- dstDir = "D:\image\300"
- ' 扩展名列表
- arrPicExt = Array("tif","tiff")
- ' 图片水平分辨率
- HorizontalResolution = 300
-
- Dim fso,wiaimage
- Set fso = CreateObject("Scripting.FileSystemObject")
- Set wiaimage = CreateObject("WIA.ImageFile")
- ShowError
- If Not fso.FolderExists(dstDir) Then
- fso.CreateFolder(dstDir)
- End If
- ShowError
- ProcessImage fso.GetFolder(srcDir)
- ShowError
-
- Set fso = Nothing
- Set wiaimage = Nothing
-
- Function Includes(ByRef arrIn,ByRef strExt)
- Dim Element
- For Each Element In arrIn
- If Element = strExt Then
- Includes = True
- Exit Function
- End If
- Next
- Includes = False
- End Function
-
- Sub ProcessImage(objFolder)
- Dim objFile
- For Each objFile In objFolder.Files
- If Includes(arrPicExt,LCase(fso.GetExtensionName(objFile.Name))) Then
- wiaimage.LoadFile objFile.Path
- ShowError
- If wiaimage.HorizontalResolution = HorizontalResolution Then
- WSH.Echo "移动 """ & objFile.Path & """ 到 """ & dstDir & "\"""
- objFile.Move dstDir & "\"
- ShowError
- End If
- End If
- Next
- End Sub
-
- Sub ShowError()
- If Err.Number <> 0 Then
- WSH.Echo "Err # " & Err.Number & vbNewLine & _
- "Description: " & Err.Description & vbnewline & _
- "Source: " & Err.Source
- Err.Clear
- End If
- End Sub
复制代码
作者: terse 时间: 2019-11-23 14:07
回复 [url=http://www.bathome.net/redirect.php?
goto=findpost&pid=225144&ptid=54313]11#[/url] ckddd1266
没有提示错误的话 代码应该没问题 可能运行环境引起闪退吧
欢迎光临 批处理之家 (http://www.bathome.net/) |
Powered by Discuz! 7.2 |