怎么用VBS读取D:\1.jpg的大小和宽高呀 - 中国DOS联盟论坛

Dim sFile,str
PFile =inputbox("Which file?")
Set oPicture = LoadPicture(PFile)
    str = "文件:" & vbTab & PFile & vbCrLf
    str = str & "宽度:" & vbTab & Fix(oPicture.Width / 26.458) & vbCrLf
    str = str & "高度:" & vbTab & Fix(oPicture.Height / 26.458)
Set oPicture = Nothing
WScript.Echo str

Dim PFile,str
Dim oStream
Dim bWidth,bHeight
PFile =inputbox("Which file?")
Set oStream = CreateObject("Adodb.Stream")
With oStream
    .Type = 1
    .Open
    .LoadFromFile PFile
End With

'如果是BMP格式，则Position=18，读4字节；
'如果是gif格式，则为Position=6，读2字节；
'如果是png格式，则Position=16，读4字节
    oStream.Position = 18
    bWidth = oStream.Read(4)
    bHeight = oStream.Read(4)
    oStream.Close
    
    str = "文件:" & vbTab & PFile & vbCrLf
    str = str & "宽度:" & vbTab & Bin2Num(bWidth) & vbCrLf
    str = str & "高度:" & vbTab & Bin2Num(bHeight)
Set oStream = Nothing
WScript.Echo str

'二进制流转换为数值
Private Function Bin2Num(binStr)

    Dim i,numLen
    numLen = Lenb(binStr)
    For i = numLen To 1 Step -1
        Bin2Num = Bin2Num * 256 + Ascb(Midb(binStr,i,1))
    Next

End Function

Dim arrFile
Dim oFile,oDir,oShell
arrFile = MyGetFile()
Set oShell = CreateObject("Shell.Application")
Set oDir = oShell.NameSpace(arrFile(1) + "\")
Set oFile = oDir.ParseName(arrFile(0))
str="文件: " & oDir.GetDetailsOf(oFile,0) & vbCrLf
str=str & oDir.GetDetailsOf(oFile,-1)
WScript.Echo str
Set oFile = Nothing
Set oDir = Nothing
Set oShell = Nothing

Function MyGetFile()
On Error Resume Next
Dim strFile,objFso,objFile
    If WScript.Arguments.Count < 1 Then
        Set objDialog = CreateObject("UserAccounts.CommonDialog")
        objDialog.Filter = "所有文件|*.*|jpg 文件|*.jpg|gif 文件|*.gif|bmp 文件|*.bmp|ico 文件|*.ico"
        objDialog.ShowOpen
        strFile = objDialog.FileName
        Set objDialog = Nothing
    Else
        strFile = WScript.Arguments(0)
    end if
Set objFso = CreateObject("Scripting.FileSystemObject")
Set objFile = objFso.GetFile(strFile)
    If Err Then 
        If Err.Number = 5 Then WScript.Quit
        WScript.Echo Err.Description 
        Err.Clear
        WScript.Quit
    Else
        MyGetFile = Array(objFile.Name,objFile.ParentFolder)
    End If
    
Set objFile = Nothing
Set objFso = Nothing
End Function

[ Last edited by hjkk123 on 2008-6-26 at 10:32 AM ]

第1楼　yywd	发表于 2008-06-24 17:43
中级用户　发帖 130　积分 358
怎么用VBS读取D:\1.jpg的大小和宽高呀怎么用VBS读取D:\1.jpg的大小和宽高呀

第2楼　lxmxn	发表于 2008-06-24 19:35
版主　发帖 4,938　积分 11,386
参考微软脚本中心：http://www.microsoft.com/china/technet/community/scriptcenter/resources/hey051116.mspx

第3楼　yywd	发表于 2008-06-25 07:28
中级用户　发帖 130　积分 358
微软脚本中心：使用四行简单的代码就能够确定图片文件的高度和宽度： Set objImage = CreateObject("WIA.ImageFile") objImage.LoadFile "C:\Scripts\Test.gif" Wscript.Echo "Width: " & objImage.Width Wscript.Echo "Height: " & objImage.Height

第4楼　yywd	发表于 2008-06-26 07:53
中级用户　发帖 130　积分 358
需要安装Windows® Image Acquisition 运行库(点击下载) http://download.microsoft.com/download/WinXPHome/Utility/2.0/WXP/EN-US/WIAAutSDK.zip

第5楼　hjkk123	发表于 2008-06-26 10:30
初级用户　发帖 82　积分 160
Dim sFile,str PFile =inputbox("Which file?") Set oPicture = LoadPicture(PFile) str = "文件:" & vbTab & PFile & vbCrLf str = str & "宽度:" & vbTab & Fix(oPicture.Width / 26.458) & vbCrLf str = str & "高度:" & vbTab & Fix(oPicture.Height / 26.458) Set oPicture = Nothing WScript.Echo str Dim PFile,str Dim oStream Dim bWidth,bHeight PFile =inputbox("Which file?") Set oStream = CreateObject("Adodb.Stream") With oStream .Type = 1 .Open .LoadFromFile PFile End With '如果是BMP格式，则Position=18，读4字节； '如果是gif格式，则为Position=6，读2字节； '如果是png格式，则Position=16，读4字节 oStream.Position = 18 bWidth = oStream.Read(4) bHeight = oStream.Read(4) oStream.Close str = "文件:" & vbTab & PFile & vbCrLf str = str & "宽度:" & vbTab & Bin2Num(bWidth) & vbCrLf str = str & "高度:" & vbTab & Bin2Num(bHeight) Set oStream = Nothing WScript.Echo str '二进制流转换为数值 Private Function Bin2Num(binStr) Dim i,numLen numLen = Lenb(binStr) For i = numLen To 1 Step -1 Bin2Num = Bin2Num * 256 + Ascb(Midb(binStr,i,1)) Next End Function Dim arrFile Dim oFile,oDir,oShell arrFile = MyGetFile() Set oShell = CreateObject("Shell.Application") Set oDir = oShell.NameSpace(arrFile(1) + "\") Set oFile = oDir.ParseName(arrFile(0)) str="文件: " & oDir.GetDetailsOf(oFile,0) & vbCrLf str=str & oDir.GetDetailsOf(oFile,-1) WScript.Echo str Set oFile = Nothing Set oDir = Nothing Set oShell = Nothing Function MyGetFile() On Error Resume Next Dim strFile,objFso,objFile If WScript.Arguments.Count < 1 Then Set objDialog = CreateObject("UserAccounts.CommonDialog") objDialog.Filter = "所有文件\|.\|jpg 文件\|.jpg\|gif 文件\|.gif\|bmp 文件\|.bmp\|ico 文件\|.ico" objDialog.ShowOpen strFile = objDialog.FileName Set objDialog = Nothing Else strFile = WScript.Arguments(0) end if Set objFso = CreateObject("Scripting.FileSystemObject") Set objFile = objFso.GetFile(strFile) If Err Then If Err.Number = 5 Then WScript.Quit WScript.Echo Err.Description Err.Clear WScript.Quit Else MyGetFile = Array(objFile.Name,objFile.ParentFolder) End If Set objFile = Nothing Set objFso = Nothing End Function [ Last edited by hjkk123 on 2008-6-26 at 10:32 AM ]