#Android開發# B4A示例20200217：《抖印無蹤》
- 2020 年 2 月 26 日
- 筆記
這是一款集，許可權獲取，粘貼板應用，菜單應用，網頁跳轉，文件下載，創建目錄，json解析，網頁請求，控制項簡單使用 ，於一體的教程示例！
應用下載地址：
https://www.lanzous.com/i9f0vza
添加許可權
項目–>Manifest編輯器
使用的類庫
BClipboard 粘貼板操作類庫（第三方） HttpUtils2 網頁請求類庫（系統自帶） JSON JSON解析類庫（系統自帶） phone 手機系統類庫（系統自帶） RSAsyncDownloader 文件瞎下載類庫（第三方） RuntimePermissions 許可權請求類庫（系統自帶）
程式碼分步解釋
- 應用基本設置
#Region Project Attributes #ApplicationLabel: 抖印無蹤 -->應用名稱 #VersionCode: 1 -->版本號 #VersionName: -->版本名稱 #SupportedOrientations: unspecified -->螢幕狀態，橫屏，豎屏 #CanInstallToExternalStorage: False -->是否使用外部儲存 #End Region #Region Activity Attributes #FullScreen: False -->是否使用全螢幕 #IncludeTitle: True -->是否顯示標題欄 #End Region
- 變數說明
''全局變數定義 Sub Process_Globals '許可權控制 Dim rp As RuntimePermissions -->動態許可權請求 End Sub ''普通變數定義 Sub Globals '粘貼板控制 Dim clb As BClipboard -->粘貼板定義 Dim http As HttpJob -->網頁請求定義 Dim vurl As String,vname As String -->影片地址，影片名稱定義 Private bt_blog As Button -->部落格按鈕控制項 Private Bt_down As Button -->下載按鈕控制項 Private bt_parse As Button -->一鍵解析按鈕控制項 Private Bt_play As Button -->播放按鈕控制項 Private txt_url As EditText -->文本框控制項 Private web_play As WebView -->瀏覽器控制項 Private bt_clear As Button -->清空按鈕控制項 End Sub
- 事件解釋 1.啟動事件
Sub Activity_Create(FirstTime As Boolean) Activity.LoadLayout("main") '=========================== '檢測儲存許可權 rp.CheckAndRequest(rp.PERMISSION_WRITE_EXTERNAL_STORAGE) ''############################# bt_blog.Visible=False Bt_down.Visible=False Bt_play.Visible=False web_play.Visible=False '======================== '添加菜單 Activity.AddMenuItem("瀏覽部落格", "blog") Activity.AddMenuItem("查看路徑", "lookdir") Activity.AddMenuItem("關於", "gy") ''===================== '粘貼板檢測 Sleep(100) Dim dystr As String=clb.getText If dystr.Contains("抖音") Then Dim result As Int result = Msgbox2(dystr,"檢測到抖音分享鏈接，是否要粘貼？" , "粘貼", "", "取消",Null) If result = DialogResponse.Positive Then txt_url.Text=dystr End If End If End Sub
2.菜單事件
'訪問部落格 Sub blog_Click() Try Dim p As PhoneIntents StartActivity (p.OpenBrowser("http://vbee.xyz")) Catch ToastMessageShow("地址跳轉失敗！！",True) End Try End Sub Sub lookdir_Click() Msgbox("文件保存在：根目錄->抖印無蹤保存目錄","") End Sub Sub gy_Click() Msgbox("本程式由微信公眾號：VB小源碼 開發！，本測試只用於教程示例，切勿用於商業或其他非法活動！謝謝合作！","") End Sub
3.按鈕點擊事件
''影片播放 Sub Bt_play_Click If vurl<>"" Then web_play.Visible=True Try web_play.LoadUrl(vurl) Catch ToastMessageShow("影片播放失敗！",True) End Try End If End Sub ''調用介面去水印 Sub bt_parse_Click Dim uurl As String=get_url(txt_url.Text) '=================== bt_blog.Visible=False Bt_down.Visible=False Bt_play.Visible=False web_play.Visible=False web_play.Loadhtml("") vurl="" '=================== If uurl<> "" Then ProgressDialogShow("正在執行去水印...") http.Initialize("Http",Me) Dim url As String ="http://douyin.vbee.xyz/dy.php?act=dy&url=" & uurl http.Download(url) Wait For JobDone(job As HttpJob) If job.Success=True Then Dim json As JSONParser Dim ret As Map json.Initialize(job.GetString) ret=json.NextObject vurl=ret.Get("videourl") vname=ret.Get("name") End If ''################# If vurl<>"" Then ProgressDialogHide ToastMessageShow("去水印成功！",True) bt_blog.Visible=True Bt_down.Visible=True Bt_play.Visible=True End If End If End Sub ''保存影片 Sub Bt_down_Click ''創建目錄 Try If File.Exists(File.DirRootExternal, "抖印無蹤保存目錄")=False Then File.MakeDir(File.DirRootExternal, "抖印無蹤保存目錄") End If '============================= Dim dw As RSAsyncDownloader dw.Initialize("dw") dw.FileName = vname & ".mp4" dw.Directory =File.Combine( File.DirRootExternal, "抖印無蹤保存目錄") dw.Download(vurl) Catch ToastMessageShow("下載出錯！",True) End Try End Sub Private Sub dw_Started ProgressDialogShow("正在下載...") End Sub Private Sub dw_Update (Progress As Int) End Sub Private Sub dw_Finished (Result As String) If Result=Null Then ProgressDialogHide ToastMessageShow("影片保存成功！",False) Else ToastMessageShow("影片保存失敗！",True) End If End Sub ''進入部落格 Sub bt_blog_Click Try Dim p As PhoneIntents StartActivity (p.OpenBrowser("http://vbee.xyz")) Catch ToastMessageShow("地址跳轉失敗！！",True) End Try End Sub Sub bt_clear_Click txt_url.Text="" End Sub
4.方法函數
''解析地址 Sub get_url(st As String) As String If st<>"" Then Dim temp As String Try temp="https://" & Regex.Split("/",Regex.Split("://",st)(1))(0) & "/" & Regex.Split("/",Regex.Split("://",st)(1))(1) Return temp Catch ToastMessageShow("請輸入正確抖音分享鏈接！",False) Return "" End Try Else ToastMessageShow("請輸入正確抖音分享鏈接！",False) Return "" End If End Sub
全部程式碼
#Region Project Attributes #ApplicationLabel: 抖印無蹤 #VersionCode: 1 #VersionName: #SupportedOrientations: unspecified #CanInstallToExternalStorage: False #End Region #Region Activity Attributes #FullScreen: False #IncludeTitle: True #End Region Sub Process_Globals '許可權控制 Dim rp As RuntimePermissions End Sub Sub Globals '粘貼板控制 Dim clb As BClipboard Dim http As HttpJob Dim vurl As String,vname As String Private bt_blog As Button Private Bt_down As Button Private bt_parse As Button Private Bt_play As Button Private txt_url As EditText Private web_play As WebView Private bt_clear As Button End Sub Sub Activity_Create(FirstTime As Boolean) Activity.LoadLayout("main") '=========================== '檢測儲存許可權 rp.CheckAndRequest(rp.PERMISSION_WRITE_EXTERNAL_STORAGE) ''############################# bt_blog.Visible=False Bt_down.Visible=False Bt_play.Visible=False web_play.Visible=False '======================== '添加菜單 Activity.AddMenuItem("瀏覽部落格", "blog") Activity.AddMenuItem("查看路徑", "lookdir") Activity.AddMenuItem("關於", "gy") ''===================== '粘貼板檢測 Sleep(100) Dim dystr As String=clb.getText If dystr.Contains("抖音") Then Dim result As Int result = Msgbox2(dystr,"檢測到抖音分享鏈接，是否要粘貼？" , "粘貼", "", "取消",Null) If result = DialogResponse.Positive Then txt_url.Text=dystr End If End If End Sub '訪問部落格 Sub blog_Click() Try Dim p As PhoneIntents StartActivity (p.OpenBrowser("http://vbee.xyz")) Catch ToastMessageShow("地址跳轉失敗！！",True) End Try End Sub Sub lookdir_Click() Msgbox("文件保存在：根目錄->抖印無蹤保存目錄","") End Sub Sub gy_Click() Msgbox("本程式由微信公眾號：VB小源碼 開發！，本測試只用於教程示例，切勿用於商業或其他非法活動！謝謝合作！","") End Sub Sub Activity_Resume End Sub Sub Activity_Pause (UserClosed As Boolean) End Sub ''影片播放 Sub Bt_play_Click If vurl<>"" Then web_play.Visible=True Try web_play.LoadUrl(vurl) Catch ToastMessageShow("影片播放失敗！",True) End Try End If End Sub ''調用介面去水印 Sub bt_parse_Click Dim uurl As String=get_url(txt_url.Text) '=================== bt_blog.Visible=False Bt_down.Visible=False Bt_play.Visible=False web_play.Visible=False web_play.Loadhtml("") vurl="" '=================== If uurl<> "" Then ProgressDialogShow("正在執行去水印...") http.Initialize("Http",Me) Dim url As String ="http://douyin.vbee.xyz/dy.php?act=dy&url=" & uurl http.Download(url) Wait For JobDone(job As HttpJob) If job.Success=True Then Dim json As JSONParser Dim ret As Map json.Initialize(job.GetString) ret=json.NextObject vurl=ret.Get("videourl") vname=ret.Get("name") End If ''################# If vurl<>"" Then ProgressDialogHide ToastMessageShow("去水印成功！",True) bt_blog.Visible=True Bt_down.Visible=True Bt_play.Visible=True End If End If End Sub ''保存影片 Sub Bt_down_Click ''創建目錄 Try If File.Exists(File.DirRootExternal, "抖印無蹤保存目錄")=False Then File.MakeDir(File.DirRootExternal, "抖印無蹤保存目錄") End If '============================= Dim dw As RSAsyncDownloader dw.Initialize("dw") dw.FileName = vname & ".mp4" dw.Directory =File.Combine( File.DirRootExternal, "抖印無蹤保存目錄") dw.Download(vurl) Catch ToastMessageShow("下載出錯！",True) End Try End Sub Private Sub dw_Started ProgressDialogShow("正在下載...") End Sub Private Sub dw_Update (Progress As Int) End Sub Private Sub dw_Finished (Result As String) If Result=Null Then ProgressDialogHide ToastMessageShow("影片保存成功！",False) Else ToastMessageShow("影片保存失敗！",True) End If End Sub ''進入部落格 Sub bt_blog_Click Try Dim p As PhoneIntents StartActivity (p.OpenBrowser("http://vbee.xyz")) Catch ToastMessageShow("地址跳轉失敗！！",True) End Try End Sub Sub Activity_PermissionResult (Permission As String, Result As Boolean) End Sub ''解析地址 Sub get_url(st As String) As String If st<>"" Then Dim temp As String Try temp="https://" & Regex.Split("/",Regex.Split("://",st)(1))(0) & "/" & Regex.Split("/",Regex.Split("://",st)(1))(1) Return temp Catch ToastMessageShow("請輸入正確抖音分享鏈接！",False) Return "" End Try Else ToastMessageShow("請輸入正確抖音分享鏈接！",False) Return "" End If End Sub Sub bt_clear_Click txt_url.Text="" End Sub
介面控制項簡單說明
主頁面簡單說明
文本框簡單說明
按鈕簡單說明
源程式碼下載地址：
https://www.lanzous.com/i9ezn5g
好啦！今天源碼分享到這裡結束啦！
有問題可以後台加群細聊哦
