批量自动下载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;