-
Feb 10th, 2019, 06:12 AM
#1
Thread Starter
Hyperactive Member
Need help changing code to make it Unicode aware
I have been using this routine for a long time and always worked fine.
However, i have come across a few files in Polish that have accented letters.
my routine returns a file name with replaced characters , which means if i try to
work with this file, it would not be found.
Code is below and would like some help to make it unicode aware.
I know its something to do with FindFirstFile and changing to FindFirstFileW. However i changed them all to W but broke the routine.
Also , if filename is returned as a Unicode , how would i deal with this in VB and allow VB to then copy file to new location
keeping its accents etc.
thanks in advance
Code:
'EXAMPLE
'
' Dim asFiles() As String, lThisFile As Long, lNumFiles As Long
'
' lNumFiles = FileSearch(asFiles, Foldername, "*.txt;*.xls", True, True)
'
' For lThisFile = 1 To lNumFiles
' If Right$(asFiles(lThisFile), 1) = "\" Then
' Debug.Print "FOLDER " & asFiles(lThisFile)
' Else
' Debug.Print asFiles(lThisFile)
' End If
' Next
Private Const MAX_PATH As Long = 260
Private Const INVALID_HANDLE_VALUE As Long = -1
Private Const FILE_ATTRIBUTE_ARCHIVE As Long = &H20
Private Const FILE_ATTRIBUTE_COMPRESSED As Long = &H800
Private Const FILE_ATTRIBUTE_DIRECTORY As Long = &H10
Private Const FILE_ATTRIBUTE_HIDDEN As Long = &H2
Private Const FILE_ATTRIBUTE_NORMAL As Long = &H80
Private Const FILE_ATTRIBUTE_READONLY As Long = &H1
Private Const FILE_ATTRIBUTE_TEMPORARY As Long = &H100
Private Const FILE_ATTRIBUTE_FLAGS = FILE_ATTRIBUTE_ARCHIVE Or FILE_ATTRIBUTE_HIDDEN Or FILE_ATTRIBUTE_NORMAL Or FILE_ATTRIBUTE_READONLY
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function SearchTreeForFile Lib "imagehlp.dll" (ByVal sFileRoot As String, ByVal InputPathName As String, ByVal OutputPathBuffer As String) As Boolean
Private Declare Function lstrlen Lib "kernel32" _
Alias "lstrlenW" (ByVal lpString As Long) As Long
Private Declare Function PathMatchSpec Lib "shlwapi" _
Alias "PathMatchSpecW" _
(ByVal pszFileParam As Long, _
ByVal pszSpec As Long) As Long
Private Function MatchExtention(sFile As String, sSpec As String) As Boolean
MatchExtention = PathMatchSpec(StrPtr(sFile), StrPtr(sSpec))
End Function
'Purpose : Performs a recursive search for a file or file pattern.
'Inputs : asMatchingFiles See outputs.
' sRootPath The path to begin the search from eg. "C:\"
' sSearchFor The file name or pattern to search for eg. "Test.xls" or "*.xls"
' bRecursiveSearch If True searchs all subfolders in sRootPath for matching files.
'Outputs : asMatchingFiles A one based, 1d string array containing the paths and names of
' the matching files. SEE NOTES.
' Returns the number of matching files.
'Notes : Example:
' FileSearch asFiles, "C:\", "*.ocx", True 'Populates asFiles with all the .ocx files on your C: drive
Function FileSearch(ByRef asMatchingFiles() As String, ByVal sRootPath As String, sSearchFor As String, Optional bRecursiveSearch As Boolean = True, Optional ShowFolders As Boolean = False) As Long
Dim tFindFile As WIN32_FIND_DATA
Dim lNumFound As Long, lHwndFile As Long
Dim sItemName As String, sThisPath As String
Dim asDirs() As String, lNumDirs As Long, lThisDir As Long
Static sbRecursion As Boolean
On Error Resume Next
If sbRecursion = False Then
'Clear existing list
Erase asMatchingFiles
End If
If Right$(sRootPath, 1) <> "\" Then
sRootPath = sRootPath & "\"
End If
lNumFound = UBound(asMatchingFiles)
'Get handle to folder
lHwndFile = FindFirstFile(sRootPath & "*", tFindFile)
If lHwndFile <> INVALID_HANDLE_VALUE Then
'-------Found a matching file, loop over other matching files
Do
If CancelProcess = True Then
Exit Function
End If
If (tFindFile.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) Then
sItemName = Left$(tFindFile.cFileName, InStr(1, tFindFile.cFileName, vbNullChar) - 1)
'Check directory name is valid
If sItemName <> "." And sItemName <> ".." Then
'Store directory
lNumDirs = lNumDirs + 1
If lNumDirs = 1 Then
ReDim asDirs(1 To lNumDirs)
Else
ReDim Preserve asDirs(1 To lNumDirs)
End If
sThisPath = sRootPath & sItemName
asDirs(lNumDirs) = sThisPath
If ShowFolders = True Then
lNumFound = lNumFound + 1
If lNumFound = 1 Then
ReDim asMatchingFiles(1 To 1)
Else
ReDim Preserve asMatchingFiles(1 To lNumFound)
End If
asMatchingFiles(lNumFound) = sThisPath & "\"
End If
End If
Else
'Found file
sItemName = Left$(tFindFile.cFileName, InStr(1, tFindFile.cFileName, vbNullChar) - 1)
If MatchExtention(sItemName, sSearchFor) Then
'If sItemName Like sSearchFor Then
'Found matching file
lNumFound = lNumFound + 1
If lNumFound = 1 Then
ReDim asMatchingFiles(1 To 1)
Else
ReDim Preserve asMatchingFiles(1 To lNumFound)
End If
asMatchingFiles(lNumFound) = sRootPath & sItemName
End If
End If
Loop While FindNextFile(lHwndFile, tFindFile)
'Close find handle
lHwndFile = FindClose(lHwndFile)
If bRecursiveSearch Then
'-----------Loop over folders
For lThisDir = 1 To lNumDirs
'Item is a folder, search subfolders for matching files
sThisPath = asDirs(lThisDir)
sbRecursion = True
FileSearch asMatchingFiles, sThisPath, sSearchFor, bRecursiveSearch
sbRecursion = False
Next
End If
End If
FileSearch = UBound(asMatchingFiles)
End Function
-
Feb 10th, 2019, 07:55 AM
#2
Re: Need help changing code to make it Unicode aware
The following is a "how to" because it seems you want to understand (vs just a quick fix). Give it a try and let us know if all went well or whether I forgot to tell you something
----------------------------------------
Typically, you can't just change them to W. Change just the ones that have an A suffix to W suffix. If no A suffix, no change.
Now for each of those you change, look at the parameters and see if any of them are currently a String vartype. If they are, you need to change them to Long, not String. Then for each of the APIs you call in code, you replace the string variable you are passing with: StrPtr([theString])
Sounds simple enough, but there's more. If you have UDT/Type structures that have strings that are passed as parameters, you want to change the parameter from the UDT/Type to ByVal Long. Otherwise, VB will convert the strings in those UDT/Types to ANSI. If no UDT/Type member contains strings, nothing special needed.
It is really simple once you understand what's needed and have done it several times. So, I'll give you an example for one of the APIs that has all three of the cases I stated above.
Currently, you have this API defined like this:
Code:
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" ( _
ByVal lpFileName As String, _
lpFindFileData As WIN32_FIND_DATA) As Long
1. Change the API name from A to W
Code:
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileW" ( _
ByVal lpFileName As String, _
lpFindFileData As WIN32_FIND_DATA) As Long
2. Change String parameters to Long
Code:
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileW" ( _
ByVal lpFileName As Long, _
lpFindFileData As WIN32_FIND_DATA) As Long
3. Change UDTs (that have string members) to "ByVal Long"
Code:
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileW" ( _
ByVal lpFileName As Long, _
ByVal lpFindFileData As Long) As Long
Now change your API calls in code. In this case, we need to change the String & UDT/Type parameters in each call
Here's a sample call from your code
Code:
lHwndFile = FindFirstFile(sRootPath & "*", tFindFile)
And here it is, modified
Code:
lHwndFile = FindFirstFile(StrPtr(sRootPath & "*"), VarPtr(tFindFile))
Ok, all said and done. You will not be able to access these files with VB methods because of the unicode. You will likely need to use APIs for most things. In addition, you'll have issues displaying unicode characters within VB.
Last edited by LaVolpe; Feb 10th, 2019 at 08:02 AM.
Reason: typo
-
Feb 10th, 2019, 08:15 AM
#3
Re: Need help changing code to make it Unicode aware
Oh, and doesn't apply to your specific example. If an API returns a String, then that needs to be changed to Long also. But you'll need to copy the return value (actually a pointer to string data) to a VB string. On this forum there are several examples to do this. Search for "String From Pointer"
-
Feb 10th, 2019, 08:22 AM
#4
Thread Starter
Hyperactive Member
Re: Need help changing code to make it Unicode aware
Ok, all said and done. You will not be able to access these files with VB methods because of the unicode. You will likely need to use APIs for most things. In addition, you'll have issues displaying unicode characters within VB.[/QUOTE]
Hi LaVolpe. thanks for the info. I have made the adjustments and seems to still work ok.
However , as you said , how to get the filename into my grid.
I do used VSFlexgrid and it does have a Unicode version so would be able to load filename into the grid.
I also found that if you use GetShortPath api this would still find the file and allow vb6 to copy etc.
I tried to use GetShortPath on the filename from the returned string, but it still shows as non unicode.
How can i get the result from GetShortPath(asFiles(lThisFile)) in unicode format so that i can do this.
VSFlexGrid1.TextMatrix(lThisFile, 0) = GetShortPath(asFiles(lThisFile))
I even thought about using a ShellolderItem to hold the Unicodefilename ie ShellolderItem .Path = Unicodefilename but
this did not work.
Any more advise
tks
-
Feb 10th, 2019, 08:28 AM
#5
Re: Need help changing code to make it Unicode aware
What is GetShortPath? Is it the API GetShortPathNameA or a routine wrapped around that API?
If so, modify that API and its call also, as shown earlier.
Edited: I didn't tell you everything
That API has a string passed ByRef. You don't pass StrPtrs ByRef, so ensure you change that parameter to both ByVal and Long vs. ByRef and String
And you don't pass vbNullString to unicode APIs. Instead, you simply pass zero
Last edited by LaVolpe; Feb 10th, 2019 at 08:40 AM.
-
Feb 10th, 2019, 08:40 AM
#6
Thread Starter
Hyperactive Member
Re: Need help changing code to make it Unicode aware
Originally Posted by LaVolpe
What is GetShortPath? Is it the API GetShortPathNameA or a routine wrapped around that API?
If so, modify that API and its call also, as shown earlier.
this is what i have.
but it does not return a filename for the unicode file , Just ""
Code:
VSFlexGrid1.ColDataType(0) = flexDTStringW ' unless this is not correct. will check documentation
Dim asFiles() As String, lThisFile As Long, lNumFiles As Long ' <<< do i need to changed this asFiles() as Long as well.?
lNumFiles = FileSearch(asFiles, "C:\test\", "*.jpg", True, False)
For lThisFile = 1 To lNumFiles
VSFlexGrid1.Rows = VSFlexGrid1.Rows + 1
VSFlexGrid1.TextMatrix(lThisFile, 0) = GetShortPath(asFiles(lThisFile))
Debug.Print asFiles(lThisFile)
Next
Private Declare Function GetShortPathNameW& Lib "kernel32" (ByVal lpLongPath&, ByVal lpShortPath&, ByVal nBufLen&)
Function GetShortPath(PathName As String) As String
Dim S As String
S = Space$(260)
GetShortPath = Left$(S, GetShortPathNameW(StrPtr(PathName), StrPtr(S), Len(S)))
End Function
Tried this earlier and it works
Code:
Dim x As Integer
Dim Shell32 As New Shell32.Shell, Item As Shell32.ShellFolderItem
For Each Item In Shell32.NameSpace("C:\test\").Items
' If StrComp(Right$(Item.Path, 4), ".jpg", vbTextCompare) = 0 Then
Dim ShrtPath As String, FNr As Long
VSFlexGrid1.TextMatrix(x, 0) = Item.Path
VSFlexGrid1.TextMatrix(x, 1) = GetShortPath(Item.Path) 'get an ANSI-compatible Path from the Unicode-Path
next
but wanted to do something with my existing code
Just checked with 2nd bit of code and the Unicode grid and it shows the unicode string as it should.
Last edited by k_zeon; Feb 10th, 2019 at 08:47 AM.
-
Feb 10th, 2019, 08:53 AM
#7
Re: Need help changing code to make it Unicode aware
That function is not written correctly. See API documentation for more information, especially regarding a return value of zero.
If your buffer string is not large enough, the function will return zero (failure). To get the length of the buffer needed, pass the last two parameters as zero and API returns length needed. Then size the buffer and pass the last two parameters appropriately.
If the API fails (returns zero), immediately call Err.LastDllError to determine why and then google the error code
-
Feb 10th, 2019, 08:56 AM
#8
Thread Starter
Hyperactive Member
Re: Need help changing code to make it Unicode aware
I am struggling to reuse my existing code, sorry but i have always had issues trying to code for unicode.
I do for my own fun and even though been coding for a long time never really got past the unicode stuff.
This seems to work and do what i need. But it is not recursive.
How can i make it so it looks in subdirs. maybe this code can be used for the app i am making.
Code:
Dim sSearchFor As String
sSearchFor = "*.jpg"
Dim x As Integer
Dim Shell32 As New Shell32.Shell, Item As Shell32.ShellFolderItem
For Each Item In Shell32.NameSpace("C:\test\").Items
If MatchExtention(Right$(Item.Path, 4), sSearchFor) Then
Dim ShrtPath As String
VSFlexGrid1.TextMatrix(x, 0) = Item.Path
VSFlexGrid1.TextMatrix(x, 1) = GetShortPath(Item.Path) 'get an ANSI-compatible Path from the Unicode-Path
x = x + 1
End If
Next
-
Feb 10th, 2019, 09:04 AM
#9
Re: Need help changing code to make it Unicode aware
If you want to use the Shell object, then I wouldn't recommend mixing in APIs and Shell object unless absolutely necessary. I'd think that the Shell object would contain most/all of the methods you need for iterating folder structures.
If you could do this with ANSI APIs, you can do this with Unicode APIs (except for displaying correctly, possibly). Its just a matter of taking your time and knowing which APIs need to be converted to "W" version.
Here's another scenario that can cause GetShortName to return a blank string. It is annotated in the GetShortPathName API page I linked you to.
It is possible to have access to a file or directory but not have access to some of the parent directories of that file or directory. As a result, GetShortPathName may fail when it is unable to query the parent directory of a path component to determine the short name for that component.
-
Feb 10th, 2019, 09:25 AM
#10
Re: Need help changing code to make it Unicode aware
As for recursion, using the Shell object, try searching this site. I prefer google and a search string like this should return hits worth looking at:
recursive directory search shell object site:vbforums.com
Within the google hits, I see this posting by a well respected member. Maybe it's what you are looking for?
http://www.vbforums.com/showthread.p...=1#post3799913
-
Feb 10th, 2019, 10:55 AM
#11
Thread Starter
Hyperactive Member
Re: Need help changing code to make it Unicode aware
got the shell recursion working now. A quick question. Is there any variable that can hold a unicode filename ie a Unicodearray of filenames.
and if yes, as they are now unicode string , how could you use them.
What i mean is, i can now load them to a unicode grid and displays fine. Now i want to do something with the file ie copy to new location.
can i use an api copy (based on the grid file path ) and will it move the unicode file to new location with same filename.
tks
-
Feb 10th, 2019, 11:11 AM
#12
Re: Need help changing code to make it Unicode aware
Strings in VB are unicode. For example, LenB("Hello") returns 10. If it were not unicode, it would return 5. VB however, does conversions between unicode/ANSI when API parameters are defined as String and/or passed UDTs have members declared as String.
I'd expect the shell object to have a copy function, along with other file methods. But to answer your question: Yes, just ensure you convert "A" APIs to "W" correctly.
-
Feb 11th, 2019, 08:09 AM
#13
Re: Need help changing code to make it Unicode aware
Originally Posted by LaVolpe
Here's a sample call from your code
Code:
lHwndFile = FindFirstFile(sRootPath & "*", tFindFile)
And here it is, modified
Code:
lHwndFile = FindFirstFile(StrPtr(sRootPath & "*"), VarPtr(tFindFile))
JFYI, calling StrPtr on temp strings is extremely dangerous as this temp BSTR does not outlive StrPtr and is effectively deallocated before calling FindFirstFile although it's content is still present in string heap, so the call seems to work ok.
cheers,
</wqw>
-
Feb 11th, 2019, 08:23 AM
#14
Re: Need help changing code to make it Unicode aware
Originally Posted by wqweto
... although it's content is still present in string heap, so the call seems to work ok.
</wqw>
Yepper, which is why I have no qualms about using StrPtr() on temp strings and do it often.
-
Feb 11th, 2019, 08:59 AM
#15
Re: Need help changing code to make it Unicode aware
Originally Posted by LaVolpe
Yepper, which is why I have no qualms about using StrPtr() on temp strings and do it often.
Yes, you are actually right. I just peeked at what this compiles to and the thing is sRootPath & "*" gets assigned to a temp variable that gets vbaFreeStr'd *after* calling FindFirstFile and even after collecting LastDllError from the API call.
It seems temp variables are deallocated after the *whole* current statement is executed, so deallocation cannot occur between argument evaluation no matter how complex these expressions get (incl calling more functions etc.)
This has been discussed here before but couldn't find anyone making the effort to inspect the disassembly to confirm that temp string variables "raw" addresses from StrPtr can be safely used until the end of the statement they are being evaluated from.
cheers,
</wqw>
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|