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

  • 主题发起人 主题发起人 lah998
  • 开始时间 开始时间
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;
 
谢谢各位，我试代码去了，再见.
 
方法大家都说了，来迟了
 
您必须登录或注册才可回复。

Similar threads

S
[教程]Delphi 函数的内部函数在匿名回调函数中无法使用的一种解决办法
回复
0
查看
555
swish
S
S
[ZBar]CalcPerf 函数
回复
0
查看
570
swish
S
不
ISO8583报文协议（转） - 不得闲
回复
0
查看
862
不得闲
不
不
Delphi中实现变长函数笔记 - 不得闲
回复
0
查看
988
不得闲
不
S
[教程]程序保存数据的防断电处理策略
回复
0
查看
922
swish
S
后退
顶部