批量自动下载chrome中的书签中保存的在线视频(如youtube)

年复年的积累的chrome中的url收藏,担心一旦资源消失(尤其是在线播放的视频文件),岂不损失大大的,所以希望能够写这么一个程序:可以自动批量下载chrome中的视频链接。但是又如何实现呢:

思路:

1、备份chrome中的书签文件,并导出。(bookmarks_2018_9_22.html)

2、程序解析出html中的书签链接。(使用dihtmlparser组件,有下载,使用的是D7(组件:7.6版本))

3、按顺序自动下载链接中的在线视频。

用到的技术:

1、dihtmlparser组件。(作用:对以上第一步中的html进行解析)

以下为工程单元文件(project1.dpr)

 
 
//工程单元,必须按照以下写法,否则无法执行

program Project1; {$I DI.inc} //必须写 uses {$IFDEF FastMM}FastMM4,{$ENDIF} //也必须写 Forms, Common in 'Common.pas', //不要漏掉 Unit1 in 'Unit1.pas' {Form1}; {$R *.res} {$R XpManifest.res} //别漏掉 begin Application.Initialize; Application.CreateForm(TForm1, Form1); Application.Run; end.

以下为主程序代码(form1.pas):

uses
      BmParser;
 private
    Parser: TBookMarkParser;
//解析书签文件bookmarks_2018_9_22.html并输出到memo组件
procedure TForm1.Button1Click(Sender: TObject);
var
  BM: PBookmark;
begin
         if Parser = nil then
         Parser := TBookMarkParser.Create;
         Parser.ParseBookMarkFile('d:\bookmarks_2018_9_22.html');
          BM := Parser.BookMarkTree.PFirstItem;
          BM := Parser.BookMarkTree.PFirstChildItem(BM);
          while BM <> nil do
          begin
              if pos('cnblogs.com',PBookmark(BM)^.URL)>0 then
              self.MemoComment.Lines.Add(PBookmark(BM)^.URL);
              BM := Parser.BookMarkTree.PNextSiblingItem(BM)
            end;

end;
//必须加入以下事件代码,否则报错

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose := (Parser = nil) or not Parser.Active;
end;

//必须加入以下代码
procedure TForm1.FormDestroy(Sender: TObject);
begin
Parser.Free;
end;

2、调用youtube-dl.exe【win64,win10测试通过】的功能。(注意:需要科学上网,并需要设成全局【如图】)

WriteToPipe(WriteIn, 'c:\users\hp\youtube-dl.exe');//给cmd 下下载命令

3、在程序中通过管道调用dos 控制台程序,并能反馈结果。

var
  Form1: TForm1;
  ReadOut, WriteOut, ReadIn, WriteIn: THandle;
  ProcessInfo: TProcessInformation;
implementation

{$R *.dfm}
  procedure WriteToPipe(Pipe: THandle; Value: string); //命令输入函数
var
  len: integer;
  BytesWrite: DWord;
  Buffer: PChar;
begin
  len := Length(Value) + 1;
  Buffer := PChar(Value + #10);
  WriteFile(Pipe, Buffer[0], len, BytesWrite, nil);
end;

 procedure TForm1.FinConsole; //关闭进程过程
begin
  TerminateProcess(ProcessInfo.hProcess, 0); //关闭cmd进程
end;
procedure TForm1.InitConsole;   //创建命令过程
var
  Security: TSecurityAttributes;
  StartUpInfo: TStartUpInfo;
begin
  with Security do begin
    nLength := SizeOf(TSecurityAttributes);
    bInheritHandle := true;
    lpSecurityDescriptor := nil;
  end;

  Createpipe(ReadOut, WriteOut, @Security, 0);
  Createpipe(ReadIn, WriteIn, @Security, 0);

  FillChar(StartUpInfo, Sizeof(StartUpInfo), #0);
  StartUpInfo.cb := SizeOf(StartUpInfo);
  with StartUpInfo do
  begin
    hStdOutput := WriteOut;
    hStdInput := ReadIn;
    hStdError := WriteOut;
    dwFlags := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
    wShowWindow := SW_HIDE;
  end;
  //创建cmd 进程   并且执行 edit1.text  命令
  CreateProcess(nil, PChar(edit1.Text), @Security, @Security, true,NORMAL_PRIORITY_CLASS, nil, nil, StartUpInfo, ProcessInfo);
 end;

function ReadFromPipe(Pipe: THandle): string;   //获取命令返回信息函数
var
  Buffer: PChar;
  BytesRead: DWord;
  ReadBuffer: Cardinal;
begin
  Result := '';
  if GetFileSize(Pipe, nil) = 0 then Exit;

  Buffer := AllocMem(ReadBuffer + 1);
  repeat
    BytesRead := 0;
    ReadFile(Pipe, Buffer[0], ReadBuffer, BytesRead, nil);  //读取返回信息
    if BytesRead > 0 then
    begin
      Buffer[BytesRead] := #0;
      OemToAnsi(Buffer, Buffer);
      Result := string(Buffer);
    end;
  until (BytesRead < ReadBuffer);
  FreeMem(Buffer);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
  s: string;
begin
  s := ReadFromPipe(ReadOut);   //获取cmd命令返回信息
  if s <> '' then begin
    Memo1.Lines.Text := Memo1.Lines.Text + s;     //添加到memo
    Memo1.SelStart := Length(Memo1.Lines.Text);
    Memo1.SelLength := 0;
  end;
end;

procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = 13 then  //当edit回车时候执行
  begin
    WriteToPipe(WriteIn, Edit1.Text);//给cmd 下命令
    Edit1.Text := '';
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
InitConsole;  //创建cmd 进程
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   FinConsole;//关闭创建的进程
end;

猜你喜欢

转载自www.cnblogs.com/windel/p/9691451.html