前往小程序，Get更优阅读体验！
立即前往
文档建议反馈控制台
首页
学习
活动
专区
工具
TVP
最新优惠活动
文章/答案/技术大牛
发布
首页
学习
活动
专区
工具
TVP最新优惠活动
返回腾讯云官网
社区首页 >专栏 >#安卓开发# B4A示例20200217：《抖印无踪》

#安卓开发# B4A示例20200217：《抖印无踪》

作者头像
一线编程
发布于 2020-02-26 11:17:49
1.4K0
发布于 2020-02-26 11:17:49
举报
文章被收录于专栏：办公魔盒办公魔盒

这是一款集，权限获取，粘贴板应用，菜单应用，网页跳转，文件下载，创建目录，json解析，网页请求，控件简单使用 ，于一体的教程示例！

应用下载地址：
代码语言：javascript
复制
https://www.lanzous.com/i9f0vza
添加权限

项目-->Manifest编辑器

使用的类库
代码语言：javascript
复制
BClipboard  粘贴板操作类库（第三方）

HttpUtils2  网页请求类库（系统自带）

JSON        JSON解析类库（系统自带）

phone       手机系统类库（系统自带）

RSAsyncDownloader       文件瞎下载类库（第三方）

RuntimePermissions      权限请求类库（系统自带）
代码分步解释
  • 应用基本设置
代码语言：javascript
复制
#Region  Project Attributes
	#ApplicationLabel: 抖印无踪                     -->应用名称
	#VersionCode: 1                                 -->版本号
	#VersionName:                                   -->版本名称
	#SupportedOrientations: unspecified             -->屏幕状态，横屏，竖屏
	#CanInstallToExternalStorage: False             -->是否使用外部储存
#End Region

#Region  Activity Attributes
	#FullScreen: False                              -->是否使用全屏
	#IncludeTitle: True                             -->是否显示标题栏
#End Region
  • 变量说明
代码语言：javascript
复制
''全局变量定义
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.启动事件
代码语言：javascript
复制
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.菜单事件

代码语言：javascript
复制
'访问博客
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.按钮点击事件

代码语言：javascript
复制
''视频播放
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.方法函数

代码语言：javascript
复制
''解析地址
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

全部代码

代码语言：javascript
复制
#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
界面控件简单说明

主页面简单说明

文本框简单说明

按钮简单说明

源代码下载地址：
代码语言：javascript
复制
https://www.lanzous.com/i9ezn5g

好啦！今天源码分享到这里结束啦！

有问题可以后台加群细聊哦

本文参与 腾讯云自媒体分享计划，分享自微信公众号。
原始发表：2020-02-17，如有侵权请联系 cloudcommunity@tencent.com 删除
编程算法

本文分享自 办公魔盒 微信公众号，前往查看

如有侵权，请联系 cloudcommunity@tencent.com 删除。

本文参与 腾讯云自媒体分享计划  ，欢迎热爱写作的你一起参与！

编程算法
评论
登录后参与评论
0 条评论
热度
最新
登录 后参与评论
推荐阅读
LV.
文章
0
获赞
0
目录
  • 应用下载地址：
  • 添加权限
  • 使用的类库
  • 代码分步解释
  • 全部代码
    • 界面控件简单说明
      • 源代码下载地址：
      领券

      腾讯云开发者

      扫码关注腾讯云开发者

      扫码关注腾讯云开发者

      领取腾讯云代金券

      热门产品

      热门推荐

      更多推荐

      Copyright © 2013 - 2024 Tencent Cloud. All Rights Reserved. 腾讯云 版权所有 

      深圳市腾讯计算机系统有限公司 ICP备案/许可证号：粤B2-20090059 深公网安备号 44030502008569

      腾讯云计算（北京）有限责任公司 京ICP证150476号 |  京ICP备11018762号 | 京公网安备号11010802020287

      问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档

      Copyright © 2013 - 2024 Tencent Cloud.

      All Rights Reserved. 腾讯云 版权所有

      登录 后参与评论