| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Как сократить полный путь файла? [D2005]

vagra ©   (2006-04-17 19:17:00) 

Здравствуйте!

Есть ли какая-нибудь функция, которая делает из полного пути файла
"c:\program files\ochen-dlinnyi put\myfilename.ext"
такой:
"c:\progr...\myfilename.ext"

Спасибо.

---

Гаврила   (2006-04-17 22:08:00) [1]

А еще есть MinimizeName

---

Джо   (2006-04-17 20:16:00) [2]

> //Относительное имя файла, относительно текущей директории

Есть ExtractRelativeFileName в SysUtils.pas

---

TUser   (2006-04-17 19:58:00) [3]

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

Будет с тильдами.

---

Rial   (2006-04-17 19:53:00) [4]

//Компактная запись имени фйла, где указываются макс. длина новой строки и
//макс. количество папок перед конечным файлом

function CompacName(Const Name:String;Const MaxLen,NumOfSlh:Integer):String;
begin
Result:=CompacNameExp(Name,MaxLen,NumOfSlh,NumOfSlh);
end;


//Та же фунцкия, с выравниванием с обеих сторон
function CompacNameExp(Name:String;Const MaxLen,NumOfSlhLeft,NumOfSlhRight:Integer):String;
Var I,J,L,BP,US:Integer;
begin
L:=Length(Name);
Result:=Name;
If (L<=MaxLen)then Exit;
J:=1;
I:=0;
While (I<NumOfSlhLeft)and(J<=L) do begin
 If (Name[J]='\')then Inc(I);
 Inc(J);
end;
BP:=J;
J:=L;
I:=0;
While (J>BP)and(I<NumOfSlhRight)do begin
 If (Name[J]='\')then Inc(I);
 Dec(J);
end;
I:=J;
US:=BP+L-I;
While (J>BP)and(US<MaxLen)do begin
 If (Name[J]='\')then I:=J-1;
 Dec(J);
 Inc(US);
end;
Name:=Copy(Name,1,BP-1)+'...'+Copy(Name,I+1,L-I);
If (Length(Name)<L)then Result:=Name;
end;

//Относительное имя файла, относительно текущей директории

function MinimizeFileName(Const FileName,DirName:String):String;
Var I,P:Integer;
   L1,L2:Integer;
begin
Result:=FileName;
If (FileName=DirName)then begin
 Result:='';
 Exit;
end;
If (ExtractFileDir(FileName)=DirName)then begin
 Result:=ExtractFileName(FileName);
 Exit;
end;
L1:=Length(FileName);
L2:=Length(DirName);
P:=1;
While (P<=L1)and(P<=L2)and(FileName[P]=DirName[P])do
 Inc(P);
If (P>=L1)or(P>=L2)then begin
 If (P>L1)then Result:=FileName
          else Result:=Copy(FileName,P+1,L1-P);
 Exit;
end;
While (P>=0)and(FileName[P]<>'\')do Dec(P);
If (P<3)then Exit;
Result:='..\';
I:=P+1;
While (I<=L2)do begin
 If (DirName[I]='\')then Result:=Result+'..\';
 Inc(I);
end;
Result:=Result+Copy(FileName,P+1,L1-P);
end;

P.S. Функции мои. Но пользуюсь давно, глючить не должны.

---

Наверх