vb-复制ie临时文件夹下所有mp3文件到指定目录,并且将utf8编码转换过来
2011-04-27 18:35
986 查看
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
相关文章推荐
- vb-复制ie临时文件夹下所有mp3文件到指定目录,并且将utf8编码转换过来
- C#-文件复制到指定目录和复制文件夹中的所有数据
- java 复制文件夹下所有文件到指定的文件夹,不改变目录结构
- 预编译加速编译(precompiled_header),指定临时文件生成目录,使项目文件夹更干净(MOC_DIR,RCC_DIR, UI_DIR, OBJECTS_DIR),#pragma execution_character_set("UTF-8")"这个命令是在编译时产生作用的,而不是运行时
- java遍历文件夹并复制文件到指定目录
- bat复制文件夹下所有文件到另一个目录
- C#实现把指定文件夹下的所有文件复制到指定路径下以及修改指定文件的后缀名
- 复制和删除指定文件夹下面的所有的文件文件夹
- 通过递归查询指定目录下的所有文件和子文件夹下的指定文件名
- VC中遍历指定目录中的所有文件和文件夹
- 单例模式&&遍历指定目录下的所有文件以及文件夹
- 如何将指定文件夹下的所有报表文件循环加载到GridView空间中 并且打开某条数据
- bash shell 遍历指定目录下文件 iconv 编码转换
- java 将某一文件夹下的所有文件 复制到指定文件下
- java单个文件复制,递归删除、复制目录下所有内容,递归创建文件夹,.7z文件解压等
- 指定编码格式读写文件和读取文件夹下所有文件
- 遍历目录下的所有文件夹和文件,为指定文件改名
- php复制目录下的所有文件及文件夹
- 通过递归查询指定目录下的所有文件和子文件夹下的指定文件名
- JAVA处理文件(新建目录,新建文件,删除文件,删除文件夹,删除文件夹里面的所有文件,复制单个文件复制整个文件夹内容)