by The Emporer (4 Submissions)
Category: String Manipulation
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Tue 10th September 2002
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Converts Path/Filenames into DOS format. REVISED!
API Declarations
This one can handle paths with versions in the name, the previous one couldn't.
EX: C:\Program Files\Application 4.0\sounds
*Visit my website and search for 'tools' for VB Tools to help you. (http://LostEmpire.s5.com)
VBcoders
Public Function DosFilename(Filename)
Dim ss(1 To 40) As String
st = 1
c = 0
i = 0
Index = 1
Dim spcFound As Boolean
fName = Left(Filename, Len(Filename) - 4)
Fext = Right(Filename, 4)
Do
i = i + 1
c = c + 1
ss(Index) = Mid(fName, st, i)
If (Right(ss(Index), 1) = " ") Then
ss(Index) = Left(ss(Index), Len(ss(Index)) - 1)
st = st + i
i = 0
spcFound = True
Index = Index + 1
End If
If (c >= Len(fName)) Then Exit Do
DoEvents
Loop
fName = ""
For i = 1 To Index
fName = fName & ss(i)
Next i
If (Len(fName) > 8) Or spcFound Then
DosFilename = Left(fName, 6) & "~1" & Fext
Else
DosFilename = Filename
End If
End Function
Public Function DosPath(Path) As String
Dim Dr(1 To 50) As String
Dim SpcFnd As Boolean
D = Left(Path, 3)
K = RTrim(Mid(Path, 4, Len(Path)))
Do While K <> ""
i = i + 1
For n = 1 To Len(K)
s1 = ""
Dr(i) = Dr(i) & Mid(K, n, 1)
If (Right(Dr(i), 1) = "\") Then Exit For
Next n
K = RTrim(Mid(K, n + 1, Len(K)))
If (Right(Dr(i), 1) = "\") Then Dr(i) = Left(Dr(i), Len(Dr(i)) - 1)
If (Len(Dr(i)) > 8) Then
For X = 1 To Len(Dr(i))
s1 = s1 & Mid(Dr(i), X, 1)
If (Right(s1, 1) = " ") Then s1 = Left(s1, Len(s1) - 1)
Next X
If (InStr(1, Dr(i), ".") > 0) Then
Dr(i) = Left(s1, 6) & "~1.0"
Else: Dr(i) = Left(s1, 6) & "~1"
End If
Else
For X = 1 To Len(Dr(i))
s1 = s1 & Mid(Dr(i), X, 1)
If (Right(s1, 1) = " ") Then SpcFnd = True: s1 = Left(s1, Len(s1) - 1)
Next X
If SpcFnd Then
If InStr(1, Dr(i), ".") Then
ch = "~1.0"
Else: ch = "~1"
End If
If (Len(s1) > 6) Then
Dr(i) = Left(s1, 6) & ch
Else
Dr(i) = s1 & ch
End If
End If
End If
If (K = "\") Or (K = "") Then Exit Do
DoEvents
Loop
DosPath = D
For i2 = 1 To i
DosPath = DosPath & Dr(i2) & "\"
Next i2
End Function
