#安卓开发# 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
好啦！今天源码分享到这里结束啦！
有问题可以后台加群细聊哦
