Generating the hash value of a file

Question

I have managed to gather code and tried to generate the hash value of a file, but in the present code I need to drag the file on the VBScript, then it gives the hash value.

Can someone help me in re-writing the code where I can select the folder or a group of files and the hash values can be generated and written in the notepad file.

Attaching the code below.

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

Please refer to VBScript to loop through all files in a folder for one part and to How to create text file and write to it in vbscript for other part. Please search this site and use Google before posting questions about simple issues.

Answer 2

Here we go:

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