unit MainForm;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.StdCtrls,
  Vcl.ExtCtrls, Vcl.ImgList, System.SyncObjs, Vcl.FileCtrl;

type
  TForm1 = class(TForm)
    lstVideo: TListView;
    Label1: TLabel;
    Panel1: TPanel;
    btnClear: TButton;
    btnCopy: TButton;
    ImageList1: TImageList;
    cmbUpan: TComboBox;
    procedure FormCreate(Sender: TObject);
    procedure lstVideoCustomDrawSubItem(Sender: TCustomListView;
      Item: TListItem; SubItem: Integer; State: TCustomDrawState;
      var DefaultDraw: Boolean);
    procedure btnClearClick(Sender: TObject);
    procedure btnCopyClick(Sender: TObject);
  private
    procedure OnDropFiles(var msg: TMessage); message WM_DROPFILES;
  public

  end;

  TExtractThread = class(TThread)
    procedure Execute; override;

    public
      FFmpegPath: string;
      FilePath: string;
      ListItem: TListItem;
      Form: TForm1;
  end;
var
  Form1: TForm1;
  LeftCount: Integer;

implementation

{$R *.dfm}

uses
  Winapi.ShellApi, IOUtils;

procedure TForm1.btnClearClick(Sender: TObject);
begin
  lstVideo.Clear;
end;

procedure TForm1.btnCopyClick(Sender: TObject);
var
  copyOpt: SHFILEOPSTRUCT;
  uPan: string;
  fileList: TStringBuilder;
  listItem: TListItem;
  i: Integer;
begin
  if cmbUpan.ItemIndex < 0 then Exit;

  copyOpt.Wnd := Self.Handle;
  copyOpt.wFunc := FO_COPY;
  copyOpt.fFlags := 0;
  copyOpt.pTo := PWideChar(cmbUpan.Items.Objects[cmbUpan.ItemIndex].ToString);

  // 讲所有语音路径组合起来
  fileList := TStringBuilder.Create;
  for i := 0 to lstVideo.Items.Count - 1 do
  begin
    // 如果提取失败就跳过
    if lstVideo.Items[i].SubItems[1] = '提取失败' then
      continue;

    fileList.Append(lstVideo.Items[i].SubItems[0]).Append(#0);
  end;
  fileList.Append(#0);

  copyOpt.pFrom := PWideChar(fileList.ToString);

  // 复制音乐到U盘
  SHFileOperation(copyOpt);

  FreeAndNil(fileList);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  res: TResourceStream;
  driveList: array [1..64] of Char;
  drive: string;
  driveName: array [0..127] of Char;
  rev1, rev2: Cardinal;
  driveLen: Cardinal;
  driveType: Cardinal;
  start, stop: Integer;
const
  defDriveName: string = '可移动磁盘';
begin
  DragAcceptFiles(Self.Handle, True);

  // 如果没有ffmpeg，则从程序中自行提取
  if not TFile.Exists('ffmpeg.exe') then
  begin
    res := TResourceStream.Create(HInstance, 'RES_FFMPEG', RT_RCDATA);
    res.SaveToFile('ffmpeg.exe');
    FreeAndNil(res);
  end;

  // 枚举所有U盘
  driveLen := GetLogicalDriveStrings(SizeOf(driveList), @driveList);
  start := 1;
  for stop := 1 to driveLen do
  begin
    if driveList[stop] = #0 then
    begin
      drive := Copy(driveList, start, stop - start);
      driveType := GetDriveType(PWideChar(drive));
      GetVolumeInformation(PWideChar(drive), @driveName, SizeOf(driveName), nil, rev1, rev2, nil, 0);

      if Length(string(driveName)) = 0 then
      begin
        ZeroMemory(@driveName, SizeOf(driveName));
        CopyMemory(@driveName, PWideChar(defDriveName), Length(defDriveName) * SizeOf(Char));
      end;

      if driveType = DRIVE_REMOVABLE then
      begin
        cmbUpan.AddItem(Format('%s(%s)', [driveName, drive]),
          TStringBuilder.Create(drive));
      end;

      start := stop + 1;
    end;
  end;

  cmbUpan.ItemIndex := 0;
end;

procedure TForm1.lstVideoCustomDrawSubItem(Sender: TCustomListView;
  Item: TListItem; SubItem: Integer; State: TCustomDrawState;
  var DefaultDraw: Boolean);
begin
  if SubItem <> 1 then Exit;

  if Item.SubItems[1] = '提取成功' then
    Sender.Canvas.Font.Color := clGreen
  else if Item.SubItems[1] = '提取失败' then
    Sender.Canvas.Font.Color := clRed;
end;

procedure TForm1.OnDropFiles(var msg: TMessage);
var
  path: array [0..255] of Char;
  funcRet: Cardinal;
  i: Integer;
  item: TListItem;
  thread: TExtractThread;
begin
  // 先看看拖拽进来几个文件
  funcRet := DragQueryFile(msg.WParam, $FFFFFFFF, nil, SizeOf(path));
  for i := 0 to funcRet - 1 do
  begin
    btnClear.Enabled := False;
    btnCopy.Enabled := False;

    InterlockedIncrement(LeftCount);

    item := lstVideo.Items.Add;
    DragQueryFile(msg.WParam, i, @path, SizeOf(Path));
    item.Caption := TPath.GetFileName(path);
    item.SubItems.AddObject('', TStringBuilder.Create(path));
    item.SubItems.Add('等待提取');

    thread := TExtractThread.Create(True);
    thread.FFmpegPath := 'ffmpeg.exe';
    thread.FilePath := path;
    thread.ListItem := item;
    thread.Form := Self;
    thread.Start;
  end;

  DragFinish(msg.WParam);
end;

procedure TExtractThread.Execute;
var
  cmd: string;
  execInfo: SHELLEXECUTEINFO;
  exitCode: Cardinal;
begin
  // 调用ffmpeg提取文件
  ListItem.SubItems[1] := '正在提取';

  execInfo.cbSize := SizeOf(SHELLEXECUTEINFO);
  execInfo.fMask := SEE_MASK_NOCLOSEPROCESS;
  execInfo.lpFile := PWideChar(FFmpegPath);
  execInfo.lpParameters := PWideChar(' -i "' + FilePath + '" -vn "' + FilePath + '.mp3"');
  execInfo.nShow := SW_HIDE;

  ShellExecuteEx(@execInfo);
  WaitForSingleObject(execInfo.hProcess, INFINITE);
  GetExitCodeProcess(execInfo.hProcess, exitCode);

  if exitCode = 0 then
  begin
    ListItem.SubItems[1] := '提取成功';
    ListItem.SubItems[0] := FilePath + '.mp3';
  end
  else
    ListItem.SubItems[1] := '提取失败';

    ListItem.SubItems.Objects[0].Free;
  if InterlockedDecrement(LeftCount) = 0 then
  begin
    Form.btnClear.Enabled := True;
    Form.btnCopy.Enabled := True;
  end;

  Self.Destroy;
end;

end.