请问有这样的字符串转换函数吗?(100分)

L

lah998

Unregistered / Unconfirmed
GUEST, unregistred user!
请问有这样的字符串转换函数吗?

把"c:/myfile/aaa.txt"转成"myfile/aaa.txt";
还有这样"c:/myfile/aaa/bbb.txt"转成"aaa/bbb.txt"
如果没有这样的转换函数,请问如何写代码。
 
function ConvertStr(Str: string): string;
var
HasOneSplash: Boolean;
i, p: Integer;
begin
Result := '';
HasOneSplash := False;
for i := Length(Str) downto 1 do
begin
if Str = '/' then
begin
if HasOneSplash then
begin
Result := Copy(Str, i + 1, MaxInt);
Exit;
end else
begin
HasOneSplash := True;
end;
end;
end;
end;
 
function ConvertStr(Str: string): string;
var
s: String;
begin
Result := ExtractFileName(Str);
s := ExtractFilePath(Str);
s := Copy(s,1,Length(s)-1);
Result := s + ExtractFileName(s) + '/' + Result;
end;
 
方法二,[red]一行搞定[/red]:

function ConvertStr(Str: string): string;
begin
Result := ExtractFileName(ExtractFileDir(Str)) + '/' + ExtractFileName(Str);
end;


另,zhukewen,你的代码不对[:D]
把最后一行 Result := s + ExtractFileName(s) + '/' + Result;
改成 Result := ExtractFileName(s) + '/' + Result;
就可以了:)

 
beta:你好,你的代码我没有加成功,是我不会加,请你看到我的代码告诉我怎么加好吗?
zhukewen,:你好,我马上去试你的代码
procedure ReadFileName(var MyFileList : TStringList
const AnyFile:String);
var
Found:integer;
sr:TSearchRec;
begin
if FileGetAttr(AnyFile)<>faDirectory then//不是目录
begin
MyFileList.Add(AnyFile);
Exit;
end;
Found:=FindFirst(AnyFile+'/*.*',faAnyFile,sr);
while Found=0 do
begin
if (sr.Name<>'.')and(sr.Name<>'..') then
begin
ReadFileName(MyFileList,AnyFile+'/'+sr.Name);
end;
Found:=FindNext(sr);
end;
if(sr.Name<>'.')and(sr.Name<>'..') then
FindClose(sr);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
MyFileList : TStringList;
begin
MyFileList := TStringList.Create;
ReadFileName(MyFileList,'c:/xxx/yyy');//随便填文件夹
Memo1.Text :=MyFileList.Text;//如何在这里显示“YYY”文件夹里的所有文件和后面的路径
MyFileList.Free ;
end;
 
不会吧,我写的两个函数都完全满足你的:
//把"c:/myfile/aaa.txt"转成"myfile/aaa.txt";
//还有这样"c:/myfile/aaa/bbb.txt"转成"aaa/bbb.txt"
的要求呀,我都测试通过了。


怎么你的问题又变成这个了?你这个不是递归搜索一个目录下的所有文件名吗。
这样改试一试:

procedure TForm1.Button1Click(Sender: TObject);
var
// 加上这个变量定义:
i: Integer;
MyFileList : TStringList;
begin
MyFileList := TStringList.Create;
ReadFileName(MyFileList,'c:/xxx/yyy');//随便填文件夹

// 加上这些:
for i := 0 to MyFileList.Count - 1 do
MyFileList := ConvertStr(MyFileList)
// 这个函数就用我刚才给你那个

Memo1.Text :=MyFileList.Text;//如何在这里显示“YYY”文件夹里的所有文件和后面的路径
MyFileList.Free ;
end;
 
beta, :谢谢你!好人做到底按照你的办我还是没有成功,请你试一下好吗?
文件夹中子文件夹多几个就不对了
 
// 子文件夹多几个就不对了
我试了,没有问题呀,子文件夹多了过后就只显示文件名和前一个目录吗:
F:/Delphi/MySofts/Romaunt/Test/FTP.INI
就变成了:
Test/MIR.INI
就是这样啊,这不是你要求的吗?

你说的不对是指什么啊?
 
真是差劲。。。
 
beta:你做对了我还不知道,dzler,说的对,我真是差劲(女孩子嘛大家原谅点) 。
问题的原因是我没有表达清楚,beta虽做对了可是没解决我真正的问题.
我的问题应该要这么问:打开一个文件夹把文件夹后面的文件名全部显示
包括子文件夹下的文件名和每个文件名的路径,这个路径只取打开这个文件夹后面的路径,
前面的路径不显示。
如ReadFileName(MyFileList,'c:/xxx/yyy');//只显示"yyy/.../.../..."
beta:那样的就把"yyy"这个文件夹名给删了。
beta:请你帮小妹一把我还是个初学者。

 

你将你以前的问题合起来不就能解决了吗?
女孩子不适合编程,上次建议你转行的,可以考虑一下。
 
ha ,用这个试试
function ConvertStr(Str: string): string;
var
s: String;
i :integer;
is_yes :boolean;
str_last:string;
begin
Result := ExtractFileName(Str);
for i:=lenght(str) downto 1
begin
s:=copy(str,i,1);
if not is_yes then
begin
if s='/' then
beign
is_yes :=true

str_last:=str_last+s;
end

else
if s='/' then
begin
result:=str_last;
exit;
end

end

end

end;
 
用delphi 中的三个空件,TDirectoryListBox,TFileListBox,TDriveComboBox。
 
我赞同 beta 的两次提取文件名的方法,
不过自己要进行适当的判断。
 
cyf_00002,:你的只能显示文件名不能显示文件夹名,而且你的代码中有三处错误
影 子,:我是没办法!
hazic,:我要用代码实现.
 
procedure SearchFiles(FilesList: TStringList

TheRootPath: String

TheExtName: String)

var
SearchRec: TSearchRec

procedure GetFile

begin
if ((SearchRec.Attr and faDirectory) > 0) then
begin
if (SearchRec.Name <> '.') and
(SearchRec.Name <> '..') then //若不是本级或上级目录则需要搜索
SearchFiles(FilesList, TheRootPath + SearchRec.Name + '/', TheExtName)

end
else if (TheExtName = '') or (UpperCase(ExtractFileExt(SearchRec.Name)) = TheExtName) then
FilesList.Append(UpperCase(TheRootPath + SearchRec.Name))

end

begin
if FindFirst(TheRootPath + '*.*',
faReadOnly +
faHidden +
faSysFile +
faVolumeID +
faDirectory +
faArchive +
faAnyFile,
SearchRec) <> 0 then
exit

TheExtName := UpperCase(TheExtName)

GetFile

while FindNext(SearchRec) = 0 do
GetFile

FindClose(SearchRec)

end


---------------
调用方法:
var
strsFiles: TStringList

begin
strsFiles := TStringList.Create

SearchFiles(strsFiles, 'c:/', '')

end


这个不是我写的,只是提供查考。
 
beta, :你哪去了啊!
 

我真的服了你。
修改一下function ConvertStr(Str: string): string;
 
谢谢各位,我试代码去了,再见.
 
方法大家都说了,来迟了
 
顶部