• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1992
  • Last Modified:

How do I shorten a path name

I want to shorten a path name to a limited amount of characters and replace the center of the string with ellipsis like this:

Input string:
c:\program files\directory1\directory2\directory3\file.name

Output stringL
c:\program file\..\directory3\file.name

I would accept the answer either by the number of characters or the first and last directory plus the filename.
0
mdlittle
Asked:
mdlittle
  • 5
  • 5
  • 4
  • +3
1 Solution
 
Zip58Commented:
Hi mdlittle

Mabey you can try this

This function, when passed a long path name, will convert it to a short Win3.1 style path name.  For example: ExtractShortPathName('C:\This is a directory\This is a file.txt') will return 'C:\Thisis~1\Thisis~1.txt'.  To extract the long path name, see ExtractLongPathName().

function ExtractShortPathName(const FileName: string): string;
{ func to shorten the long path name to look like Win 3.1 naming conventions. }
{ If file doesn't exist, func will return an emtpy string.                    }
var
  Buffer: array[0..MAX_PATH] of Char;
begin
  SetString(Result, Buffer,
    GetShortPathName(PChar(FileName), Buffer, SizeOf(Buffer)));
end;

Regards

Zip58


0
 
DaFoxCommented:
Hi mdlittle!

Looks like you are searching for a function like MinimizeName()?

{ uses FileCtrl }

procedure TForm1.Button1Click(Sender: TObject);
var
  s: String;
begin
  s := 'c:\program files\directory1\directory2\directory3\file.name';
  Label1.Caption := MinimizeName(s, Label1.Canvas, Label1.Width);
end;

Markus
0
 
Zip58Commented:
Hi mdlittle

Take also a look to this

function MinimizePathName(Wnd: HWND; const Filename: string): string;
{ func to shorten the long path name with an ellipses '...' to fit }
{ in whatever control is passed to the Wnd parameter. }
{ Usage: Panel1.Caption := MinimizePathName(Panel1.Handle, DirectoryOutline1.Directory) }
{ This will shorten the path if necessary to fit in Panel1. }
procedure CutFirstDirectory(var S: string);
var
Root: Boolean;
P: Integer;
begin
if S = '\' then
S := ''
else
begin
if S[1] = '\' then
begin
Root := True;
Delete(S, 1, 1);
end
else
Root := False;
if S[1] = '.' then
Delete(S, 1, 4);
P := Pos('\',S);
if P <> 0 then
begin
Delete(S, 1, P);
S := '...\' + S;
end
else
S := '';
if Root then
S := '\' + S;
end;
end;

function GetTextWidth(DC: HDC; const Text: String): Integer;
var
Extent: TSize;
begin
if GetTextExtentPoint(DC, PChar(Text), Length(Text), Extent) then
Result := Extent.cX
else
Result := 0;
end;

var
Drive,
Dir,
Name: string;
R: TRect;
DC: HDC;
MaxLen: integer;
OldFont, Font: HFONT;
begin
Result := FileName;

if Wnd = 0 then
Exit;

DC := GetDC(Wnd);
if DC = 0 then
Exit;

Font := HFONT(SendMessage(Wnd, WM_GETFONT, 0, 0));
OldFont := SelectObject(DC, Font);
try
GetWindowRect(Wnd, R);
MaxLen := R.Right - R.Left;

Dir := ExtractFilePath(Result);
Name := ExtractFileName(Result);

if (Length(Dir) >= 2) and (Dir[2] = ':') then
begin
Drive := Copy(Dir, 1, 2);
Delete(Dir, 1, 2);
end
else
Drive := '';

while ((Dir <> '') or (Drive <> '')) and (GetTextWidth(DC, Result) > MaxLen) do
begin
if Dir = '\...\' then
begin
Drive := '';
Dir := '...\';
end
else
if Dir = '' then
Drive := ''
else
CutFirstDirectory(Dir);
Result := Drive + Dir + Name;
end;
finally
SelectObject(DC, OldFont);
ReleaseDC(Wnd, DC);
end;
end;

Ps.( not tested)

Regards

Zip58
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
jbshumateCommented:
var
  ii : integer;
  count : integer;
  start,stop : integer;
begin
  count := 0;
  start := 0;
  stop := 0;
  for ii := 1 to length(fPath) do begin
    // look for all the separators
    if fPath[ii] = '\'  then begin
      count := count + 1;  // count them
      if count = 2 then start := ii + 1  // 2nd is start
      else stop := ii;
    end;
  end;
  if (count > 2) and (stop > (start + 2)) then begin
    // we had at least 3 separators and can shorten
    fPath[start] := '.';
    fPath[start+1] := '.';
    fPath[start+2] := '.';
    start := start + 3;  // elipses
    for ii := stop to length(fPath) do begin
      // copy the last separator and the filename
      fPath[start] := fPath[ii];
      start := start + 1;
    end;
    setLength(fPath,start-1);  // shorten the string
  end;
end;
   
0
 
mdlittleAuthor Commented:
jbshumate:

Not sure how this works. I tried it and the string is truncated.

0
 
kretzschmarCommented:
a sample

unit Shorten_Path_u;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

//this simple function returns the first part as result,
//and shorten the given string
//for next item simple call again
//if there are no items, then the given string becomes empty
function SplitStr(Var AString : String; ADelim : String) : String;
var APos : Integer;
begin
  Result := '';
  APos := Pos(ADelim,AString);
  if APos > 0 then
  begin
    Result := Copy(AString,1,APos-1);
    AString := copy(Astring,APos+length(Adelim),MaxLongInt);
  end
  else
  begin
    Result := AString;
    AString := '';
  end;
end;

//This function shorten the path
function shorten_Path(APath : String) : String;
var
  sl : TstringList;
  s : string;
begin
  s := APath;
  result := APath;
  sl := TstringList.Create;
  try
    while s <> '' do
      sl.add(SplitStr(s,'\'));
    if sl.count > 4 then
      result := sl[0]+'\'+sl[1]+'\...\'+sl[sl.count-2]+'\'+sl[sl.count-1];
  finally
    sl.free;
  end;
end;



procedure TForm1.Button1Click(Sender: TObject);
begin
  edit2.text := Shorten_Path(edit1.text);
end;

end.

meikl ;-)
0
 
DaFoxCommented:
Meikl, what about using TStrings instead of TStringList (-> speed increase!)?

Markus
0
 
jbshumateCommented:
How did you use the code.  If you just typed it in as I gave it the compiler probably eliminated the final result since it was not used.  Here it is wrapped as a procedure and should work if you just cut and paste.


procedure Shorten(var fPath : string);
var
 ii : integer;
 count : integer;
 startPos,stop : integer;
begin
 count := 0;
 startPos := 0;
 stop := 0;
 for ii := 1 to length(fPath) do begin
   // look for all the separators
   if fPath[ii] = '\'  then begin
     count := count + 1;  // count them
     if count = 2 then startPos := ii + 1  // 2nd is start
     else stop := ii;
   end;
 end;
 if (count > 2) and (stop > (startPos + 2)) then begin
   // we had at least 3 separators and can shorten
   fPath[startPos] := '.';
   fPath[startPos+1] := '.';
   fPath[startPos+2] := '.';
   startPos := startPos + 3;  // elipses
   for ii := stop to length(fPath) do begin
     // copy the last separator and the filename
     fPath[startPos] := fPath[ii];
     startPos := startPos + 1;
   end;
   setLength(fPath,startPos - 1);  // shorten the string
 end;
end;
0
 
kretzschmarCommented:
markus,

>what about using TStrings instead of TStringList
>(-> speed increase!)?

tsrings is a abstract class,
some methods are only abstract declared,
and must be implemented in a derived class
-> thats why i use tstringslist

it may be, that the methods i used,
 are already implemented in tstrings,
but i guess the speed increasement,
if there is one, may not significant.

meikl ;-)
0
 
jbshumateCommented:
Ok, lets try this again.  I just re-read your original request and realized I was only giving you the filename and not the last directory as well.  The following should work.

procedure Shorten(var fPath : string);
var
 ii : integer;
 count : integer;
 startPos,stop : integer;
 prevStop : integer;
begin
 count := 0;
 startPos := 0;
 stop := 0;
 prevStop := 0;
 for ii := 1 to length(fPath) do begin
   // look for all the separators
   if fPath[ii] = '\'  then begin
     count := count + 1;  // count them
     if count = 2 then startPos := ii + 1  // 2nd is start
     else begin
       prevStop := stop;
       stop := ii;
     end;
   end;
 end;
 if (count > 3) and (prevStop > (startPos + 2)) then begin
   // we had at least 4 separators and can shorten
   fPath[startPos] := '.';
   fPath[startPos+1] := '.';
   fPath[startPos+2] := '.';
   startPos := startPos + 3;  // elipses
   for ii := prevStop to length(fPath) do begin
     // copy the last separator and the filename
     fPath[startPos] := fPath[ii];
     startPos := startPos + 1;
   end;
   setLength(fPath,startPos - 1);  // shorten the string
 end;
end;
0
 
DaFoxCommented:
Meikl, you're right, of course. It was more a theoretical objection; I always try to get rid of TStringLists in such trivial cases (no matter if speed increase is insignificant or not.

Markus
0
 
merry_princeCommented:
Jbshumate, Good solution.
0
 
merry_princeCommented:
Hi Jbshumate,
Input string:
'c:\Program\c\d\a.exe'
Shorten proc can't dispose above path and will return original string. Should you update the proc to meet Mdlittle's request?
0
 
merry_princeCommented:
Just a suggestion. It doesn't matter.
0
 
jbshumateCommented:
merry prince

Your example would not in fact shorten based on his request.  The result would be c:\Program\...\d\a.exe.  I wrote the code to only operate if the result was shorter.
0
 
merry_princeCommented:
Just a suggestion. It doesn't matter.
0
 
DaFoxCommented:
btw: If someone uses/tests my code above: Set the autosize property of the label to false... (otherwise you'll just get the filename without the path ... not very useful then)

Markus
0
 
mdlittleAuthor Commented:
OK. The label thing will not work for me. I am not sending the short string to a label or any other control. This is not what I want. I am testing Jbshumate's and Meikl's code now.

Thanks
0
 
mdlittleAuthor Commented:
kretzschmar:

Very good  - works very well. Also works well for directory names as changed below;

result := sl[0]+'\'+sl[1]+'\...\' +sl[sl.count-1] + '\';
0
 
jbshumateCommented:
Glad to see you found something you like.  For what it is worth the code you chose is probably 1 to 2 orders of magnitude slower than what I showed you since it requires procedure calls, creation of a string list, try..except blocks etc.  As long as you are only doing this occasionally that would be no problem.  If you are using this to navigate a large number of paths and populate a treeView or some such you may want to keep this is mind.
0
 
mdlittleAuthor Commented:
jbshumate:

I do appreciate the suggestion and help with the question. It would be nice if you could also award points for effort and assistance.

I will watch for you name the next time I post a question.

Thanks again

Mike
0
 
merry_princeCommented:
I agreed with jbshumate. His proc is smart. Since no need to create and free object resource.
0

Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 5
  • 5
  • 4
  • +3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now