shorten long file names 3

[hennep]

I need a function to shorten the path to a file.
I have seen programs that show this path for example:
"c:\program files\common files\some file.ext"

as something similar to this:
"c:\program\...\some file.ext"

can this be done with some API call ?

 

[vb5prgrmr]

with the API of...
[tt]
Public Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
[/tt]

GetShortPathName
The GetShortPathName function obtains the short path form of a specified input path.

DWORD GetShortPathName(
LPCTSTR lpszLongPath, // pointer to a null-terminated path string
LPTSTR lpszShortPath, // pointer to a buffer to receive the
// null-terminated short form of the path
DWORD cchBuffer // specifies the size of the buffer pointed
// to by lpszShortPath
);

Parameters
lpszLongPath
Pointer to a null-terminated path string. The function obtains the short form of this path.
lpszShortPath
Pointer to a buffer to receive the null-terminated short form of the path specified by lpszLongPath.
cchBuffer
Specifies the size, in characters, of the buffer pointed to by lpszShortPath.
Return Values
If the function succeeds, the return value is the length, in characters, of the string copied to lpszShortPath, not including the terminating null character.

If the function fails due to the lpszShortPath buffer being too small to contain the short path string, the return value is the size, in characters, of the short path string. You need to call the function with a short path buffer that is at least as large as the short path string.

If the function fails for any other reason, the return value is zero. To get extended error information, call GetLastError.

Remarks
When an application calls this function and specifies a path on a volume that does not support 8.3 aliases, the function fails with ERROR_INVALID_PARAMETER if the path is longer than 67 bytes.

The path specified by lpszLongPath does not have to be a fully qualified path or a long path. The short form may be longer than the specifed path.

If the specified path is already in its short form, there is no need for any conversion, and the function simply copies the specified path to the buffer for the short path.

You can set lpszShortPath to the same value as lpszLongPath; in other words, you can set the buffer for the short path to the address of the input path string.

You can obtain the long name of a file from the short name by calling the FindFirstFile function.

QuickInfo
Windows NT: Requires version 3.5 or later.
Windows: Requires Windows 95 or later.
Windows CE: Unsupported.
Header: Declared in winbase.h.
Import Library: Use kernel32.lib.
Unicode: Implemented as Unicode and ANSI versions on Windows NT.

See Also
File I/O Overview, File Functions, GetFullPathName, FindFirstFile

 

[hennep]

That's not the one i meant, GetShortPathName converts to an 8.3 alias.

I need a function to shorten a filename to fit for instance in a form label that's actually to small.
I have seen a few program's that shows the first part of a path, a few dots and de filename itself.

I was hoping there is a api to do this,

 

[jnicks]

Amazin, C, and DOS interrupts do 'splitpath' first thing, but VB and the API seem to have forgotten about the old splitpath, which is just what you want and you can shorten the path part as you like.

What the Developers Studio suggests to replace splitpath is awfully clunky.. You search for 'BreakDown' for comments, here is the code...

Yoicks! How quaint. Not even a reverse scan for the last backslash (reverse solidus)!

Definitely 60's code.

------------snip-------------------



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, "\&quot Then
FName = Full
PName = ""
Sloc% = InStr(FName, "\&quot
Do While Sloc% <> 0
PName = PName + Left$(FName, Sloc%)
FName = Mid$(FName, Sloc% + 1)
Sloc% = InStr(FName, &quot;\&quot
Loop

Else
PName = &quot;&quot;
FName = Full
End If

Dot% = InStr(Full, &quot;.&quot
If Dot% <> 0 Then
Ext = Mid$(Full, Dot%)
Else
Ext = &quot;&quot;
End If
BreakDown = True
End Function

 

[vb5prgrmr]

Ok this is kind of ugly but I belive it will work for you.

Create a new project and add a label and a picture box to the form and then paste the following code in your form.

[tt]Private Sub Form_Load()

'declare local variables
Dim S As String, FName As String, PName As String, Length As Single

'set up user interface
Picture1.Visible = False
Label1.BackColor = vbWhite

'set up variables
S = &quot;C:\This\Is\A\Long\String\To\A\File.Name&quot;
FName = &quot;..&quot; & Mid(S, InStrRev(S, &quot;\&quot)
PName = Left(S, InStrRev(S, &quot;\&quot)
Length = Picture1.TextWidth(S)

'check and reduce the path part of the string
If Length > Label1.Width Then
Do While Length > Label1.Width
PName = Left(PName, InStrRev(PName, &quot;\&quot;, (Len(PName) - 1)))
Length = Picture1.TextWidth(PName & FName)
Loop
Label1.Caption = PName & FName
Else
Label1.Caption = S
End If

End Sub

[/tt]

Notes:

the back color is changed so you can see that the caption does not exceed the boundries of the label.

I hope this helps, Good Luck

 

[strongm]

Yes, with a teeny bit of work the API will do it for you. Here's a VB version:

Option Explicit

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type


Private Const DT_PATH_ELLIPSIS_MODIFY = &H14020 ' DT_PATH_ELLIPSES or DT_MODIFYSTRING
Private Declare Function DrawText Lib &quot;user32&quot; Alias &quot;DrawTextA&quot; (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Private Declare Function GetClientRect Lib &quot;user32&quot; (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function CreateCompatibleDC Lib &quot;gdi32&quot; (ByVal hdc As Long) As Long
Private Declare Function DeleteDC Lib &quot;gdi32&quot; (ByVal hdc As Long) As Long

Private Sub Command1_Click()
Dim BoundingRect As RECT
Dim TempDC As Long

Dim strText As String

GetClientRect Text1.hwnd, BoundingRect
TempDC = CreateCompatibleDC(Form1.hdc)
strText = &quot;C:\This\Is\A\Long\String\To\A\File.Name&quot;
DrawText TempDC, strText, Len(strText), BoundingRect, DT_PATH_ELLIPSIS_MODIFY
Text1.Text = strText
DeleteDC TempDC
End Sub

 

[jnicks]

Hullo VB5prgrmr and Strongm

Strongm, that is great. I am not sure it is easier though. And computationally, but it is great!

It also gets around the fact that BreakDown from MS does not handle names like

C:\myprogs\a.b.c.d

and it does far worse on
G:\mydata.bas\test1.prg.

SO it fixed BreakDown to BetterNreakDwon and while at was at it threw in the trditional splitpath

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, &quot;\&quot;)
Loop

Else
PName = &quot;&quot;
FName = Full
End If

Dot% = InStr(Full, &quot;.&quot;)
If Dot% <> 0 Then
Ext = Mid$(Full, Dot%)
Else
Ext = &quot;&quot;
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 = &quot;&quot; Then BetterBreakDown = False: Exit Function

' these kinds of filters are often cleaner by setting defaults at the top
   BetterBreakDown = True: PName = &quot;&quot;: FName = &quot;&quot;: Ext = &quot;&quot;
   Floc$ = Full  ' a local copy we can play with.

   GoSub sortoutExt

   Sloc% = InStr(Floc$, &quot;\&quot;)
   If Sloc% = 0 Then FName = Floc$: Exit Function

' we have a backslash
   t% = 1
   Do While t%
     t% = InStr(Sloc% + 1, Floc$, &quot;\&quot;)
     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) = &quot;.&quot; 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$ = &quot;&quot;:              Ext$ = &quot;&quot;
   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$, &quot;\&quot;)
   If Sloc% = 0 Then FName$ = Floc$: Exit Sub

' we have a backslash
   t% = 1
   Do While t%
     t% = InStr(Sloc% + 1, Floc$, &quot;\&quot;)
     If t% Then Sloc% = t%
   Loop

   path$ = Left$(Floc$, Sloc%)
   FName$ = Mid$(Floc$, Sloc% + 1)
Exit Sub

sortoutDrive:
  If Mid$(Floc$, 2, 1) = &quot;:&quot; 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) = &quot;.&quot; 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

 

[strongm]

I don't mean to be difficult (read: &quot;oh yes I do&quot, but easier than what? It's sure as heck easier than your code...

And here's a faster, shorter version of your better breakdown. All you need to do is add a refernce to the Microsoft Scriting Runtime to your project:

[tt]
Option Explicit

Public Sub KnowYourToolsBetterBreakdown(strSource As String)
Dim fso As FileSystemObject
Dim aFile As String 'File
Dim strMessage As String

strSource = &quot;g:\'tis is a test \ of a gnarly pathname\a.pre.htm.exe&quot;
Set fso = New FileSystemObject


MsgBox &quot;Drive:&quot; + fso.GetDriveName(strSource) + vbCrLf + &quot;Path: &quot; + fso.GetParentFolderName(strSource) + vbCrLf + &quot;Filename: &quot; + fso.GetBaseName(strSource) + vbCrLf + &quot;Extension: &quot; + fso.GetExtensionName(strSource) + vbCrLf
End Sub

Private Sub Command1_Click()
KnowYourToolsBetterBreakdown &quot;g:\'tis is a test \ of a gnarly pathname\a.pre.htm.exe&quot;
End Sub

 

[strongm]

That should have read:

[tt]
Option Explicit

Public Sub KnowYourToolsBetterBreakdown(strSource As String)
Dim fso As FileSystemObject
Dim aFile As String 'File
Dim strMessage As String

Set fso = New FileSystemObject
MsgBox &quot;Drive:&quot; + fso.GetDriveName(strSource) + vbCrLf + &quot;Path: &quot; + fso.GetParentFolderName(strSource) + vbCrLf + &quot;Filename: &quot; + fso.GetBaseName(strSource) + vbCrLf + &quot;Extension: &quot; + fso.GetExtensionName(strSource) + vbCrLf

End Sub

Private Sub Command1_Click()
KnowYourToolsBetterBreakdown &quot;g:\'tis is a test \ of a gnarly pathname\a.pre.htm.exe&quot;
End Sub

 

[jnicks]

Hey Strongm

Yeah, simpler if you have scripts, not native.

Dim fso As FileSystemObject

Bombs out on &quot;User Defined Type not Defined&quot;

Acutally, I wish you'd solve that for me, there's a bunch of things that would be easier if that situation were not blocking things.

Don't worry about being difficult if it works.

 

[strongm]

You would need to add a reference to the Microsoft Scripting Runtime library.

Apologies if my previous comment seemed a little brusque - I wrote it just after coming out of an 8 hour meeting, so I wasn't on best form...

 

[jnicks]

Please, Strongm, 8 hour meetings are hell unless you are the judge or CEO (smile). Even then.

The error I get in VB5 may be something to do with scripting hosts? After the security problems with various, I dumped them.

Samples like yours snafu on my VB5: Service Pack 3; Prof. not enterprise version; no install wsrnings or complaints.

I'd like some help, on that so I'll start another thread, not here, or if you would prefer offline, j@roninsg.com

p.s. I dropped you another * for that DOS pipe thing, that was nice work, I did not know you could do that (large grin).

 

[BetterLateThanNever]

You could try using PathCompactPathEx, which will shorten a filename to fit inside a certain pixel width, or character width (there are two related functions), replacing removed portions of the path with ellipses.

For more:

http://msdn.microsoft.com/library/d.../reference/shlwapi/path/pathcompactpathex.asp

Cheers.