关于文件夹改名的问题（程序有点问题）：

Question

procedure TForm1.Button1Click(Sender: TObject);
var
  sr : TSearchRec;
const
  s = 'c:\Rename'; //把所有要改名的都放在这个文件夹下，根据你的情况修改。
begin
  if DirectoryExists(s) then
  begin
    if FindFirst(s+'\*.*', faAnyFile, sr) = 0 then
    begin
      repeat
        if (sr.Attr and faAnyFile) = sr.Attr then
        begin
          if (sr.Attr=faDirectory) and (sr.Name<>'.') and
            (sr.Name<>'..') then
               RenameFile(s+'\'+sr.Name, s+'\SH-'+ sr.Name);
        end;
      until FindNext(sr) <> 0
    end;
    FindClose(sr);
  end;
end;

Answer 1

修改测试，没有问题；可能是你其它设置的有问题，仔细找找吧。//首先建i个文件夹 ,我的测试数据分别是2000和10000，当到10000的时候是慢，但是功能也完成。
procedure TForm1.Button2Click(Sender: TObject);
var
  i:Integer;
begin
  for i := 1 to 10000 do
    ForceDirectories('C:\Rename\' + IntToStr(i));
end;procedure TForm1.Button1Click(Sender: TObject);
var
  sr : TSearchRec;
const
  s = 'c:\Rename'; //把所有要改名的都放在这个文件夹下，根据你的情况修改。
begin
  if DirectoryExists(s) then
  begin
    if FindFirst(s+'\*.*', faAnyFile, sr) = 0 then
    begin
      repeat
        if (sr.Attr and faAnyFile) = sr.Attr then
        begin
          if (sr.Attr=faDirectory) and (sr.Name<>'.') and
            (sr.Name<>'..') then
               RenameFile(s+'\'+sr.Name, s+'\SH-'+ sr.Name);
        end;
      until FindNext(sr) <> 0
    end;
    FindClose(sr);
  end;
end;