• Vui lòng đọc nội qui diễn đàn để tránh bị xóa bài viết
  • Tìm kiếm trước khi đặt câu hỏi

Lấy link Youtube

Các thủ thuật về hệ thống, thư mục, tập tin và mạng
dactung93
Thành viên tâm huyết
Thành viên tâm huyết
Bài viết: 496
Ngày tham gia: T.Ba 04/11/2008 8:43 am
Has thanked: 6 time
Been thanked: 8 time

Lấy link Youtube

Gửi bàigửi bởi dactung93 » T.Tư 25/02/2009 10:50 am

Có một số chương trình hay trang Web lấy link youtube nhưng chúng có một số đặc điểm như sau
Đối với chương trình lấy và down ( hầu như các chương trình toàn lấy rồi down chứ không cho ta link ) nên tốc độ download sẽ rất là lâu.
Đối với trang web thì tốc độ của nó lề mề vì còn phải load hình load ảnh nữa.
Vậy mình xin giới thiệu với các bạn mã nguồn các lấy link down của youtube rồi copy vào IDM hay GIGAGET để down tốc độ cao
- Bạn cần Inet control
- 2 Textbox
- 1 Button

Mã: Chọn hết

  1.  
  2. ' APIs cho sự kiện kéo thả
  3. Private Declare Function ReleaseCapture Lib "user32" () As Long
  4. Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
  5. Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
  6.  
  7. Private Const HTCAPTION = 2
  8. Private Const WM_NCLBUTTONDOWN = &HA1
  9.  
  10. Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
  11. Private fln As String
  12. Dim mblnCanceled As Boolean, mblnConnected As Boolean
  13. Dim DonloadLink, vName As String
  14. Function GetVideoFile(Url As String)
  15. On Error GoTo err:
  16.     Dim RequestVideoId, respText
  17.         lblStat.Caption = "Getting File Name"
  18.         'Lấy code trang youtube bạn đưa vào
  19.         respText = Inet1.OpenURL(Url)
  20.        
  21.         'Tìm tên của video đấy ( lấy từ tiêu đề trang đấy )
  22.         vName = FindVideoName(respText)
  23.    
  24.     If Len(vName) = 0 Then
  25.         MsgBox "Không thể lấy được tên video từ địa chỉ: " & Url
  26.         Exit Function
  27.     End If
  28.             'Nếu mà nó trông giống với cái ID sau thì được video_id=SSQEdNysJDA&view_type=L&watch3=1&search=baby
  29.     VideoId = GetVideoId(respText)
  30.        
  31.     If Len(VideoId) = 0 Then
  32.         MsgBox "Không lấy được ID từ  URL " & vbCrLf & Url
  33.         Exit Function
  34.     End If
  35.     'Đã lấy được link download
  36.     DonloadLink = "http://youtube.com/get_video?" & VideoId
  37.    
  38.     Exit Function
  39. err:
  40. MsgBox "Error: " & vbCrLf & err.Description & " Try Again..!" & vbCrLf & "Nếu vẫn còn lỗi thì copy lại URL đi bạn"
  41. End Function
  42. Function FindVideoName(strResponse)
  43.     FindVideoName = JamesBond(strResponse, "<title>YouTube - ([^<]+)<")
  44. End Function
  45. Function GetVideoId(strResponse)
  46.  
  47.     Dim video_id
  48.     video_id = JamesBond(strResponse, "video_id"": ""([^""]+)")
  49.     Dim t_id
  50.     t_id = JamesBond(strResponse, "t"": ""([^""]+)")
  51.  
  52.     GetVideoId = "video_id=" & video_id & "&t=" & t_id
  53. End Function
  54. Function JamesBond(Text, Pattern)
  55.  
  56.  
  57.     Dim Regex, Matches
  58.  
  59.     Set Regex = New RegExp
  60.     Regex.Pattern = Pattern
  61.     Set Matches = Regex.Execute(Text)
  62.     If Matches.Count = 0 Then
  63.         JamesBond = ""
  64.         Exit Function
  65.     End If
  66.  
  67.     JamesBond = Matches(0).SubMatches(0)
  68. End Function
  69.  
  70. Private Sub Command1_Click()
  71. GetVideoFile Text1.Text
  72. End Sub
  73.  
  74.  
  75.  


Em đã thử code ở nhà và kết quả vẫn ngon lành. Nếu có gì thì các bạn giúp mình Fix code nhá :) thanks



Hình đại diện của người dùng
vie87vn
Thành viên tích cực
Thành viên tích cực
Bài viết: 150
Ngày tham gia: T.Bảy 05/04/2008 10:15 am
Đến từ: Quán Đôi - Củ Chi
Been thanked: 2 time
Liên hệ:

Re: Lấy link Youtube

Gửi bàigửi bởi vie87vn » T.Năm 26/02/2009 3:09 pm

Inet control trong Compoment tên là: Microsoft Internet Transfer Control 6.0
Mình test thử thì thế này:
Tập tin đính kèm
Err.jpg
Lỗi vậy sửa lèm seo?
Err.jpg (15.27 KiB) Đã xem 2701 lần
Hoàng Sa và Trường Sa là của Việt Nam.

dactung93
Thành viên tâm huyết
Thành viên tâm huyết
Bài viết: 496
Ngày tham gia: T.Ba 04/11/2008 8:43 am
Has thanked: 6 time
Been thanked: 8 time

Re: Lấy link Youtube

Gửi bàigửi bởi dactung93 » T.Sáu 27/02/2009 10:23 am

Đây là cách sửa bạn ah
Chọn Project --> Refer... --> Và chọn các mục theo như hình dưới đây. Bạn sẽ thấy được ngay mà

untitled.JPG

Hình đại diện của người dùng
truongphu
VIP
VIP
Bài viết: 4760
Ngày tham gia: CN 04/11/2007 10:57 am
Đến từ: Cam Đức, Khánh hòa
Has thanked: 14 time
Been thanked: 515 time

Re: Lấy link Youtube

Gửi bàigửi bởi truongphu » T.Sáu 27/02/2009 1:53 pm

12 dòng code đầu tiên sao không thấy dactung93 sử dụng nhỉ ? :>
o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh

dactung93
Thành viên tâm huyết
Thành viên tâm huyết
Bài viết: 496
Ngày tham gia: T.Ba 04/11/2008 8:43 am
Has thanked: 6 time
Been thanked: 8 time

Re: Lấy link Youtube

Gửi bàigửi bởi dactung93 » T.Bảy 28/02/2009 8:56 am

À, đấy là em đang định sử dụng cái sự kiện kéo thả link cho nhanh vào đấy mà. Nhưng mới biết khai báo thôi. Chưa làm xong. Tức là nếu ai đó muốn lấy cùng lúc nhiều phim mà không muốn mất thì giờ thì cú chỉ vào link đó rồi kéo ra khung tìm link là OK mà


Quay về “[VB] Hệ thống - Tập tin - Thư mục và Mạng”

Đang trực tuyến

Đang xem chuyên mục này: Không có thành viên nào trực tuyến.2 khách