Attribute VB_Name = "Module1"
Sub Main()
Dim b%, p$, f$, e$
FullName = "c:\winword\legal\filename.exe"
b% = BreakDown("a.b.c", p$, f$, e$): GoSub msgit
b% = BreakDown("g:\'tis is a test \ of a gnarly pathname\a.pre.htm.exe", p$, f$, e$)
b% = BetterBreakDown("a.b.c", p$, f$, e$): GoSub msg1
b% = BetterBreakDown("g:\'tis is a test \ of a gnarly pathname\a.pre.htm.exe", p$, f$, e$)
GoSub msg1
' but what you really should to is the classic SplitPath, not an inferior
' copy with a new name (MS standard)
splitpath "a.b.c", d$, p$, f$, e$: GoSub msg2
splitpath "g:\'tis is a test \ of a gnarly pathname\a.pre.htm.exe", d$, p$, f$, e$
splitpath "", d$, p$, f$, e$: GoSub msg2
splitpath "\*.e*", d$, p$, f$, e$: GoSub msg2
splitpath "D:", d$, p$, f$, e$: GoSub msg2
End
msgit:
m$ = "BreakDown" & vbCrLf$ & vbCrLf$ _
& " Path = " & p$ & vbCrLf$ _
& " Filename = " & f$ & vbCrLf$ _
& " Ext = " & e$
MsgBox m$
Return
msg1:
m$ = "Better BreakDown" & vbCrLf$ & vbCrLf$ _
& " Path = " & p$ & vbCrLf$ _
& " Filename = " & f$ & vbCrLf$ _
& " Ext = " & e$
MsgBox m$
Return
msg2:
m$ = "SplitPath" & vbCrLf$ & vbCrLf$ _
& " Drive = " & d$ & vbCrLf$ _
& " Path = " & p$ & vbCrLf$ _
& " Filename = " & f$ & vbCrLf$ _
& " Ext = " & e$
MsgBox m$
Return
End Sub
Public Function BreakDown(Full As String, FName As String, PName As String, Ext As String) As Integer
If Full = "" Then
BreakDown = False
Exit Function
End If
If InStr(Full, "\") Then
FName = Full
PName = ""
Sloc% = InStr(FName, "\")
Do While Sloc% <> 0
PName = PName + Left$(FName, Sloc%)
FName = Mid$(FName, Sloc% + 1)
Sloc% = InStr(FName, "\")
Loop
Else
PName = ""
FName = Full
End If
Dot% = InStr(Full, ".")
If Dot% <> 0 Then
Ext = Mid$(Full, Dot%)
Else
Ext = ""
End If
BreakDown = True
End Function
Public Function BetterBreakDown(Full As String, PName As String, FName As String, Ext As String) As Integer
' Note: now Breakdown: Source, Path, File, Ext
' MS Breakdown was: Source, File, Path, Ext, which is trashy logic
If Full = "" Then BetterBreakDown = False: Exit Function
' these kinds of filters are often cleaner by setting defaults at the top
BetterBreakDown = True: PName = "": FName = "": Ext = ""
Floc$ = Full ' a local copy we can play with.
GoSub sortoutExt
Sloc% = InStr(Floc$, "\")
If Sloc% = 0 Then FName = Floc$: Exit Function
' we have a backslash
t% = 1
Do While t%
t% = InStr(Sloc% + 1, Floc$, "\")
If t% Then Sloc% = t%
Loop
'
PName = PName + Left$(Floc$, Sloc%)
FName = Mid$(Floc$, Sloc% + 1)
Exit Function
sortoutExt:
' The MS version did not handle files names with multiple periods, I think
' I did not test it.
gotit% = 0: flen% = Len(Full)
For i% = Len(Full) To 1 Step -1
If Mid$(Full, i, 1) = "." Then gotit% = -1: Exit For
Next
If gotit% = -1 And gotit% < flen% Then
Ext = Mid$(Full, i% + 1)
Floc$ = Left$(Floc$, i% - 1)
End If
Return
End Function
Public Sub splitpath(Src$, drive$, path$, FName$, Ext$)
'Some people prever blank returns on a problem.... I prefer CurDir$ info
a$ = CurDir$
drive$ = Left$(a$, 2): path$ = Mid$(a$, 3)
FName$ = "": Ext$ = ""
If Len(Src$) = 0 Then Exit Sub
Floc$ = Src$ ' a local copy we can play with.
GoSub sortoutExt ' isolate EXT if any
GoSub sortoutDrive ' isolate Drive if any
Sloc% = InStr(Floc$, "\")
If Sloc% = 0 Then FName$ = Floc$: Exit Sub
' we have a backslash
t% = 1
Do While t%
t% = InStr(Sloc% + 1, Floc$, "\")
If t% Then Sloc% = t%
Loop
path$ = Left$(Floc$, Sloc%)
FName$ = Mid$(Floc$, Sloc% + 1)
Exit Sub
sortoutDrive:
If Mid$(Floc$, 2, 1) = ":" Then
drive$ = Left$(Floc$, 2)
Floc$ = Mid$(Floc$, 3)
End If
Return
sortoutExt: ' backscan for .
gotit% = 0: flen% = Len(Floc$)
For i% = Len(Floc$) To 1 Step -1
If Mid$(Floc$, i, 1) = "." Then gotit% = -1: Exit For
Next
If gotit% = -1 And gotit% < flen% Then
Ext$ = Mid$(Floc$, i% + 1)
Floc$ = Left$(Floc$, i% - 1)
End If
Return
End Sub
Then 