Change local to relative url

can you use :

https://www.experts-exchange.com/questions/20652014/Delphi-function-to-find-'relative-path'.html

below the code for the inverse function

function GetabsolutePath(Source, Relative: string): string;
var
    i, Num, num1: integer;
    St: TStringList;
    s: string;
begin
    Num := GetappearNum('..', Relative);
    St := TStringList.Create;
    decomposestr('\', Source, st);
    Num1 := st.Count;

    Result := '';

    for i := 0 to num1 - num - 1 do
    begin
        Result := Result + st[i];
    end;
    s := CopyRightNum('..\', Relative, 1);
    Result := Result + s;
    st.Free;
end;

Select allOpen in new window

You basically have to replace in your string : 'c:\somefolder\' with '/images/' and eventually all remaining '\' into '/' so :

NewPath:=ReplacePath2URL('c:\somefolder\someimage.jpg', 'c:\somefolder\',  '/images/');

Function ReplacePath2URL(FileName,Path1, Path2:String):String;
Var
 P:Integer;
begin
 P:=Length(Path1);
// first check that FileName is starting with Path1
 if UpperCase(LeftStr(FileName,P))<>UpperCase(Path1) Then Raise Exception.Create('Bad start path');
 Result:=Path2+Copy(FileName,P+1,Length(FileName)-P);
// Then replace all '\' with '/'
 Result:=StringReplace(Result,'\','/',[rfReplaceAll]);
end;

Select allOpen in new window

Thanks epasquier,

I've give it a try right after work :o)

Hmm...sorry I don't think I expressed myself properly.

In a memo...

I need to replace anything that looks like this:

c:\somefolder\someimage.jpg

to:

/images/someimage.jpg

So, if we get the source path:

c:\somefolder\someimage.jpg ...anything but the filename "someimage.jpg"  is stripped off and "/images/" is added in it's place.

Hope this is clearer...sorry about that and thanks!

Ok.
Then let's first replace all 'c:\somefolder\' with '/images/', then rescan the string for all occurences of '/images/' and replace all following '\' with '/' up to the first invalid character for a filename.

Function ReplacePath2URL(Str,Path1, Path2:String):String;
Var
 P,L,LP2:Integer;
begin
 Result:= StringReplace(Str, Path1, Path2,                          
             [rfReplaceAll, rfIgnoreCase]);
 P:=1;
 L:=Length(Result);
 LP2:=Length(Path2);
 Repeat
  P:=PosEx(Result,Path2,P);
  if P>0 Then 
   begin
    P:=P+LP2;
    while (P<=L) and Not (Result[P] In [#0..#31, '<','>','"','?','*']) do
     begin
      if Result[P]='\' Then Result[P]:='/';
      inc(P);
     end;
   end;
 Until (P>L) Or (P=0);
end;

Select allOpen in new window

Cool...will check it as soon as I get home...thanks :o)

I made the same mistake again with PosEx, the order of the parameters is wrong

Function ReplacePath2URL(Str,Path1, Path2:String):String;
Var
 P,L,LP2:Integer;
begin
 Result:= StringReplace(Str, Path1, Path2,                          
             [rfReplaceAll, rfIgnoreCase]);
 P:=1;
 L:=Length(Result);
 LP2:=Length(Path2);
 Repeat
  P:=PosEx(Path2,Result,P);
  if P>0 Then 
   begin
    P:=P+LP2;
    while (P<=L) and Not (Result[P] In [#0..#31, '<','>','"','?','*']) do
     begin
      if Result[P]='\' Then Result[P]:='/';
      inc(P);
     end;
   end;
 Until (P>L) Or (P=0);
end;

Select allOpen in new window

Hi epasquier,

Do you have a usage example via memo please?

thx again!

Memo.Text:=ReplacePath2URL(Memo.Text, 'c:\somefolder\',  '/images/');

Can c:\somefolder\ be any path that's local or do I have to manually specify the local paths?

thx

you must have a limited list of pairs like 'c:\somefolder\' => '/images/'
find the best way that suits your needs to define such a pair list and call the function ReplacePath2URL for each
There is no other generic way

Sorry about my delay (christmas party's)  

Merry xmas by the way...

Anyway...could it be something like:

Memo.Text:=ReplacePath2URL(Memo.Text, 'c:\*',  '/images/');

So basically if the url has a c:\ ...we know it's local ... then it will replace the c:\ and whatever folders follow it to /images/ ...know what I mean?


thx

I don't wanna take nothing to epasquier, but as I've understood how ST3VO is working and what he need I've created a function specified for his purpose.

It must be a little described.
To replace any occurrence of c:\somefolder\someimage.jpg, or c:\somefolder\somotherfolder\someotherimage.jpg or c:\somefolderagain\someother\whateverimage.jpg we must know first of all a point of start and one of end to search between them.
So the function is
function CustomReplace(Text, PathPortion, Replacing, Ext: String): String;
where
Text => The string that we must parse (e.g. Memo1.text)
PathPortion => the portion of the path we are starting to look for (e.g. 'c:\')
Replacing => what we want replace with (e.g. '/images/')
Ext => The extension of the images, needed to find the exact part of the path that must be replaced (e.g. '.jpg'), skipping the filename;

So now we can
1) find any C:\
2) from there find the .jpg starting from there
3) get the path that must be replaced reading back from that .jpg until we find the '\' (that is back where filename starts)
4) replace the found path with our Replacing value
and so on.
Better to see than explain.
Try the code attached.

function CustomReplace(Text, PathPortion, Replacing, Ext: String): String;
  var
    s, temp, temppath: String;
    i, t: integer;
  begin
    s := Text; // get the text from Memo
    while pos(PathPortion, Text) > 0 do
    begin
      temp := '';
      i := pos(PathPortion, Text); // found drive
      begin
        t := posex(Ext, Text, i+3)-1;
        while Text[t] <> '\' do
        begin
          temp := Text[t]+temp;
          dec(t);
        end;
        temppath := copy(Text, i, t-i+1);
        Text := stringreplace(Text, temppath, Replacing, []);
      end;
    end;
    result := Text;
  end;

Use it as follows
Memo1.Text := CustomReplace(Memo1.Text, 'c:\', '/images/', '.jpg');

Select allOpen in new window

Hmmm testing both:

Memo1.Text := CustomReplace(Memo1.Text, 'c:\', '/images/', '.jpg');
Memo1.Text := CustomReplace(Memo1.Text, 'c:\', '/images/', '.jpg'); <-- uppercase C

But it's not doing anything...Does it check the whole memo1 text from top to bottom for c:\  ???

My mistake...ignore my last comment...works perfect :o) Thx!!!

Works Perfect thx!!!

ST3VO, when you change or precise your specifications after a while, you could at least split points to recognize initial work.

Ferruccio : That's a good thinking to take the file extension as a reference and look back for the previous slash. Still, you could have optimized :
- by first calculating i=Pos and test it instead of calling twice
- by using PosEx even for that in order to start looking other path to replace not from the beginning each time
- use 2 copy with your positions instead of one to find the middle one to extract and then call StringReplace, which will refind the position you already have
- and you have a bug in this line : t := posex(Ext, Text, i+3)-1;
instead of 3 you should have Length(PathPortion) - which equals 3 in this example only

function CustomReplace(Text, PathPortion, Replacing, Ext: String): String;
Var
 i, t, L : integer;
begin
 L:=Length(Replacing);
 i := pos(PathPortion, Text); // found drive
 while i > 0 do
  begin
   t := posex(Ext, Text, i+Length(PathPortion))-1;
   while Text[t] <> '\' do dec(t);
   Text := Copy(Text,1,i-1)+Replacing+Copy(Text,t+1,Length(Text)-t);
   i := posEx(PathPortion, Text, i+L ); 
  end;
 Result:=Text;
end;

Select allOpen in new window

ST3VO, when you change specs in the middle of a thread you could at least split points to recognize initial work or better yet close and reopen a new question.

Ferruccio, nice thinking to use extension as reference. Still, you could optimize a lot
- call Pos once to calculate i at first and use it for the while loop
- call PosEx to update i at each end of loop, not searching from the beginning
- use directly 2 copy with i and t to replace instead of using copy and stringreplace, which will have to refind first the position
- you have a bug in the line t := posex(Ext, Text, i+3)-1;
you should use Length(PathPortion) instead of 3 even if in this example it's the correct value


function CustomReplace(Text, PathPortion, Replacing, Ext: String): String;
var
  i, t, L: integer;
begin
 L:=Length(Replacing);
 i := pos(PathPortion, Text); // found drive
 while i > 0 do
  begin
   t := posex(Ext, Text, i+Length(PathPortion))-1;
   while Text[t] <> '\' do dec(t);
   Text := Copy(Text,1,i-1)+Replacing+Copy(Text,t+1,Length(Text)-t);
   i := posEx(PathPortion, Text, i+L );
  end;
 Result:=Text;
end;  

please forget the message sent twice as I was on the list of question interface, and it seems that a bug prevent from seeing comments of closed questions there. I supposed that the first message did not go through because I was attaching code.

Hi epasquier, sorry about that, didn't realize I changed the specs...