VB6的Unicode文件名支持

kvitaliy

谢谢

kx25

Name xx As xx 用 MoveFileW StrPtr(是Unicode), StrPtr(非Unicode) 代替：

Private Declare Function MoveFileW Lib "kernel32.dll" (ByVal lpExistingFileName As Long, ByVal lpNewFileName As Long) As Long

将【Unicode文件路径】改成【 非 Unicode文件路径】，然后想干什么就干什么！

         MoveFileW 和 枚举 支持带“.\”的畸形路径

1. Private Declare Function MoveFileW Lib "kernel32.dll" (ByVal lpExistingFileName As Long, ByVal lpNewFileName As Long) As Long
   
2. 
   
3. Private Function SearchFilesDirW(ByRef CustomArray() As String, ByRef Amount As Long, _
   
4.                                Optional ByVal FileFormat As String = "*", Optional ByVal sPath As String, _
   
5.                                Optional vNote As String = "递归文件") As Boolean ' DIR递归文件(包括子目录、隐藏文件夹、系统文件夹)
   
6.     '
   
7.     Dim s As String, s1 As String, T$$$$, A&, V$$$$(), K&, L&, b As Boolean, R$$$$, NewDir$$$$, nd&, fold$$$$()
   
8.     Dim i As VbFileAttribute
   
9.     '
   
10.     If Left(FileFormat, 1) <> ";" Then FileFormat = ";" & FileFormat
    
11.     If Right(FileFormat, 1) <> ";" Then FileFormat = FileFormat & ";"
    
12.     If Right(sPath, 1) <> "" Then sPath = sPath & ""
    
13.     '
    
14.     i = vbDirectory Or vbHidden Or vbSystem Or vbReadOnly Or vbNormal Or vbArchive
    
15.     s = DirW(sPath, i)
    
16.     Do Until s = vbNullString
    
17.         If s Like "?*.?*" Then
    
18.             If FileFormat = ";*;" Or Len(FileFormat) < 1 Then
    
19.                 Call SetValueToStrArray(CustomArray, Amount, sPath & s)
    
20.             Else
    
21.                 A = InStrRev(s, ".")
    
22.                 If A > 1 Then
    
23.                     T = ";" & UCase(Mid(s, A + 1)) & ";"
    
24.                     b = InStr(FileFormat, T)
    
25.                     If b > 0 Then Call SetValueToStrArray(CustomArray, Amount, sPath & s)
    
26.                 End If
    
27.             End If
    
28.         Else
    
29.             If s <> "." And s <> ".." Then
    
30.                 nd = nd + 1
    
31.                 ReDim Preserve fold$$$$(nd)
    
32.                 fold(nd) = sPath & s & ""
    
33.                 fold(nd) = Replace(fold(nd), "\", "")
    
34.                 If Right(fold(nd), 2) = "." Then fold(nd) = Left(fold(nd), Len(fold(nd)) - 2) & ".."
    
35.             End If
    
36.         End If
    
37.         DoEvents
    
38.         s = DirW
    
39.     Loop
    
40.     '
    
41.     If nd > 0 Then
    
42.         For K = 1 To nd
    
43.             Call SearchFilesDirW(CustomArray, Amount, FileFormat, fold(K))
    
44.             List1.AddItem fold(K)
    
45.         Next
    
46.     End If
    
47. End Function
    
48.                                                                     
    
49. Private Function SetValueToStrArray(ArrayName() As String, ArrayAmount As Long, _
    
50.                                     ByVal ArrayValue As String, Optional vNote As String = "字符串数组赋值") As Boolean
    
51.     '
    
52.     ArrayAmount = ArrayAmount + 1
    
53.     ReDim Preserve ArrayName(1 To ArrayAmount) As String
    
54.     ArrayName(ArrayAmount) = ArrayValue
    
55. End Function
    
56. 
    
57. Private Function SearchFolderDirW(ByRef CustomArray() As String, ByRef Amount As Long, _
    
58.                                Optional ByVal sPath As String, Optional vNote As String = "递归子目录") As Boolean  ' DIR递归子目录(包括子目录、隐藏文件夹、系统文件夹)
    
59.     '
    
60.     Dim s As String, s1 As String, T$$$$, A&, V$$$$(), K&, L&, b As Boolean, R$$$$, NewDir$$$$, nd&, fold$$$$()
    
61.     Dim i As VbFileAttribute
    
62.     '
    
63.     If Right(sPath, 1) <> "" Then sPath = sPath & ""
    
64.     '
    
65.     i = vbDirectory Or vbHidden Or vbSystem Or vbReadOnly Or vbNormal Or vbArchive
    
66.     s = DirW(sPath, i)
    
67.     Do Until s = vbNullString
    
68.         If s Like "?*.?*" Then
    
69.             '
    
70.         Else
    
71.             If s <> "." And s <> ".." Then
    
72.                 nd = nd + 1
    
73.                 ReDim Preserve fold$$$$(nd)
    
74.                 fold(nd) = sPath & s & ""
    
75.                 fold(nd) = Replace(fold(nd), "\", "")
    
76.                 If Right(fold(nd), 2) = "." Then fold(nd) = Left(fold(nd), Len(fold(nd)) - 2) & ".."
    
77.                 Call SetValueToStrArray(CustomArray, Amount, fold(nd))
    
78.             End If
    
79.         End If
    
80.         DoEvents
    
81.         s = DirW
    
82.     Loop
    
83.     '
    
84.     If nd > 0 Then
    
85.         For K = 1 To nd
    
86.             Call SearchFolderDirW(CustomArray, Amount, fold(K))
    
87.         Next
    
88.     End If
    
89. End Function
    
90. 
    
91. Private Sub RenameFile(ByVal sOldName As String, ByVal sNewName As String)  ' 移动、重新命名文件夹或文件
    
92.     MoveFileW StrPtr(sOldName), StrPtr(sNewName)
    
93. End Sub
    
94.                                                                     
    
95. Private Sub Command4_Click()
    
96.     Dim DF$$$$(), A&, i&, L&, K&, R$$$$, b As Boolean
    
97.     '
    
98.     'SearchFilesDirW DF, A, "*", TextBox1.Text    ' 递归文件
    
99.     SearchFolderDirW DF, A, TextBox1.Text  ' 递归子目录
    
100.     If A < 1 Then Exit Sub
     
101.     '
     
102.     List1.Clear
     
103.     For i = A To 1 Step -1
     
104.         Text2.Text = DF(i)  ' TextBox 会把不支持的字符换成： 英文问号
     
105.         If InStr(1, Text2.Text, "?") > 0 Then ' 检查是否含有不支持的字符
     
106.             R = Replace(Text2.Text, "?", "？")  ' 把不支持的字符换成： 中文问号
     
107.             '最好循环检测一下【路径 R 】是否已经存在，存在就在文件名末端加编号。
     
108.             Call RenameFile(DF(i), R)  ' 将【Unicode 路径】改成【 非 Unicode 路径】，
     
109.             DF(i) = R  ' 将路径写回数组
     
110.         End If
     
111.         List1.AddItem DF(i)
     
112.     Next
     
113. End Sub

复制代码