将unicode(UTF-8)文件名转换为ANSI(DOS)

有一个。我今天自己做的。

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.