There is one. I made it by myself today.
unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ComCtrls, ExtCtrls, SHLOBJ, Buttons, Grids;
type
TForm1 = class(TForm)
StatusBar1: TStatusBar;
Panel1: TPanel;
Button3: TButton;
SpeedButton1: TSpeedButton;
Button2: TButton;
Edit2: TEdit;
Edit1: TEdit;
Button1: TButton;
Label1: TLabel;
Panel2: TPanel;
Memo1: TMemo;
Panel3: TPanel;
Memo2: TMemo;
Panel4: TPanel;
ProgressBar1: TProgressBar;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{$LongStrings On}
procedure FindFiles(FilesList: TStringList; StartDir, FileMask: string);
var
SR: TSearchRec;
DirList: TStringList;
IsFound: Boolean;
i: integer;
begin
if StartDir[length(StartDir)] <> '\' then
StartDir := StartDir + '\';
IsFound := FindFirst('\\?\' + StartDir+FileMask, faAnyFile-faDirectory, SR) = 0;
while IsFound do begin
FilesList.Add(StartDir + SR.Name);
IsFound := FindNext(SR) = 0;
end;
FindClose(SR);
DirList := TStringList.Create;
IsFound := FindFirst('\\?\' + StartDir + '*.*', faAnyFile, SR) = 0;
while IsFound do begin
if ((SR.Attr and faDirectory) <> 0) and
(SR.Name[1] <> '.') then
DirList.Add(StartDir + SR.Name);
IsFound := FindNext(SR) = 0;
end;
FindClose(SR);
for i := 0 to DirList.Count - 1 do
FindFiles(FilesList, DirList[i], FileMask);
DirList.Free;
end;
function BrowseForFolder(var Foldr: string; Title: string): Boolean;
var
BrowseInfo: TBrowseInfo;
ItemIDList: PItemIDList;
DisplayName: array[0..MAX_PATH] of Char;
begin
Result := False;
FillChar(BrowseInfo, SizeOf(BrowseInfo), #0);
with BrowseInfo do begin
hwndOwner := Application.Handle;
pszDisplayName := @DisplayName[0];
lpszTitle := PChar(Title);
ulFlags := BIF_RETURNONLYFSDIRS;
end;
ItemIDList := SHBrowseForFolder(BrowseInfo);
if Assigned(ItemIDList) then
if SHGetPathFromIDList(ItemIDList, DisplayName) then begin
Foldr := DisplayName;
Result := True;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Foldr: string;
FilesList: TStringList;
i: Integer;
begin
if BrowseForFolder(Foldr, 'Select a source folder') then begin
Edit1.Text := Foldr;
Edit2.Text := '';
Button3.Enabled:= false;
ProgressBar1.Position := 0;
Button2.Enabled:= true;
FilesList := TStringList.Create;
try
FindFiles(FilesList, Edit1.Text, '*.*');
for i:= 0 to FilesList.Count-1 do
FilesList[i] := Copy(FilesList[i], Length(Edit1.Text)+2, Length(FilesList[i]));
Memo1.Lines.Assign(FilesList);
Label1.Caption := 'Files found: ' + IntToStr(FilesList.Count);
finally
FilesList.Free;
end;
end else begin
Button2.Enabled:= false;
Button3.Enabled:= false;
Edit1.Text := '';
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
Foldr: string;
i: Integer;
begin
if BrowseForFolder(Foldr, 'Select a destination folder') then begin
Edit2.Text := Foldr;
Button3.Enabled:= true;
for i := 0 to Memo1.Lines.Count - 1 do
begin
Memo2.Lines.Add(Utf8ToAnsi(Memo1.Lines[i]));
end;
end else begin
Edit2.Text := '';
Button3.Enabled:= false;
end;
end;
procedure Split (const Delimiter: Char; Input: string; const Strings: TStrings) ;
begin
Assert(Assigned(Strings)) ;
Strings.Clear;
Strings.Delimiter := Delimiter;
Strings.DelimitedText := Input;
end;
procedure TForm1.Button3Click(Sender: TObject);
var
i,j, error : Integer;
DestDir: String;
begin
Button1.Enabled:= false;
Button2.Enabled:= false;
Button3.Enabled:= false;
StatusBar1.Panels[0].Text := 'Parsing directory names...';
for i := 0 to Memo1.Lines.Count - 1 do
begin
j := LastDelimiter('\', Memo2.Lines[i]);
DestDir := '\\?\' + Edit2.Text + '\' + Copy(Memo2.Lines[i], 0, j-1);
if not DirectoryExists(DestDir) then begin
{$IOChecks off}
ForceDirectories(DestDir);
// Did the directory get created OK?
error := IOResult;
if error <> 0
then ShowMessageFmt('Directory creation failed with error %d',[error]);
{$IOChecks on}
end;
end;
StatusBar1.Panels[0].Text := 'Copying...';
for i := 0 to Memo1.Lines.Count - 1 do
begin
if ProgressBar1.Position <> Round((100/Memo1.Lines.Count) * i) then begin
ProgressBar1.Position := Round((100/Memo1.Lines.Count) * i);
Button3.Caption := IntToStr(Round((100/Memo1.Lines.Count) * i)) + '%';
end;
CopyFile(PChar('\\?\' + Edit1.Text + '\' + Memo1.Lines[i]), PChar('\\?\' + Edit2.Text + '\' + Memo2.Lines[i]), False);
end;
Button1.Enabled:= True;
ProgressBar1.Position := 100;
Button2.Enabled:= True;
Button3.Enabled:= True;
Button3.Caption := 'Convert';
StatusBar1.Panels[0].Text := 'Ready!';
ShowMessageFmt('Converted %d files', [i]);
end;
end.