Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Delphi: Для новичков > Смена расширения php на txt

Автор: BeeMaster 27.12.2008, 21:44

Народ подскажите пожалуйста код для смены расширения файлов. Суть в том что есть определенный двигатель сайта на php. И мне надо найти определенную фразу в одном из файлов. Но стандартный поиск не ищит текст в файлах с расширением php.
Путь до папки с двигом c:\123

мне просто надо запустить программу и она бы расширение поменяла у файлов с расширением php на txt.

ОЧЕНЬ НАДО

smile

Автор: THandle 27.12.2008, 23:27

BeeMaster,

1) ищешь все файлы с расширением .php
Смотри сслыки в этом посте:
http://forum.vingrad.ru/index.php?showtopic=241852&view=findpost&p=1740483

2) RenameFile для каждого найденного .php файла.

Автор: Akella 28.12.2008, 01:32

Цитата(BeeMaster @ 27.12.2008, 21:44

)

Но стандартный поиск не ищит текст в файлах с расширением php.

что за стандартный поиск

Автор: BeeMaster 28.12.2008, 17:26

Код


procedure ListFilesInDirectory(Dir: string; Strings: TStrings);
var
  rSearchRec: TSearchRec;
begin
  if ((Dir = '') or (not Assigned(Strings))) then
    Exit;
  Dir := IncludeTrailingPathDelimiter(Dir);
  if FindFirst(Dir + '*.php', faAnyFile, rSearchRec) = 0 then
    try
      repeat
        if ((rSearchRec.Name <> '.') and (rSearchRec.Name <> '..')) then
          if (rSearchRec.Attr and faDirectory) <> 0 then
            ListFilesInDirectory(Dir + rSearchRec.Name, Strings)
          else
            Strings.Add(rSearchRec.Name);
      until FindNext(rSearchRec) <> 0;
    finally
      FindClose(rSearchRec);
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ListFilesInDirectory('C:\123', Memo1.Lines);
end;

procedure TForm1.Button2Click(Sender: TObject);
 var
  i:integer;
  ii:integer;
  oldName, newName : string;
begin
  i := Memo1.Lines.Count;
  ii:=0;
  while i<ii do
  begin
  oldName := Memo1.Lines.Strings[ii];
  newName := ChangeFileExt(oldName, '.txt');
  RenameFile(oldName, newName);
  ii:=ii+1;
  end;
end

Вот я сделал. Но из-за того что при нахождение файлов не пишится целиком путь до файла у меня переименовывание не срабатывает. Подскажите как переделать код для того чтобы писался путь до файла???

Akella, системный поиск, который с системой идет в комплекте =)))

Автор: THandle 28.12.2008, 20:11

Код


function ExtractFileNameWithoutExt(const FileName: String): String;
var
  DPos: Integer;
begin
  Result := ExtractFileName(FileName);
  DPos := LastDelimiter('.', Result);
  if DPos > 0 then
    Result := Copy(Result, 1, DPos - 1);
end;

procedure RenameFilesInDirectory(Dir: string; const Ext1, Ext2: String);
var
  rSearchRec: TSearchRec;
begin
  if Dir = '' then
    Exit;
  Dir := IncludeTrailingPathDelimiter(Dir);
  if FindFirst(Dir + '*.*', faAnyFile, rSearchRec) = 0 then
    repeat
      if ((rSearchRec.Name <> '.') and (rSearchRec.Name <> '..')) then
        if (rSearchRec.Attr and faDirectory) <> 0 then
          RenameFilesInDirectory(Dir + rSearchRec.Name, Ext1, Ext2)
        else
          if CompareText(ExtractFileExt(rSearchRec.Name), Ext1) = 0 then
            RenameFile(Dir + rSearchRec.Name, Dir + ExtractFileNameWithoutExt(rSearchRec.Name) + Ext2);
    until FindNext(rSearchRec) <> 0;
  FindClose(rSearchRec);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  RenameFilesInDirectory('C:\', '.php', '.txt');
end;

Должна переименовать все php файлы на диске C в txt.

Автор: Akella 28.12.2008, 23:41

Цитата(THandle @ 28.12.2008, 20:11

)

function ExtractFileNameWithoutExt(const FileName: String): String;
var
  S: String;
begin
  S := ExtractFileName(FileName);
  Result := Copy(S, 1, LastDelimiter('.', S) - 1);
end;

а если не будет точки?

Автор: THandle 29.12.2008, 09:04

Akella, значит тогда у файла нет расширения smile

Но согласен, некоректная функция, исправил чуток. smile