vb-复制ie临时文件夹下所有mp3文件到指定目录,并且将utf8编码转换过来

简介: vb-复制ie临时文件夹下所有mp3文件到指定目录,并且将utf8编码转换过来

vb-复制ie临时文件夹下所有mp3文件到指定目录,并且将utf8编码转换过来。

Option Explicit
'引用Microsoft Scripting RunTime
Dim m_objFSO As New FileSystemObject   '定义文件系统对象
Private Declare Function SHGetSpecialFolderLocation Lib "Shell32" (ByVal hwndOwner As Long, ByVal nFolder As Integer, ppidl As Long) As Long
Private Declare Function SHGetPathFromIDList Lib "Shell32" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal szPath As String) As Long
Const MAX_LEN = 200 '字符串最大长度
Const PAGETMP = &H20& '网页临时文件
Private Sub Command1_Click()
    Dim sTmp As String * MAX_LEN '存放结果的固定长度的字符串
    Dim nLength As Long '字符串的实际长度
    Dim pidl As Long '某特殊目录在特殊目录列表中的位置
    Dim TStr As String
    '获得网页临时文件夹
    SHGetSpecialFolderLocation 0, PAGETMP, pidl
    SHGetPathFromIDList pidl, sTmp
    TStr = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
    SearchMP3 TStr
End Sub
Private Sub SearchMP3(strPath As String)
    Dim objFolder   As Scripting.Folder   '文件夹对象
    Dim objFile   As Scripting.File   '文件对象
    Dim objSubdirs   As Scripting.Folders   '文件夹集合对象
    Dim objLoopFolder   As Scripting.Folder   '文件夹对象
    Set objFolder = m_objFSO.GetFolder(strPath)
    For Each objFile In objFolder.Files
        If LCase$(Right$(objFile.ShortPath, 4)) = ".mp3" Then
            FileCopy objFile.Path, "c:/TestMP3/" & UTF8Decode(objFile.Name)
        End If
    Next objFile
    Set objSubdirs = objFolder.SubFolders
    For Each objLoopFolder In objSubdirs
        SearchMP3 objLoopFolder.Path
    Next objLoopFolder
    Set objSubdirs = Nothing
    Set objFolder = Nothing
End Sub
Public Function UTF8Decode(ByVal code As String) As String
    If code = "" Then
        UTF8Decode = ""
        Exit Function
    End If
    Dim tmp As String
    Dim decodeStr As String
    Dim codelen As Long
    Dim result As String
    Dim leftStr As String
    leftStr = Left(code, 1)
    While (code <> "")
        codelen = Len(code)
        leftStr = Left(code, 1)
        If leftStr = "%" Then
                If (Mid(code, 2, 1) = "C" Or Mid(code, 2, 1) = "B") Then
                    decodeStr = Replace(Mid(code, 1, 6), "%", "")
                    tmp = c10ton(Val("&H" & Hex(Val("&H" & decodeStr) And &H1F3F)))
                    tmp = String(16 - Len(tmp), "0") & tmp
                    UTF8Decode = UTF8Decode & UTF8Decode & ChrW(Val("&H" & c2to16(Mid(tmp, 3, 4)) & c2to16(Mid(tmp, 7, 2) & Mid(tmp, 11, 2)) & Right(decodeStr, 1)))
                    code = Right(code, codelen - 6)
                ElseIf (Mid(code, 2, 1) = "E") Then
                    decodeStr = Replace(Mid(code, 1, 9), "%", "")
                    tmp = c10ton((Val("&H" & Mid(Hex(Val("&H" & decodeStr) And &HF3F3F), 2, 3))))
                    tmp = String(10 - Len(tmp), "0") & tmp
                    UTF8Decode = UTF8Decode & ChrW(Val("&H" & (Mid(decodeStr, 2, 1) & c2to16(Mid(tmp, 1, 4)) & c2to16(Mid(tmp, 5, 2) & Right(tmp, 2)) & Right(decodeStr, 1))))
                    code = Right(code, codelen - 9)
                End If
        Else
            UTF8Decode = UTF8Decode & leftStr
            code = Right(code, codelen - 1)
        End If
    Wend
End Function
'10进制转n进制(默认2)
Public Function c10ton(ByVal x As Integer, Optional ByVal n As Integer = 2) As String
    Dim i As Integer
    i = x / n
    If i > 0 Then
        If x Mod n > 10 Then
            c10ton = c10ton(i, n) + Chr(x Mod n + 55)
        Else
            c10ton = c10ton(i, n) + CStr(x Mod n)
        End If
    Else
        If x > 10 Then
            c10ton = Chr(x + 55)
        Else
            c10ton = CStr(x)
        End If
    End If
End Function
'二进制代码转换为十六进制代码
Public Function c2to16(ByVal x As String) As String
   Dim i As Long
   i = 1
   For i = 1 To Len(x) Step 4
      c2to16 = c2to16 & Hex(c2to10(Mid(x, i, 4)))
   Next
End Function
'二进制代码转换为十进制代码
Public Function c2to10(ByVal x As String) As String
   c2to10 = 0
   If x = "0" Then Exit Function
   Dim i As Long
   i = 0
   For i = 0 To Len(x) - 1
      If Mid(x, Len(x) - i, 1) = "1" Then c2to10 = c2to10 + 2 ^ (i)
   Next
End Function


sysdzw
+关注
目录
打赏
0
0
0
0
2
分享
相关文章
【Azure 环境】存储在Azure上的文件,使用IE/Edge时自动打开的问题,如何变为下载而非自动打开
【Azure 环境】存储在Azure上的文件,使用IE/Edge时自动打开的问题,如何变为下载而非自动打开
IE浏览器下载文件中文文件名乱码问题解决
IE浏览器下载文件中文文件名乱码问题解决
206 0
ie8 ie浏览器下载excel文件乱码,变成压缩包,解决方案
ie8 ie浏览器下载excel文件乱码,变成压缩包,解决方案
261 0
DotNetNuke(DNN)皮肤制作-通过JS文件解决不同IE版本对CSS解释不一致的问题
IE不同的版本对CSS解释不一致是一个众所周知的问题,有很多解决方案,其中的一个方法是通过加载不同的JS脚本来纠正不同IE版本对CSS的解释,这样你只要按照web标准来编写CSS就可以了。   IE7.js是用来解决版本低于7,高于或等于5的IE上的一些WEB标准的兼容性问题,可以看看解决的兼容性列表。
1012 0
使用Cache-Control: no-store头,禁止IE浏览器保存临时文件,保护机密信息
通常,IE浏览器访问页面时,会在临时文件夹下保存页面的html,js,图片等等。 当页面上包含敏感信息时,这些信息也会存储在临时文件中。
1593 0
阿里云ECS配置vsftpd,windows文件浏览器和IE浏览器不能访问
阿里云服务器ECS配置vsftpd(Centos7.4),浏览器或FileZilla能访问,但windows文件浏览器和IE浏览器不能访问
3183 0
AI助理
登录插画

登录以查看您的控制台资源

管理云资源
状态一览
快捷访问

你好,我是AI助理

可以解答问题、推荐解决方案等