中国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