VB icon

FileWork.bas

Email
Submitted on: 1/4/2015 3:31:00 PM
By: Rocky Clark (Kath-Rock Software) (from psc cd)  
Level: Intermediate
User Rating: By 4 Users
Compatibility: VB 5.0, VB 6.0
Views: 914
 
     A collection of file associated functions such as GetLongFilename(), GetShortFilename(), GetFilePath(), GetFileTitle(), Exists(), etc.
 

Windows API/Global Declarations:

Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!
'**************************************
'Windows API/Global Declarations for :FileWork.bas
'**************************************
Uses GetLongPathname() and GetShortPathname() API functions.
code:
Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!
				
'**************************************
' Name: FileWork.bas
' Description:A collection of file associated functions such as GetLongFilename(), GetShortFilename(), GetFilePath(), GetFileTitle(), Exists(), etc.
' By: Rocky Clark (Kath-Rock Software) (from psc cd)
'
' Assumes:Great for beginners or power coders. Simply create a new Module, name it something like basFileWork(FileWork.bas), then copy and paste the entire code sample into the 'General/Declarations' section.
'**************************************

'API declarations
Public Declare Function GetLongPathName Lib "kernel32" Alias "GetLongPathNameA" (ByVal lpszShortPath As String, ByVal lpszLongPath As String, ByVal cchBuffer As Long) As Long
Public Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Public Function AddBackSlash(ByVal sPath As String) As String
'Returns sPath with a trailing backslash if sPath does not
'already have a trailing backslash. Otherwise, returns sPath.
 sPath = Trim$(sPath)
 If Len(sPath) > 0 Then
sPath = sPath & IIf(Right$(sPath, 1) <> "\", "\", "")
 End If
 AddBackSlash = sPath
 
End Function
Public Function GetLongFilename(ByVal sShortFilename As String) As String
'Returns the Long Filename associated with sShortFilename
Dim lRet As Long
Dim sLongFilename As String
 'First attempt using 1024 character buffer.
 sLongFilename = String$(1024, " ")
 lRet = GetLongPathName(sShortFilename, sLongFilename, Len(sLongFilename))
 
 'If buffer is too small lRet contains buffer size needed.
 If lRet > Len(sLongFilename) Then
'Increase buffer size...
sLongFilename = String$(lRet + 1, " ")
'and try again.
lRet = GetLongPathName(sShortFilename, sLongFilename, Len(sLongFilename))
 End If
 
 'lRet contains the number of characters returned.
 If lRet > 0 Then
GetLongFilename = Left$(sLongFilename, lRet)
 End If
 
End Function
Public Function GetShortFilename(ByVal sLongFilename As String) As String
'Returns the Short Filename associated with sLongFilename
Dim lRet As Long
Dim sShortFilename As String
 'First attempt using 1024 character buffer.
 sShortFilename = String$(1024, " ")
 lRet = GetShortPathName(sLongFilename, sShortFilename, Len(sShortFilename))
 
 'If buffer is too small lRet contains buffer size needed.
 If lRet > Len(sShortFilename) Then
'Increase buffer size...
sShortFilename = String$(lRet + 1, " ")
'and try again.
lRet = GetShortPathName(sLongFilename, sShortFilename, Len(sShortFilename))
 End If
 
 'lRet contains the number of characters returned.
 If lRet > 0 Then
GetShortFilename = Left$(sShortFilename, lRet)
 End If
 
End Function
Public Function RemoveBackSlash(ByVal sPath As String) As String
'Returns sPath without a trailing backslash if sPath
'has one. Otherwise, returns sPath.
 
 sPath = Trim$(sPath)
 If Len(sPath) > 0 Then
sPath = Left$(sPath, Len(sPath) - IIf(Right$(sPath, 1) = "\", 1, 0))
 End If
 RemoveBackSlash = sPath
 
End Function
Public Function AppPath() As String
'Returns App.Path with backslash "\"
Dim sPath As String
 sPath = App.Path
 AppPath = sPath & IIf(Right$(sPath, 1) <> "\", "\", "")
 
End Function
Public Function Exists(ByVal sFilename As String) As Boolean
'Returns True if File Exists.
'Else returns False.
 If Len(Trim$(sFilename)) > 0 Then
On Error Resume Next
sFilename = Dir$(sFilename)
Exists = ((Err.Number = 0) And (Len(sFilename) > 0))
 Else
Exists = False
 End If
 
End Function
Public Function GetFilePath(ByVal sFilename As String, Optional ByVal bAddBackslash As Boolean) As String
'Returns Path Without FileTitle
Dim lPos As Long
 lPos = InStrRev(sFilename, "\")
 If lPos > 0 Then
GetFilePath = Left$(sFilename, lPos - 1) _
 & IIf(bAddBackslash, "\", "")
 Else
GetFilePath = ""
 End If
 
End Function
Public Function GetFileTitle(ByVal sFilename As String) As String
'Returns FileTitle Without Path
Dim lPos As Long
 lPos = InStrRev(sFilename, "\")
 If lPos > 0 Then
If lPos < Len(sFilename) Then
 GetFileTitle = Mid$(sFilename, lPos + 1)
Else
 GetFileTitle = ""
End If
 Else
GetFileTitle = sFilename
 End If
 
End Function


Other 11 submission(s) by this author

 


Report Bad Submission
Use this form to tell us if this entry should be deleted (i.e contains no code, is a virus, etc.).
This submission should be removed because:

Your Vote

What do you think of this code (in the Intermediate category)?
(The code with your highest vote will win this month's coding contest!)
Excellent  Good  Average  Below Average  Poor (See voting log ...)
 

Other User Comments


 There are no comments on this submission.
 

Add Your Feedback
Your feedback will be posted below and an email sent to the author. Please remember that the author was kind enough to share this with you, so any criticisms must be stated politely, or they will be deleted. (For feedback not related to this particular code, please click here instead.)
 

To post feedback, first please login.