From: krazymike on
This code is in an Access Database module (VBA). It builds an index
of all files and directory in a given tree.

Sorry, some elements of the paths have been changed in this post due
to some of my firm's policies.

One such file has the path: "\\server\data\shared\username\New
Folderaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaadfasdfasdfasdifuasdiofuy
asdkofuh asdkjfjh askldjfh askdfh askdjfh askldjfh askdjfhasd
\adsfdkjfh askdjfh asldkjfh asdklf hasdfkljashdlfjksdfh.txt" - yes i
made that path intentionally to test long filepaths. That one's 309
characters.

Every file indexed after that one seems to inherit stray chars from
that one. "\\server\data\shared\username
\CLX4IndyGoHelp.chmaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaadfasdfasdfasdifuasdiofuy
asdkofuh asdkjfjh askldjfh askdfh askdjfh askldjfh askdjfhasd" Should
be "\\server\data\shared\username\CLX4IndyGoHelp.chm"

I can't see that I'm doing anything wrong. I'm guessing this is due
to some object or element not getting reinitialized before being
reused, but which? Any thoughts would be appreciated.

Portions of this code were inspired by a post from Karl E. Peterson.

Here's the code:

Option Compare Database
Option Explicit

Private Declare Function FindFirstFile Lib "kernel32" Alias
"FindFirstFileW" _
(ByVal lpFileName As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias
"FindNextFileW" (ByVal _
hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile
As Long) As _
Long

Private Const INVALID_FILE_ATTRIBUTES As Long = -1&
Private Const INVALID_HANDLE_VALUE As Long = -1&

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(0 To 519) As Byte
cAlternate(0 To 27) As Byte
End Type
Dim rsF As Recordset, rsD As Recordset

Public Sub Main()
Dim src As String
Set rsD = CurrentDb.OpenRecordset("dir_list")
Set rsF = CurrentDb.OpenRecordset("file_list")
Do While src = ""
src = Prod_Path
Loop
Call getEm(src)
rsF.Close
rsD.Close
End Sub

Sub getEm(ByVal path As String)
Dim hFind As Long, src As String
Dim nFound As Long, temP As String
Dim wfd As WIN32_FIND_DATA

src = ""
src = path

If Right(path, 1) = "\" Then path = Left(path, Len(path ) - 1)
If Left(path, 2)= "\\" Then
path = "\\?\UNC\" & right(path , Len(path) - 3) & "\*.*"
Else
path = "\\?\" & path & "\*.*"
End If

hFind = FindFirstFile(StrPtr(path), wfd)
If hFind <> INVALID_HANDLE_VALUE Then
Do
temP = Trim(Replace(wfd.cFileName, Chr(0), ""))
If temP <> "." And temP <> ".." Then
Select Case wfd.dwFileAttributes
Case 16
With rsD
.AddNew
!Name = src & "\" & temP
.Update
End With
getEm(src & "\" & temP)
Case Else
With rsF
.AddNew
!Name = src & "\" & temP
!ShortPath = src & "\" &
Trim(Replace(wfd.cAlternate, Chr(0), ""))
.Update
End With
End Select
End If
Loop Until FindNextFile(hFind, wfd) = 0
End If
Call FindClose(hFind) ' Clean up.
End Sub

Function Prod_Path() As String
On Error GoTo Err_pathdialog

Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
Dim vrtSelectedItem As Variant

With fd
If .Show = -1 Then
For Each vrtSelectedItem In .SelectedItems
' MsgBox "The file folder is: " & vrtSelectedItem
temP = vrtSelectedItem
Next vrtSelectedItem
End If
End With
Do While tempP = ""
temP = Prod_Path() 'recurse until a directory is chosen
Loop
Prod_Path = temP
Exit_pathdialog:
Exit Function

Err_pathdialog:
MsgBox Err.Description
Resume Exit_pathdialog

End Function
From: Bob Butler on

"krazymike" <krazymike(a)gmail.com> wrote in message
news:cff3b2a7-8681-4f22-b52c-cdc39c512176(a)k30g2000hse.googlegroups.com...
<cut>
> temP = Trim(Replace(wfd.cFileName, Chr(0), ""))

That line is incorrect; the buffer can contain garbage after the initial
Null character so you are keeping the garbage. Something like this would be
closer:
temP = Left$(wfd.cFileName, Instr(1,wfd.cFileName,vbNullChar)-1)

From: Karl E. Peterson on
krazymike wrote:
> temP = Trim(Replace(wfd.cFileName, Chr(0), ""))

Try changing that to:

temP = TrimNull(wfd.cFileName)

Where:

Private Function TrimNull(ByVal Data As String) As String
Dim nNull As Long
nNull = InStr(Data, vbNullChar)
Select Case nNull
Case 0 ' Just do normal trim
TrimNull = Trim$(Data)
Case 1 ' Empty string
TrimNull = ""
Case Else
TrimNull = Left$(Data, nNull - 1)
End Select
End Function

--
..NET: It's About Trust!
http://vfred.mvps.org


From: Sinna on
Karl E. Peterson wrote:
> krazymike wrote:
>> temP = Trim(Replace(wfd.cFileName, Chr(0), ""))
>
> Try changing that to:
>
> temP = TrimNull(wfd.cFileName)
>
> Where:
>
> Private Function TrimNull(ByVal Data As String) As String
> Dim nNull As Long
> nNull = InStr(Data, vbNullChar)
> Select Case nNull
> Case 0 ' Just do normal trim
> TrimNull = Trim$(Data)
> Case 1 ' Empty string
> TrimNull = ""
> Case Else
> TrimNull = Left$(Data, nNull - 1)
> End Select
> End Function
>
Karl,

I don't see why you're splitting it up into three parts as Left$(foo, 0)
doesn't raise an error.

So I get:
<code>
lNullPos = InStr(1, Data, vbNullChar)
If lNullPos Then Data = Left(Data, lNullPos - 1)
</code>

Sinna
From: Ben Jones on
The output from FindNextFileW is a Unicode string. When interpreted
by VB (ANSI), the two-byte-per-char Unicode is converted to one-byte-
per-char ANSI, resulting in alternating Null bytes throughout the VB
string. My replace is to remove all of them. Otherwise, that
TrimNull (which I was using) was only returning the first character
since the second one was a null.

I fixed my problem, though. Hit me as I was going to sleep. I
would've anticipated this in C++, but not VB. The .cFileName is
defined as a FIXED array of BYTES. So when the field is populated
with such a long value, and gets re-written with a smaller value only
the BYTES needed for the smaller value are replaced. When read, the
trailing bytes are still there, and thus returned.

Here's my fix:

For i = 0 To UBound(wfd.cFileName)
wfd.cFileName(i) = CByte(0)
Next
For i = 0 To UBound(wfd.cAlternate)
wfd.cAlternate(i) = CByte(0)
Next
Loop Until FindNextFile(hFind, wfd) = 0

Thus explicitly resetting these bytes back to the null state.

Thanks for your input.

krazymike

blnBozo_Bit = false

On Jul 7, 5:12 pm, "Karl E. Peterson" <k...(a)mvps.org> wrote:
> krazymike wrote:
> >            temP = Trim(Replace(wfd.cFileName, Chr(0), ""))
>
> Try changing that to:
>
>     temP = TrimNull(wfd.cFileName)
>
> Where:
>
>    Private Function TrimNull(ByVal Data As String) As String
>       Dim nNull As Long
>       nNull = InStr(Data, vbNullChar)
>       Select Case nNull
>          Case 0  ' Just do normal trim
>             TrimNull = Trim$(Data)
>          Case 1  ' Empty string
>             TrimNull = ""
>          Case Else
>             TrimNull = Left$(Data, nNull - 1)
>       End Select
>    End Function
>
> --
> .NET: It's About Trust!
>  http://vfred.mvps.org