B4A VB扫码数据提取V1.0 程序包含扫码,TXT文件保存,TXT文件分享,文件批量删除,时间操作,发票数据等技巧

#Region  Project Attributes 
  #ApplicationLabel: 扫码提取数据
  #VersionCode: 1
  #VersionName: VB小源码
  'SupportedOrientations possible values: unspecified, landscape or portrait.
  #SupportedOrientations: unspecified
  #CanInstallToExternalStorage: False
#End Region

#Region  Activity Attributes 
  #FullScreen: False
  #IncludeTitle: True
#End Region

Sub Process_Globals
  Dim RP As RuntimePermissions
  Dim flname As String
End Sub

Sub Globals
  Private ZX As JhsIceZxing1
  ''------------------------
  Private BT_SAVE As Button
  Private LV_RES As ListView
  Private BT_QR As Button
  ''------------------------
  Private BT_SEND As Button
  Private BT_DEL As Button
  ''***************
  Private path As String
  Private sharepath As String
  Private BT_DELLIST As Button
  Private TXT_NAME As EditText
  Private BT_RFFLNAME As Button
End Sub

Sub Activity_Create(FirstTime As Boolean)
  Try
      Activity.LoadLayout("TXT")
      ''***********************
      DateTime.DateFormat="yyyyMMddHHmmss"
      TXT_NAME.Text=DateTime.Date(DateTime.Now)
      flname=TXT_NAME.Text & ".txt"
      ''************************
      Activity.AddMenuItem("关于", "OpenFile")
      ''************************
      RP.CheckAndRequest(RP.PERMISSION_WRITE_EXTERNAL_STORAGE)
      RP.CheckAndRequest(RP.PERMISSION_CAMERA)
      ''************************
      path=File.DirDefaultExternal
      sharepath=File.DirDefaultExternal & "/shared"
      ''************************
      LV_RES.FastScrollEnabled=True
      LV_RES.SingleLineLayout.ItemHeight=35dip
      LV_RES.ScrollingBackgroundColor = Colors.Transparent
      LV_RES.SingleLineLayout.Label.TextSize = 15
      LV_RES.SingleLineLayout.Label.Typeface = Typeface.MONOSPACE
      LV_RES.SingleLineLayout.Label.Typeface = Typeface.DEFAULT_BOLD
      LV_RES.SingleLineLayout.Label.TextColor = Colors.Red
      LV_RES.SingleLineLayout.Label.Gravity = Gravity.LEFT
  Catch
    ToastMessageShow("软件运行出错啦^_^",True)
  End Try
End Sub

#Region "关于"
Sub OpenFile_Click
  Msgbox($"本程序由<巴西_prince>编写;更多精彩内容请关注,微信公众号:VB小源码""$$,"关于")
End Sub
#End Region

Sub Activity_Resume

End Sub

Sub Activity_Pause (UserClosed As Boolean)

End Sub


Sub BT_SAVE_Click
  Try
    If LV_RES.Size <> 0 Then
      Dim LIS As List,i As Int
      LIS.Initialize
      For i=0 To LV_RES.Size-1
        LIS.Add(LV_RES.GetItem(i))
      Next
      File.WriteList(path, flname, LIS)
      ToastMessageShow("数据保存成功!",True)
    Else
      ToastMessageShow("没有要保存数据!",True)
    End If 
  Catch
    ToastMessageShow("数据保存失败!",True)
  End Try

'  Dim str As String ="卡佛的恐反恐"& CRLF & "kf0kpgohlg"
'  Dim writer As TextWriter
'  writer.Initialize(File.OpenOutput(File.DirDefaultExternal,"data.txt",True))
'  writer.WriteLine(str)
'  writer.Close

End Sub

#Region "权限处理"

Sub Activity_PermissionResult (Permission As String, Result As Boolean)
  Try
    If Permission=RP.PERMISSION_WRITE_EXTERNAL_STORAGE Then
      If Result=False Then
        Msgbox("储存权限获取失败!,软件即将退出","警告")
        ExitApplication
      End If
    Else If Permission=RP.PERMISSION_CAMERA Then
      If Result=False Then
        Msgbox("相机权限获取失败!,软件即将退出","警告")
        ExitApplication
      End If
    End If
  Catch
    Log(LastException)
  End Try

End Sub

#End Region

#Region "扫码按钮事件"

Sub BT_QR_Click
  Try
    ''****************
    ZX.isportrait = True
    ZX.useFrontCam = False
    ZX.timeoutDuration = 30
    ZX.theViewFinderXfactor = 0.9
    ZX.theViewFinderYfactor = 0.5
    ZX.theFrameColor = Colors.Green
    ZX.theLaserColor = Colors.Green
    ZX.theMaskColor = Colors.argb(95, 0, 0, 0)
    ZX.theResultColor = Colors.Green
    ZX.theResultPointColor = Colors.Red
    ZX.theBottomPromptMessage = "将二维码/条形码放入框内,即可自动扫描"
    ZX.theBottomPromptTextSize = 2%y
    ZX.bottomPromptColor = Colors.LightGray
    ZX.bottomPromptDistanceFromBottom = 23%y
    ZX.BeginScan("mzx")
  Catch
    ToastMessageShow("扫码异常!",True)
  End Try
End Sub

Sub mzx_result(atype As String,Value As String, image As Bitmap)
  Try
    If Value<>"" Then LV_RES.AddSingleLine(Value)
  Catch
    Log(LastException)
  End Try
End Sub

Sub mzx_timedout(timedOut As Boolean)
  Try
    Log(timedOut)
  Catch
    Log(LastException)
  End Try
End Sub

Sub mzx_usercancelled(userCancelled As Boolean)
  Try
    If userCancelled=True Then ToastMessageShow("用户已取消扫码",False)
  Catch
    Log(LastException)
  End Try
End Sub

#End Region

#Region "文件分享"

Sub BT_SEND_Click
  Dim FileToSend As String =flname
  If File.Exists(path,FileToSend)=True Then
    File.Copy(path, FileToSend, Starter.shared, FileToSend)
    Dim in As Intent
    in.Initialize(in.ACTION_SEND, "")
    in.SetType("*/*")
    Dim uri As Object
    uri = CreateFileProviderUri(Starter.shared, FileToSend)
    in.PutExtra("android.intent.extra.STREAM", uri)
    in.WrapAsIntentChooser("请选择要分享到的程序")
    StartActivity(in)
  Else
    ToastMessageShow("没找到文件!",True)
  End If
End Sub


Sub CreateFileProviderUri (Dir As String, FileName As String) As Object
  Try
    Dim FileProvider As JavaObject
    Dim context As JavaObject
    context.InitializeContext
    FileProvider.InitializeStatic("android.support.v4.content.FileProvider")
    Dim f As JavaObject
    f.InitializeNewInstance("java.io.File", Array(Dir, FileName))
    Return FileProvider.RunMethod("getUriForFile", Array(context, Application.PackageName & ".provider", f))
  Catch
    Return path
    ToastMessageShow("路径转换时发生错误!",True)
  End Try
End Sub

#End Region

#Region "清空文件"

Sub BT_DEL_Click
  Try
    Dim result As Int
    result = Msgbox2("你确定要清空所有历史文件吗?", "清空文件", "确定", "", "取消", LoadBitmap(File.DirAssets, "logo.png"))
    If result = DialogResponse.Positive Then
      Dim ls As List,lt As List
      ls.Initialize
      lt.Initialize
      ls=File.ListFiles(path)
      lt=File.ListFiles(sharepath)
      For Each xl In ls
        If File.Exists(path,xl)  Then
          File.Delete(path,xl)
        End If
      Next
      For Each l In lt
        If File.Exists(sharepath,l)  Then
          File.Delete(sharepath,l)
        End If
      Next
      ToastMessageShow("已清空所有文件!",True)
    End If
  Catch
    ToastMessageShow("删除文件时发生错误啦!",True)
  End Try

End Sub

#End Region

#Region "清空列表"
Sub BT_DELLIST_Click
  Try
    If LV_RES.Size <> 0 Then
      Dim result As Int
      result = Msgbox2("你确定要清空列表中的数据吗?", "清空列表", "确定", "", "取消", LoadBitmap(File.DirAssets,"Info.png"))
      If result = DialogResponse.Positive Then 
        LV_RES.Clear
      End If
    Else
      ToastMessageShow("列表为空!",False)
    End If 
  Catch
    Log(LastException)
  End Try
  
End Sub

#End Region

#Region "更改文件名"
Sub BT_RFFLNAME_Click
  Try
    Dim result As Int
    result = Msgbox2("你确定要修改当前保存的文件名吗?", "文件名修改", "确定", "", "取消", LoadBitmap(File.DirAssets, "logo.png"))
    If result = DialogResponse.Positive Then 
      DateTime.DateFormat="yyyyMMddHHmmss"
      TXT_NAME.Text=DateTime.Date(DateTime.Now)
      flname=TXT_NAME.Text  & ".txt"
    End If
  Catch
    ToastMessageShow("文件名刷新失败!",True)
  End Try

End Sub

#End Region

#Region  Service Attributes 
  #StartAtBoot: False
  #ExcludeFromLibrary: True
#End Region

Sub Process_Globals

  Public rp As RuntimePermissions
  Public shared As String
End Sub

Sub Service_Create
  shared = rp.GetSafeDirDefaultExternal("shared")
End Sub

Sub Service_Start (StartingIntent As Intent)
  Service.StopAutomaticForeground 

End Sub

Sub Service_TaskRemoved
  
End Sub


Sub Application_Error (Error As Exception, StackTrace As String) As Boolean
  Return True
End Sub

Sub Service_Destroy

End Sub

AddManifestText(
<uses-sdk android:minSdkVersion="5" android:targetSdkVersion="26"/>
<supports-screens android:largeScreens="true" 
    android:normalScreens="true" 
    android:smallScreens="true" 
    android:anyDensity="true"/>)
SetApplicationAttribute(android:icon, "@drawable/icon")
SetApplicationAttribute(android:label, "$LABEL$")
CreateResourceFromFile(Macro, Themes.DarkTheme)

'扫码权限
  AddPermission(android.permission.CAMERA)
  AddPermission(android.permission.WRITE_EXTERNAL_STORAGE)
  AddPermission(android.hardware.camera)
  AddPermission(android.hardware.camera.autofocus)
  AddPermission(android.permission.VIBRATE)
  AddPermission(android.permission.FLASHLIGHT)
 
 
  '扫码布局
  AddApplicationText(<activity android:name="ice.zxing.CaptureActivity"
      android:screenOrientation="portrait" android:configChanges="orientation|keyboardHidden"
      android:theme="@android:style/Theme.NoTitleBar.Fullscreen"
      android:windowSoftInputMode="stateAlwaysHidden">
    </activity>)
    
    
''********************
''文件地址转换

AddManifestText(<uses-permission
  android:name="android.permission.WRITE_EXTERNAL_STORAGE"
  android:maxSdkVersion="18" />
)

AddApplicationText(
  <provider
  android:name="android.support.v4.content.FileProvider"
  android:authorities="$PACKAGE$.provider"
  android:exported="false"
  android:grantUriPermissions="true">
  <meta-data
  android:name="android.support.FILE_PROVIDER_PATHS"
  android:resource="@xml/provider_paths"/>
  </provider>
)
CreateResource(xml, provider_paths,
   <external-files-path name="name" path="shared" />
)

  版本1: https://www.lanzous.com/i585fpi

 版本2: https://www.lanzous.com/i588i3c