Question

我设法收集代码并尝试生成文件的哈希值，但在目前的代码中我需要在VBScript上拖动文件，然后它给出哈希值。

有人可以帮我重写我可以选择文件夹或一组文件的代码，并且可以在记事本文件中生成和写入哈希值。

附上以下代码。

Dim objFile,objFolder,objFSO
Dim Arg, strText

strText = ""
Set objFSO = CreateObject("Scripting.FileSystemObject")

If WScript.Arguments.Count > 0 Then
    For Each Arg in Wscript.Arguments
        Arg = Trim(Arg)
        If InStr(Arg,".") Then
            strText = strText & "Filename: " & Arg & vbNewLine
            If doMd5 Then
                strText = strText & "MD5 --> " & md5(Arg) & vbNewLine
            End If
        End If
    Next
End If

' = 0 arguments means use double-clicked md5.vbs (or possible executed via the command line without filename arguments)

Dim fName
If WScript.Arguments.Count = 0 Then
    fName = ChooseFile(".")
    If fName <> "" Then
        strText = strText & "Filename: " & fName & vbNewLine
        If doMd5 Then
            strText = strText & "MD5 --> " & md5(fName) & vbNewLine
        End If
        Wscript.echo strText 'need this to keep things from going crazy when inserting data into notepad (ensures notepad is top window somehow)
    End If
End If

'exit gracefully if the user canceled file selection in the open file dialog
If strText = "" Then
    Dim strExit
    strExit = "No file selected, exiting gracefully..." & vbNewLine
    strExit = strExit + "Don't forget you can drag and drop files onto this script, too." & vbNewLine
    strExit = strExit + "Or use the 'Send To' right-context menu as detailed in the script." & vbNewLine
    MsgBox  strExit, 0, "MD5.VBS"
    WScript.Quit
End If
Dim WshShell

Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.Run "notepad", 3

WScript.Sleep 500

WshShell.SendKeys strText

Function md5(filename)
    Dim MSXML, EL, MD5Obj

    Set MD5Obj = CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider")
    MD5Obj.ComputeHash_2(readBinaryFile(filename))

    Set MSXML = CreateObject("MSXML2.DOMDocument")
    Set EL = MSXML.CreateElement("tmp")
    EL.DataType = "bin.hex"
    EL.NodeTypedValue = MD5Obj.Hash
    md5 = EL.Text
End Function

Function readBinaryFile(filename)
    Const adTypeBinary = 1
    Dim objStream
    Set objStream = CreateObject("ADODB.Stream")
    objStream.Type = adTypeBinary
    objStream.Open
    If filename <> "" Then
        objStream.LoadFromFile filename  'slight modification here to prevent error msg if no file selected
    End If
    readBinaryFile = objStream.Read
    objStream.Close
    Set objStream = Nothing
End Function

Dim shell, defaultLocalDir, objWMIService, colItems, objItem, ex

Set shell = CreateObject( "WScript.Shell" )
defaultLocalDir = shell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop"
Set shell = Nothing

Function ChooseFile(ByVal initialDir)
    Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")

    Set colItems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
    Dim winVersion

    winVersion = CInt(Left(objItem.version, 1))
    Next
    Set objWMIService = Nothing
    Set colItems = Nothing

    If (winVersion <= 5) Then
        Set cd = CreateObject("UserAccounts.CommonDialog")
        cd.InitialDir = initialDir
        cd.Filter = "ZIP files|*.zip|Text Documents|*.txt|Shell Scripts|*.*sh|All Files|*.*"

        cd.FilterIndex = 4
        If cd.ShowOpen = True Then
            ChooseFile = cd.FileName
        Else
            ChooseFile = ""
        End If
        Set cd = Nothing
    Else
        Set shell = CreateObject( "WScript.Shell" )
        Set ex = shell.Exec( "mshta.exe ""about: """ )
        ChooseFile = Replace( ex.StdOut.ReadAll, vbCRLF, "" )

        Set ex = Nothing
        Set shell = Nothing
    End If
End Function

Answer 1

我们走了：

Set fso = CreateObject("Scripting.FileSystemObject")
Dim oMD5:  Set oMD5 = CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider")
Dim oLog 'As Scripting.TextStream

Set oArgs = WScript.Arguments

If oArgs.Count = 1 Then
    sFolderPath = GetFolderPath()
    Set oLog = fso.CreateTextFile(sFolderPath & "\FileHash.csv", True)
    oLog.Write "sep=" & vbTab & vbCrLf
    CheckFolder oArgs(I)
    oLog.Close
    Msgbox "Done!"
Else
    Msgbox "Drop Folder"
End If

Sub CheckFolder(sFolderPath)
    Dim sKey
    Dim oFolder 'As Scripting.Folder
    Set oFolder = fso.GetFolder(sFolderPath)

    For Each oFile In oFolder.Files
        oLog.Write oFile.Path & vbTab & GetMd5(oFile.Path) & vbCrLf
    Next

    For Each oChildFolder In oFolder.SubFolders
        CheckFolder oChildFolder.Path
    Next
End Sub

Function GetFolderPath()
    Dim oFile 'As Scripting.File
    Set oFile = fso.GetFile(WScript.ScriptFullName)
    GetFolderPath = oFile.ParentFolder
End Function

Function GetMd5(filename)
    Dim oXml, oElement

    oMD5.ComputeHash_2(GetBinaryFile(filename))

    Set oXml = CreateObject("MSXML2.DOMDocument")
    Set oElement = oXml.CreateElement("tmp")
    oElement.DataType = "bin.hex"
    oElement.NodeTypedValue = oMD5.Hash
    GetMd5 = oElement.Text
End Function

Function GetBinaryFile(filename)
    Dim oStream: Set oStream = CreateObject("ADODB.Stream")
    oStream.Type = 1 'adTypeBinary
    oStream.Open
    oStream.LoadFromFile filename
    GetBinaryFile= oStream.Read
    oStream.Close
    Set oStream = Nothing
End Function

Answer 2

一部分请参考VBScript to loop through all files in a folder，其他部分请参考How to create text file and write to it in vbscript。在发布有关简单问题的问题之前，请先搜索此网站并使用Google。

生成文件的哈希值

2 个答案: