Hallo Zusammen,
wie kann ich unter W2K nach ein komplettes Laufwerk nach Dateinamen durchsuchen und alle Dateien anzeigen lassen ,dessen Dateinamen länger sind als 40 Zeichen.
Besser wäre, dass mir für jeden langen Dateinamen ein „Kürzugsvorschlag“ (auf 40 Zeichen!) angeboten wird, den ich mit „OK“ bestätigen kann oder auch ablehnen kann.
Das ganze vielleicht in VBA?!
Vielen Dank sagt
Roland
hi
http://www.mvps.org/btmtz/drvscan/drvscan.zip
unter diesem link findest du eine source, die deine verzeichnisstruktur durchsucht…
da umbenennen der einzelnen dateien und auslesen der namenslänge wirst du wohl schaffen…
wenn nicht, oder probleme, poste nochmal
viele grüße
rasta
[Bei dieser Antwort wurde das Vollzitat nachträglich automatisiert entfernt]
Hallo Rasta,
ich bekomme leider das Programm nicht geöffnet.
Mir wäre schon sehr damit geholfen, dass ich Dateien mit langen Namen auffinden könnte.
Hast Du noch einen Tipp?
Gruß
Roland
[Bei dieser Antwort wurde das Vollzitat nachträglich automatisiert entfernt]
Hi,
schau dir mal folgenden Link an
http://www.activevb.de/tipps/vb6tipps/tipp0266.html
Da musst du eigentlich nur noch die Länge über Len ermitteln.
Wie du dann einen Alternativnamen wählst, weiß ich jetzt nicht.
Du könntest ja intern eine Variable definieren und die dann an der 40-Stelle des Namens von der Datei stellen
greetz
Mario
hallo roland,
habe den code der frm und bas datei herauskopiert.
ich weiss bzw. denke, du suchst nach einer möglichst einfachen lösung-- aber wozu das rad andauernd neu erfinden- der code ist imho gut kommentiert…
Option Explicit
' Brought to you by Brad Martinez
' http://members.aol.com/btmtz/vb
' Though this example has been optimized for speed,
' it's obviously not as efficient as it could be.
' Consider it a starting point...
' A liberal use of module level variables...
Dim PicHeight%, hLB&, FileSpec$, UseFileSpec%
Dim TotalDirs%, TotalFiles%, Running%
' These variables are allocated at the module level to save on
' stack space & on variable re-allocation time in SearchDirs().
' They could be declared as Static within their respective procs...
Dim WFD As WIN32\_FIND\_DATA, hItem&, hFile&
' SearchDirs() constants
Const vbBackslash = "\"
Const vbAllFiles = "\*.\*"
Const vbKeyDot = 46
Private Sub Form\_Load()
ScaleMode = vbPixels
PicHeight% = Picture1.Height
hLB& = List1.hwnd
' This speeds things a bit but will consume close to 6MB of memory...!!!
SendMessage hLB&, LB\_INITSTORAGE, 30000&, ByVal 30000& \* 200
Move (Screen.Width - Width) \* 0.5, (Screen.Height - Height) \* 0.5
End Sub
Private Sub Form\_KeyDown(KeyCode As Integer, Shift As Integer)
' Cancels the search (Form1.KeyPreview = True)
If KeyCode = vbKeyEscape And Running% Then Running% = False
End Sub
Private Sub Form\_Resize()
' Much faster & cleaner than the Move Method...
MoveWindow hLB&, 0, 0, ScaleWidth, ScaleHeight - PicHeight%, True
End Sub
Private Sub Form\_Unload(Cancel As Integer)
Set Form1 = Nothing
End
End Sub
Private Sub mnuFindFiles\_Click()
' If we're running & we got a click, it's because DoEvents in
' either the SearchDirs() or SearchFileSpec() proc let it happen.
' Tell the proc to stop. Once SearchDirs() has un-recursed itself
' we'll finish off below where we left off...
If Running% Then: Running% = False: Exit Sub
Dim drvbitmask&, maxpwr%, pwr%
On Error Resume Next
FileSpec$ = InputBox("Enter a file spec:" & vbCrLf & vbCrLf & \_
"Searching will begin at drive A and continue " & \_
"until no more drives are found. " & \_
"Click Stop! at any time." & vbCrLf & \_
"The \* and ? wildcards can be used.", \_
"Find File(s)", "\*.exe")
' A parsing routine could be implemented here for
' multiple file spec searches, i.e. "\*.bmp,\*.wmf", etc.
' See the MS KB article Q130860 for information on how
' FindFirstFile() does not handle the "?" wildcard char correctly !!
If Len(FileSpec$) = 0 Then Exit Sub
MousePointer = 11
Running% = True
UseFileSpec% = True
mnuFindFiles.Caption = "&Stop!"
mnuFolderInfo.Enabled = False
List1.Clear
' The following code block is used to demonstrate how
' to search every available drive on a system.
' See the "Browse for Folder" demo for an example of
' selecting individual drives or folders for a search.
' http://members.aol.com/btmtz/vb/browsdlg
drvbitmask& = GetLogicalDrives()
' If GetLogicalDrives() succeeds, the return value is a bitmask representing
' the currently available disk drives. Bit position 0 (the least-significant bit)
' is drive A, bit position 1 is drive B, bit position 2 is drive C, and so on.
' If the function fails, the return value is zero.
' GetLogicalDriveStrings() could be used here instead,
' but it's string buffer would have to be parsed...
If drvbitmask& Then
' Get & search each available drive
maxpwr% = Int(Log(drvbitmask&:wink: / Log(2)) ' a little math...
For pwr% = 0 To maxpwr%
If Running% And (2 ^ pwr% And drvbitmask&:wink: Then \_
Call SearchDirs(Chr$(vbKeyA + pwr%) & ":\")
Next
End If
Running% = False
UseFileSpec% = False
mnuFindFiles.Caption = "&Find File(s)..."
mnuFolderInfo.Enabled = True
MousePointer = 0
Picture1.Cls
Picture1.Print "Find File(s): " & List1.ListCount & " items found matching " & """" & FileSpec$ & """"
Beep
End Sub
Private Sub mnuFolderInfo\_Click()
' If we're running & we got a click, it's because DoEvents in
' either the SearchDirs() or SearchFileSpec() proc let it happen.
' Tell the proc to stop. Once SearchDirs() has un-recursed itself
' we'll finish off below where we left off...
If Running% Then: Running% = False: Exit Sub
Dim searchpath$
On Error Resume Next
searchpath$ = InputBox("Enter a valid explicit path:", "Folder Info", "C:\")
' Doesn't allow relative paths...
If Len(searchpath$) ":" Then Exit Sub
' nornalize path
If Right$(searchpath$, 1) vbBackslash Then searchpath$ = searchpath$ & vbBackslash
' Simple little one-line "FolderExists" expression, can be easily adapted to test for files
If FindClose(FindFirstFile(searchpath$ & vbAllFiles, WFD)) = False Then
MsgBox searchpath$, vbInformation, "Path is invalid": Exit Sub
End If
MousePointer = 11
Running% = True
mnuFolderInfo.Caption = "&Stop!"
mnuFindFiles.Enabled = False
List1.Clear
TotalDirs% = 0
TotalFiles% = 0
Call SearchDirs(searchpath$)
Running% = False
mnuFolderInfo.Caption = "&Folder Info..."
mnuFindFiles.Enabled = True
Picture1.Cls
MousePointer = 0
MsgBox "Total folders: " & vbTab & TotalDirs% & vbCrLf & \_
"Total files: " & vbTab & TotalFiles%, , \_
"Folder Info for: " & searchpath$
End Sub
' This is were it all happens...
' You can use the values in returned in the
' WIN32\_FIND\_DATA structure to virtually obtain any
' information you want for a particular folder or group of files.
' This recursive procedure is similar to the Dir$ function
' example found in the VB3 help file...
Private Sub SearchDirs(curpath$) ' curpath$ is passed w/ trailing "\"
' These can't be static!!! They must be
' re-allocated on each recursive call.
Dim dirs%, dirbuf$(), i%
' Display what's happening...
' A Timer could be used instead to display status at
' pre-defined intervals, saving on PictureBox redraw time...
Picture1.Cls
Picture1.Print "Searching " & curpath$
' Allows the PictureBox to be redrawn
' & this proc to be cancelled by the user.
' It's not necessary to have this in the loop
' below since the loop works so fast...
DoEvents
If Not Running% Then Exit Sub
' This loop finds \*every\* subdir and file in the current dir
hItem& = FindFirstFile(curpath$ & vbAllFiles, WFD)
If hItem& INVALID\_HANDLE\_VALUE Then
Do
' Tests for subdirs only...
If (WFD.dwFileAttributes And vbDirectory) Then
' If not a "." or ".." DOS subdir...
If Asc(WFD.cFileName) vbKeyDot Then
' This is executed in the mnuFindFiles\_Click()
' call though it isn't used...
TotalDirs% = TotalDirs% + 1
' This is the heart of a recursive proc...
' Cache the subdirs of the current dir in the 1 based array.
' This proc calls itself below for each subdir cached in the array.
' (re-allocating the array only once every 10 itinerations improves speed)
If (dirs% Mod 10) = 0 Then ReDim Preserve dirbuf$(dirs% + 10)
dirs% = dirs% + 1
dirbuf$(dirs%) = Left$(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)
End If
' File size and attribute tests can be used here, i.e:
' ElseIf (WFD.dwFileAttributes And vbHidden) = False Then 'etc...
' Get a total file count for mnuFolderInfo\_Click()
ElseIf Not UseFileSpec% Then
TotalFiles% = TotalFiles% + 1
End If
' Get the next subdir or file
Loop While FindNextFile(hItem&, WFD)
' Close the search handle
Call FindClose(hItem&:wink:
End If
' When UseFileSpec% is set mnuFindFiles\_Click(),
' SearchFileSpec() is called & each folder must be
' searched a second time.
If UseFileSpec% Then
' Turning off painting speeds things quite a bit...
' Speed also would be vastly improved if the redrawing
' & scrolling were placed in a Timer event...
SendMessage hLB&, WM\_SETREDRAW, 0, 0
Call SearchFileSpec(curpath$)
' Keeps the currently found items scrolled into view...
SendMessage hLB&, WM\_VSCROLL, SB\_BOTTOM, 0
SendMessage hLB&, WM\_SETREDRAW, 1, 0
End If
' Recursively call this proc & iterate through each subdir cached above.
For i% = 1 To dirs%: SearchDirs curpath$ & dirbuf$(i%) & vbBackslash: Next i%
End Sub
Private Sub SearchFileSpec(curpath$) ' curpath$ is passed w/ trailing "\"
' This procedure \*only\* finds files in the
' current folder that match the FileSpec$
hFile& = FindFirstFile(curpath$ & FileSpec$, WFD)
If hFile& INVALID\_HANDLE\_VALUE Then
Do
' Use DoEvents here since we're loading a ListBox and
' there could be hundreds of files matching the FileSpec$
DoEvents
If Not Running% Then Exit Sub
' The ListBox's Sorted property is initially set to False.
' Set it to True and see how things slow down a bit...
SendMessage hLB&, LB\_ADDSTRING, 0, \_
ByVal curpath$ & Left$(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)
' Get the next file matching the FileSpec$
Loop While FindNextFile(hFile&, WFD)
' Close the search handle
Call FindClose(hFile&:wink:
End If
End Sub
und hier noch der .bas-file
' An application sends an LB\_ADDSTRING message to add a string to a list box.
' If the list box does not have the LBS\_SORT style, the string is added to the end
' of the list. Otherwise, the string is inserted into the list and the list is sorted.
Public Const LB\_ADDSTRING = &H180
Public Const WM\_SETREDRAW = &HB
Public Const WM\_VSCROLL = &H115
Public Const SB\_BOTTOM = 7
' If the function succeeds, the return value is a bitmask
' representing the currently available disk drives. Bit
' position 0 (the least-significant bit) is drive A, bit position
' 1 is drive B, bit position 2 is drive C, and so on.
' If the function fails, the return value is zero.
Declare Function GetLogicalDrives Lib "kernel32" () As Long
' If the function succeeds, the return value is a search handle
' used in a subsequent call to FindNextFile or FindClose
Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" \_
(ByVal lpFileName As String, lpFindFileData As WIN32\_FIND\_DATA) As Long
'FindFirstFile failure rtn value
Public Const INVALID\_HANDLE\_VALUE = -1
' Rtns True (non zero) on succes, False on failure
Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" \_
(ByVal hFindFile As Long, lpFindFileData As WIN32\_FIND\_DATA) As Long
' Rtns True (non zero) on succes, False on failure
Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Public Const MaxLFNPath = 260
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 \* MaxLFNPath
cShortFileName As String \* 14
End Type
gruß
rasta
[Bei dieser Antwort wurde das Vollzitat nachträglich automatisiert entfernt]