delphi M3U8列表下载视频

需要uAES这里下载：https://sourceforge.net/projects/eucoin/

unit FM_Main;

interface

uses

  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,

  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,

  Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.ComCtrls, IdIOHandler, IdIOHandlerSocket,

  IdIOHandlerStack, IdSSL, IdSSLOpenSSL, IdBaseComponent, IdComponent,

  IdTCPConnection, IdTCPClient, IdHTTP, IdGlobal, uAES;

type

  TDownloadEven = procedure(Sender: TObject; ATotal, AIndex: Integer) of object;

  TM3U8 = class

  private

    mHTTP: TIdHTTP;

    mSSL: TIdSSLIOHandlerSocketOpenSSL;

    mURL_Head: string;

    mKey: TAESKey128;

    mIV: TAESBuffer;

    mList: TStringList;

    FOnDownload: TDownloadEven;

    ///

    procedure GetURLHead(AURL: string);

    ///

    procedure ParseKey(AText: string);

    ///

    procedure GetAESKey(AURL: string);

    ///

    procedure GetIV(AText: string);

    ///

    procedure GetList(AURL: string);

    ///

    procedure GetTS(AURL: string; out Ams: TMemoryStream);

    ///

    procedure SaveTS(AFileName: string);

    procedure SetOnDownload(const Value: TDownloadEven);

  public

    constructor Create;

    destructor Destroy; override;

    ///

    ///链接地址

    ///保存文件名，含完整路径

    procedure Download(AURL, AFileName: string);

    property OnDownload: TDownloadEven read FOnDownload write SetOnDownload;

  end;

  TfrmMain = class(TForm)

    edtURL: TLabeledEdit;

    btnRun: TButton;

    mmoLog: TMemo;

    edtFile: TLabeledEdit;

    btnSelectFile: TButton;

    pb1: TProgressBar;

    dlgSave1: TSaveDialog;

    lblTProgress: TLabel;

    lbl1: TLabel;

    procedure FormCreate(Sender: TObject);

    procedure FormDestroy(Sender: TObject);

    procedure btnRunClick(Sender: TObject);

    procedure btnSelectFileClick(Sender: TObject);

  private

    m3u8: TM3U8;

    procedure ProcDownload(Sender: TObject; ATotal, AIndex: Integer);

  public

  end;

var

  frmMain: TfrmMain;

implementation

{$R *.dfm}

const //使用说明

  Tips = '【使用说明】' + #13#10 //

    + '1. 用【火狐】打开网页，找到想要下载的视频，并播放' + #13#10 //

    + '2. 按【F12】进入到调试模式' + #13#10 //

    + '3. 从出来的界面中点【网络】' + #13#10 //

    + '4. 在下方选择【XHR】' + #13#10 //

    + '5. 按【F5】刷新，或者点界面中的【重新载入】' + #13#10 //

    + '6. 选择第一条【方法】列为【GET】，且【类型】列为【vnd.apple.mpegurl】' + #13#10 //

    +

    '7. 复制【GET】后面的网址，例如：【https://cd11-ccd1-1.play.bokecc.com/flvs/4800438B48685E7E/2018-08-23/6D06EE8E082C7D789C33DC5901307461-10.m3u8?t=1600635731&key=0AA94E693F6E5786ADD5E7009BFBF5C9&tpl=10&tpt=112】' +

    #13#10 //

    + '8. 把网址粘贴到本工具的【下载地址】里' + #13#10 //

    + '9. 点【选择位置】，选择一个要保存的文件夹，并给要下载的视频起个名字' + #13#10 //

    + '10.点【开始下载】等待视频下载完成' + #13#10 //

    + '11.重复以上操作下载其它视频' + #13#10 //

    + '================================================================================';

{ TM3U8 }

constructor TM3U8.Create;

begin

  mHTTP := TIdHTTP.Create(nil);

  mSSL := TIdSSLIOHandlerSocketOpenSSL.Create(nil);

  mSSL.SSLOptions.Method := sslvSSLv23;

  mSSL.SSLOptions.Mode := sslmBoth;

  mHTTP.IOHandler := mSSL;

  mList := TStringList.Create;

  mHTTP.Request.Accept := '*/*';

  mHTTP.Request.AcceptEncoding := 'gzip, deflate, br';

  mHTTP.Request.AcceptLanguage :=

    'zh-CN,zh;q=0.8,zh-TW;q=0.7,zh-HK;q=0.5,en-US;q=0.3,en;q=0.2';

  mHTTP.Request.Connection := 'keep-alive';

  mHTTP.Request.UserAgent :=

    'Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:80.0) Gecko/20100101 Firefox/80.0';

end;

destructor TM3U8.Destroy;

begin

  mList.Free;

  mSSL.Free;

  mHTTP.Free;

  inherited Destroy;

end;

procedure TM3U8.Download(AURL, AFileName: string);

begin

  //提取链接头

  GetURLHead(AURL);

  //提取分片列表

  GetList(AURL);

  //下载分片

  SaveTS(AFileName);

end;

procedure TM3U8.GetAESKey(AURL: string);

var

  ms: TMemoryStream;

begin

  ms := TMemoryStream.Create;

  try

    mHTTP.Get(AURL, ms);

    ms.Position := 0;

    ms.Read(mKey, 16);

  finally

    ms.Free;

  end;

end;

procedure TM3U8.GetIV(AText: string);

var

  i: Integer;

begin

  for i := 0 to 15 do

  begin

    mIV[i] := StrToUInt('$' + Copy(AText, i * 2 + 1, 2)) and $FF;

  end;

end;

procedure TM3U8.GetList(AURL: string);

var

  sl: TStringList;

  i: Integer;

begin

  sl := TStringList.Create;

  try

    sl.Text := mHTTP.Get(AURL);

    mList.Clear;

    for i := 0 to sl.Count - 1 do

    begin

      //密钥

      if Pos('#EXT-X-KEY', UpperCase(sl[i])) > 0 then

      begin

        ParseKey(sl[i]);

        Continue;

      end;

      //分片列表

      if Pos('#EXTINF', UpperCase(sl[i])) > 0 then

      begin

        mList.Add(mURL_Head + sl[i + 1]);

        Continue;

      end;

    end;

  finally

    sl.Free;

  end;

end;

procedure TM3U8.GetTS(AURL: string; out Ams: TMemoryStream);

var

  ms: TMemoryStream;

begin

  ms := TMemoryStream.Create;

  try

    mHTTP.Get(AURL, ms);

    ms.Position := 0;

    Ams.Clear;

    DecryptAESStreamCBC(ms, ms.Size, mKey, mIV, Ams);

  finally

    ms.Free;

  end;

end;

procedure TM3U8.GetURLHead(AURL: string);

var

  sl: TStringList;

  i: Integer;

begin

  mURL_Head := '';

  sl := TStringList.Create;

  try

    ExtractStrings(['/'], [], PChar(AURL), sl);

    for i := 0 to sl.Count - 2 do

      mURL_Head := mURL_Head + sl[i] + '/';

    mURL_Head := StringReplace(mURL_Head, 'https:/', 'https://', [rfIgnoreCase]);

  finally

    sl.Free;

  end;

end;

procedure TM3U8.ParseKey(AText: string);

var

  sl: TStringList;

  i: Integer;

  url, iv: string;

begin

  url := '';

  sl := TStringList.Create;

  try

    ExtractStrings([','], [], PChar(AText), sl);

    for i := 0 to sl.Count - 1 do

    begin

      if UpperCase(sl.KeyNames[i]) = 'URI' then

      begin

        url := sl.ValueFromIndex[i];

        url := StringReplace(url, '"', '', [rfReplaceAll, rfIgnoreCase]);

        GetAESKey(url);

        Continue;

      end;

      if UpperCase(sl.KeyNames[i]) = 'IV' then

      begin

        iv := sl.ValueFromIndex[i];

        iv := StringReplace(iv, '0x', '', [rfReplaceAll, rfIgnoreCase]);

        GetIV(iv);

        Continue;

      end;

    end;

  finally

    sl.Free;

  end;

end;

procedure TM3U8.SaveTS(AFileName: string);

var

  fs: TFileStream;

  ms: TMemoryStream;

  i: Integer;

begin

  fs := TFileStream.Create(AFileName, fmCreate);

  ms := TMemoryStream.Create;

  try

    fs.Position := 0;

    for i := 0 to mList.Count - 1 do

    begin

      if Assigned(FOnDownload) then

        FOnDownload(Self, mList.Count, i);

      GetTS(mList[i], ms);

      fs.CopyFrom(ms, 0);

      Application.ProcessMessages;

    end;

  finally

    if Assigned(FOnDownload) then

      FOnDownload(Self, mList.Count, i);

    ms.Free;

    fs.Free;

  end;

end;

procedure TM3U8.SetOnDownload(const Value: TDownloadEven);

begin

  FOnDownload := Value;

end;

procedure TfrmMain.btnRunClick(Sender: TObject);

begin

  if Trim(edtURL.Text) = '' then

  begin

    ShowMessage('下载地址不能为空！');

    Exit;

  end;

  if Trim(edtFile.Text) = '' then

  begin

    ShowMessage('保存位置不能为空！');

    Exit;

  end;

  mmoLog.Lines.Add(Format('[%s]从【%s】下载到【%s】', [FormatDateTime('HH:NN:SS', Now),

    edtURL.Text, edtFile.Text]));

  m3u8.Download(edtURL.Text, edtFile.Text);

  mmoLog.Lines.Add(Format('[%s]%s', [FormatDateTime('HH:NN:SS', Now), 'OK!']));

end;

procedure TfrmMain.btnSelectFileClick(Sender: TObject);

begin

  dlgSave1.Filter := 'mp4|*.mp4';

  dlgSave1.DefaultExt := 'mp4';

  if dlgSave1.Execute then

    edtFile.Text := dlgSave1.FileName;

end;

procedure TfrmMain.FormCreate(Sender: TObject);

begin

  m3u8 := TM3U8.Create;

  m3u8.OnDownload := ProcDownload;

  mmoLog.Lines.Add(Tips);

end;

procedure TfrmMain.FormDestroy(Sender: TObject);

begin

  m3u8.Free;

end;

procedure TfrmMain.ProcDownload(Sender: TObject; ATotal, AIndex: Integer);

begin

  pb1.Max := ATotal;

  pb1.Position := AIndex;

  lblTProgress.Caption := Format('%d/%d', [AIndex, ATotal]);

end;

end.