PATHTRUNCATE

Function PathTruncate(Source:String):TstringList;

Var
temp,strtemp,strbck:string;
pathdata,drivedata:string;
slcount,i,cpos:integer;
Output:Tstringlist;
delim:String;

begin
// Initialisation des variables
slcount:=0;
cpos:=0;
i:=0;

Output := TStringList.Create;



// Premier découpage (récupération 'x:\' ou '\\')
if copy(source,2,1) = ':' then  begin
                                pathdata:=copy(source,4,length(source));
                                drivedata:=copy(source,0,3);
                                end else

if copy(source,2,1) = '\' then  begin
                                pathdata:=copy(source,3,length(source));
                                drivedata:=copy(source,0,2);
                                end else
                                    begin
                                    Pathdata:=source;
                                    Drivedata:='';
                                    end;


temp:=pathdata;
strtemp:=pathdata;


//compter le nombre de '\' ou '/'

if Pos('\',pathdata) > 1 then delim:='\' else delim:='/';

        repeat
        temp:=copy(temp,pos(delim,temp)+1,length(temp));
        inc(slcount);
        until pos(delim,temp)=0;

//découpage
inc(i);
strtemp:=copy(strtemp,cpos,pos(delim,strtemp));
cpos:=length(strtemp)+1;
strbck:=strtemp;


Output.Add(drivedata+strtemp);

if i<slcount then
        begin
              repeat
                inc(i);
                strtemp:=pathdata;
                strtemp:=copy(strtemp,cpos,length(strtemp));
                strtemp:=copy(strtemp,0,pos(delim,strtemp));
                cpos:=cpos+length(strtemp);
                strbck:=strbck+strtemp;
                strtemp:=strbck;

                Output.Add(drivedata+strtemp);
              until i=slcount;
        end;

     Result:=output;

end;

Télécharger le zip

21 septembre 2005 23:16:41 :

-source ajouté (pour eviter de le télécharger)

22 septembre 2005 15:35:37 :

-nouvelle interface (juste dans le but de montrer le fonctionnement) -Procedure pathtruncate -> fonction pathtruncate

22 septembre 2005 15:37:13 :

-nouvelle interface (juste dans le but de montrer le fonctionnement) -Procedure pathtruncate -> fonction pathtruncate

22 septembre 2005 15:46:33 :

pb tranfert- tentative 3

22 septembre 2005 16:21:17 :

Bon ca y est maintenant...