ファイルのハッシュ値を生成する

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

VBScript to loop through all files in a folderは1部、How to create text file and write to it in vbscriptは他の部分を参照してください。簡単な問題に関する質問を投稿する前に、このサイトを検索してGoogleを使用してください。

Answer 2

ここで行く：

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