Postup:
V projektu založte novou třídu.
Do této třídy vložte následující kód:
Option Explicit
Private msFullPath As String
Private msPath As String
Private msDrive As String
Private msFile As String
Private msExt As String
Public Property Get FullPath() As String
FullPath = msFullPath
End Property
Public Property Let FullPath(sNewFullPath As String)
Dim
iPos As Integer
Dim iCounter As Integer
msFullPath = sNewFullPath
msDrive = ""
msPath = ""
msFile = ""
msExt = ""
'Zjištění disku
iPos =
InStr(1, msFullPath, ":")
If iPos > 0 Then 'Drive exists
msDrive = Left$(msFullPath, iPos)
End If
If Right$(msFullPath, 1) = "/" Or _
Right$(msFullPath, 1) = "\" Or _
InStr(1, msFullPath, ".") = 0 Then
'Na cestě není specifikován soubor
msFile = ""
msExt = ""
msPath = msFullPath
'Připojit backslash pokud tam nejsou
If Right$(msPath, 1) <> "/" And _
Right$(msPath, 1) <> "\" Then
msPath =
msPath & "\"
End If
Else
iPos = Len(msFullPath)
'Cyklus po msFullPath dokud nezjistíme celé jméno
For iCounter = iPos To 1 Step -1
If Mid$(msFullPath,
iCounter, 1) = "/" _
Or
Mid$(msFullPath, iCounter, 1) = "\" Then
'není více znaků
Exit For
Else
msFile = Mid$(msFullPath, _
iCounter, 1) & msFile
End If
Next
'Zjištění
cesty bez jména souboru
msPath = Left$(msFullPath, _
Len(msFullPath) - Len(msFile))
'Zjištění
přípony
iPos = InStr(1, msFile, ".")
msExt = Right$(msFile, Len(msFile)
- iPos)
End If
End Property
Public Property Get Path() As String
Path = msPath
End Property
Public Property Get Drive() As String
Drive = msDrive
End Property
Public Property Get File() As String
File = msFile
End Property
Public Property Get Extension() As String
Extension = msExt
End Property
Nyní, při volání třídy, zadejte cestu
do FullPath a pak už si jenom zjistěte hodnoty pro Drive, Path, File a
Extension.
|