Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2006.04.09;
Скачать: CL | DM;

Вниз

Путь в файлу   Найти похожие ветки 

 
Dmitrij_K   (2006-03-22 10:59) [0]

Как получить полный путь к файлу из такого вида
..\pas\kan_st.pas


 
DelphiN! ©   (2006-03-22 11:32) [1]

Относительно твоей программы?
ExtractFilePath(ExtractFilePath(ParamStr(0))+"pas\kan_st.pas)?


 
Dmitrij_K   (2006-03-22 11:35) [2]

Например
текущая директория c:\projects\lalala\
надо ..\pas\kan_st.pas преобразовать в c:\projects\pas\kan_st.pas


 
Dmitrij_K   (2006-03-22 11:40) [3]

Что-то в этом духе

function daj_path(const aCurDir,aFileName:AnsiString):AnsiString;
var s : string;
begin
 GetDir(0,s);
 ChDir(ExtractFilePath(aFileName));
 GetDir(0,result);
 result := result + "\" + ExtractFileName(aFileName);
 ChDir(s);
end;


 
DelphiN! ©   (2006-03-22 11:43) [4]


function GetRealPath(Path,CurrentDir: String): String;
var
 i: Integer;
begin
 i := pos("..",Path);
 while i > 0 do
 begin
   CurrentDir := GetCurrentDir;
   CurrentDir := ExtractFilePath(CurrentDir);
   Delete(Path,i,3);
   Insert(CurrentDir,Path,i);
   i := pos("..",Path);
 end;
 Result := Path;
end;

var
 s: String;
begin
 ShowMessage(GetRealPath("..\pas\kan_st.pas",GetCurrentDir));
end;


 
Dmitrij_K   (2006-03-22 11:49) [5]


> DelphiN! ©   (22.03.06 11:43) [4]

Неработает

CurentDir = C:\Documents and Settings\lalala\Рабочий стол\Новая папка (3)\

function daj_path(const aCurDir,aFileName:AnsiString):AnsiString;
var s,z : string;
begin
 GetDir(0,s);
 ChDir(aCurDir);
 ChDir(ExtractFilePath(aFileName));
 GetDir(0,z);
 z := IncludeTrailingPathDelimiter(z) + ExtractFileName(aFileName);
 ChDir(s);
 result := z;
end;

function GetRealPath(Path,CurrentDir: String): String;
var
i: Integer;
begin
i := pos("..",Path);
while i > 0 do
begin
  CurrentDir := GetCurrentDir;
  CurrentDir := ExtractFilePath(CurrentDir);
  Delete(Path,i,3);
  Insert(CurrentDir,Path,i);
  i := pos("..",Path);
end;
Result := Path;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 showmessage(daj_path(ExtractFilePath(paramstr(0)),"..\..\Мои документы\111.htm"));
 showmessage(GetRealPath("..\..\Мои документы\111.htm",ExtractFilePath(paramstr(0))));
end;


 
DelphiN! ©   (2006-03-22 11:53) [6]

или лучше так

function GetRealPath(Path,CurrentDir: String): String;
var
 i: Integer;
 n: Integer;
begin
 n := 0;
 i := pos("..",Path);
 CurrentDir := GetCurrentDir;
 while i > 0 do
 begin
   CurrentDir := ExtractFilePath(CurrentDir);
   Delete(Path,i,3);
   Inc(n);
   i := pos("..",Path);
 end;
 CurrentDir := GetCurrentDir;
 for i := 0 to n-1 do
 begin
   if i > 0 then
     Delete(CurrentDir,Length(CurrentDir),1);
   CurrentDir := ExtractFilePath(CurrentDir);
 end;
 Result := CurrentDir+Path;
end;

var
 s: String;
begin
 ShowMessage(GetRealPath("..\..\pas\kan_st.pas",GetCurrentDir));
end;


Работает, когда переходов на предыдущий каталог несколько


 
Anatoly Podgoretsky ©   (2006-03-22 11:59) [7]

ExpandFilename


 
Dmitrij_K   (2006-03-22 12:08) [8]


> Anatoly Podgoretsky ©   (22.03.06 11:59) [7]
>
> ExpandFilename
>


Спасибо!



Страницы: 1 вся ветка

Текущий архив: 2006.04.09;
Скачать: CL | DM;

Наверх




Память: 0.46 MB
Время: 0.011 c
4-1137610292
Volf_555
2006-01-18 21:51
2006.04.09
Как в TPopup добавить путь к программе с её иконкой?


15-1142688836
TStas
2006-03-18 16:33
2006.04.09
РЕальная необходимость рекурсии


4-1137885803
Wistful
2006-01-22 02:23
2006.04.09
Hook на окно


3-1139562513
Bless
2006-02-10 12:08
2006.04.09
shared-бликировки и read commited


2-1143026107
Der Nechk@ssoff
2006-03-22 14:15
2006.04.09
Регистрация





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский