vB编程，小白求教

新建1个窗体1个模块 窗脊唯体引用Microsoft Scripting Runtime

未做窗体 所以没有运行界面 结果以msgbox的方式返回

''''''''''''''窗体代码
'obj引用：Microsoft Scripting Runtime
'本演示仅为遍历"C:\test"下的文件，不会遍历目录及子目录
Option Explicit
Private Sub Form_Load()
 Dim pFolder As String
 Dim fso As New FileSystemObject
 '设咐并定目录
 pFolder = "C:\test"
    
 Dim objFile As Object
 Dim objFolder As Object
 Dim nofile As Boolean
 Set objFolder = fso.GetFolder(pFolder)
 For Each objFile In objFolder.Files
    'MsgBox "返回结果：" & objFile.Path
    
    Dim tmp() As String
    Dim fmd5 As String
    Dim tmpstr As String
    tmpstr = objFile.Path
    
    If InStr(tmpstr, ".txt") Then
       tmp = Split(tmpstr, ".txt")
       '文件改名
       Name tmpstr As tmp(0) & ".fn"
       nofile = True
    End If
    
    If InStr(tmpstr, ".doc") Then
       tmp = Split(tmpstr, ".doc")
       '文件改名
       Name tmpstr As tmp(0) & ".fn"
       nofile = True
       '读取md5值
       fmd5 = HashFile(Replace(tmpstr, ".doc", ".fn"))
       MsgBox fmd5
    End If
    
    If InStr(tmpstr, ".xsl") Then
       tmp = Split(tmpstr, ".xsl")
       '文件改名
       Name tmpstr As tmp(0) & ".fn"
       nofile = True
       '读取md5值
       fmd5 = HashFile(Replace(tmpstr, ".xsl", ".fn"))
       MsgBox fmd5
    End If
 Next
 
 If nofile = False Then MsgBox "提示：“C:\test”目录下没有文件或没有指定类型的文件！"
End Sub 

''''''''模块代码
Option Explicit
Private Declare Function CryptAcquireContext Lib "advapi32.dll" Alias "CryptAcquireContextA" (ByRef phProv As Long, ByVal pszContainer As String, ByVal pszProvider As String, ByVal dwProvType As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptReleaseContext Lib "advapi32.dll" (ByVal hProv As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptCreateHash Lib "advapi32.dll" (ByVal hProv As Long, ByVal Algid As Long, ByVal 衡野迹hKey As Long, ByVal dwFlags As Long, ByRef phHash As Long) As Long
Private Declare Function CryptDestroyHash Lib "advapi32.dll" (ByVal hHash As Long) As Long
Private Declare Function CryptHashData Lib "advapi32.dll" (ByVal hHash As Long, pbData As Any, ByVal dwDataLen As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptGetHashParam Lib "advapi32.dll" (ByVal hHash As Long, ByVal dwParam As Long, pbData As Any, pdwDataLen As Long, ByVal dwFlags As Long) As Long
Private Const PROV_RSA_FULL = 1
Private Const CRYPT_NEWKEYSET = &H8
Private Const ALG_CLASS_HASH = 32768
Private Const ALG_TYPE_ANY = 0
Private Const ALG_SID_MD2 = 1
Private Const ALG_SID_MD4 = 2
Private Const ALG_SID_MD5 = 3
Private Const ALG_SID_SHA1 = 4
Enum HashAlgorithm
   MD2 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD2
   MD4 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD4
   MD5 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD5
   SHA1 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA1
End Enum
Private Const HP_HASHVAL = 2
Private Const HP_HASHSIZE = 4
Function HashFile(ByVal FileName As String, Optional ByVal Algorithm As HashAlgorithm = MD5) As String
Dim hCtx As Long
Dim hHash As Long
Dim lFile As Long
Dim lRes As Long
Dim lLen As Long
Dim lIdx As Long
Dim abHash() As Byte
   If Len(Dir$(FileName)) = 0 Then Err.Raise 53
  
   lRes = CryptAcquireContext(hCtx, vbNullString, vbNullString, PROV_RSA_FULL, 0)
   If lRes = 0 And Err.LastDllError = &H80090016 Then
      lRes = CryptAcquireContext(hCtx, vbNullString, vbNullString, PROV_RSA_FULL, CRYPT_NEWKEYSET)
   End If
  
   If lRes <> 0 Then
      lRes = CryptCreateHash(hCtx, Algorithm, 0, 0, hHash)
      If lRes <> 0 Then
         lFile = FreeFile
        
         Open FileName For Binary As lFile
        
         If Err.Number = 0 Then
        
            Const BLOCK_SIZE As Long = 32 * 1024& ' 32K
            ReDim abBlock(1 To BLOCK_SIZE) As Byte
            Dim lCount As Long
            Dim lBlocks As Long
            Dim lLastBlock As Long
           
            lBlocks = LOF(lFile) \ BLOCK_SIZE
           
            lLastBlock = LOF(lFile) - lBlocks * BLOCK_SIZE
           
            For lCount = 1 To lBlocks
           
               Get lFile, , abBlock
        
               lRes = CryptHashData(hHash, abBlock(1), BLOCK_SIZE, 0)
           
               If lRes = 0 Then Exit For
              
            Next
            If lLastBlock > 0 And lRes <> 0 Then
           
               ReDim abBlock(1 To lLastBlock) As Byte
               Get lFile, , abBlock
              
               lRes = CryptHashData(hHash, abBlock(1), lLastBlock, 0)
              
            End If
           
            Close lFile
        
         End If
         If lRes <> 0 Then
           
            lRes = CryptGetHashParam(hHash, HP_HASHSIZE, lLen, 4, 0)
            If lRes <> 0 Then
                ReDim abHash(0 To lLen - 1)
                lRes = CryptGetHashParam(hHash, HP_HASHVAL, abHash(0), lLen, 0)
                If lRes <> 0 Then
                    For lIdx = 0 To UBound(abHash)
                        HashFile = HashFile & _
                                     Right$("0" & Hex$(abHash(lIdx)), 2)
                    Next
                End If
            End If
         End If
         CryptDestroyHash hHash
      End If
     
   End If
   CryptReleaseContext hCtx, 0
   If lRes = 0 Then Err.Raise Err.LastDllError
End Function