专栏首页VB小源码#安卓开发# B4A示例20200217:《抖印无踪》

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

这是一款集,权限获取,粘贴板应用,菜单应用,网页跳转,文件下载,创建目录,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


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

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

本文分享自微信公众号 - VB小源码(vb_xym),作者:VB小源码

原文出处及转载信息见文内详细说明,如有侵权,请联系 yunjia_community@tencent.com 删除。

原始发表时间:2020-02-17

本文参与腾讯云自媒体分享计划,欢迎正在阅读的你也加入,一起分享。

我来说两句

0 条评论
登录 后参与评论

相关文章

  • 用VB.NET 撸一个登录界面(开箱即食)

    界面均使用panel、Label、textbox、pictruebox 拼凑而成!

    巴西_prince
  • VB6 PDF批量打印,方便快速

    Private Declare Function ShellExecuteEx Lib "shell32.dll" Alias "ShellExecuteExA...

    巴西_prince
  • B4A 手机客户端源码

    Sub Process_Globals Dim Socket1 As Socket Dim AStreams As AsyncStreams

    巴西_prince
  • 用VB.NET 撸一个登录界面(开箱即食)

    界面均使用panel、Label、textbox、pictruebox 拼凑而成!

    巴西_prince
  • VB6 PDF批量打印,方便快速

    Private Declare Function ShellExecuteEx Lib "shell32.dll" Alias "ShellExecuteExA...

    巴西_prince
  • Basic4android(B4A)设置主题样式

    巴西_prince
  • 看我如何骚操作“破解”*查查的sign和天*查的Authorization!!!

    1.Python(2或者3) 2.App爬虫神器mitmproxy 3.按键精灵 4.还有之前的强制抓包工具postern

    吾爱小白
  • itchat库初探--微信好友全头像的拼接

    如果安装python的时候pip安装选项没打√ ,就先安装pip。 Python和pip的安装

    意气相许的许
  • 小程序web-view关闭后,页面音频没有关闭

    在web-view的src中,引入了一个HTML5页面,这个页面有个自动播放的音频。 在小程序中,点击右上角关闭小程序后,web-view页面中的音频依然会播放...

    siberiawolf
  • [自定义服务器控件] 第二步:下拉列表框。

    前面发了一个文本框的,这回发一个下拉列表框。 一般在写自定义控件之前都要考虑一下原来的控件(系统代的)有什么优缺点,有哪些功能是我想要的,但是自带的控件没有提...

    用户1174620

扫码关注云+社区

领取腾讯云代金券