Commit inicial

This commit is contained in:
2024-03-23 13:07:32 -06:00
parent fd9e92da09
commit 79d74e2fdb
43 changed files with 6912 additions and 0 deletions

2
.gitignore vendored Normal file
View File

@@ -0,0 +1,2 @@
**/Objects
**/AutoBackups

223
B4A/B4x_Transition.bas Normal file
View File

@@ -0,0 +1,223 @@
B4A=true
Group=Default Group
ModulesStructureVersion=1
Type=StaticCode
Version=11
@EndOfDesignText@
'Code module
Sub Process_Globals
End Sub
Public Sub PrepareTransition_RadiusOut (Xui As XUI, RootWidth As Float, RootHeight As Float, CurrentPageRoot As B4XView, NewPageRoot As B4XView) As ResumableSub
Dim pnl As B4XView = Xui.CreatePanel("")
NewPageRoot.AddView(pnl, 0, 0, RootWidth, RootHeight)
pnl.As(Panel).Elevation = 10dip
Dim cnv As B4XCanvas
cnv.Initialize(pnl)
Dim frontBmp As B4XBitmap = CurrentPageRoot.Snapshot
Dim backBmp As B4XBitmap = NewPageRoot.Snapshot
cnv.ClearRect(cnv.TargetRect)
Dim frames As Int = 20
Dim stepWidth As Float = RootWidth/frames
For i = 0 To frames-1
cnv.DrawBitmap(frontBmp,getRect(0,0,RootWidth,RootHeight))
Dim path As B4XPath
path.InitializeOval(getRect((RootWidth/2)-(stepWidth*i),(RootHeight/2)-(stepWidth*i),(stepWidth*2)*i,(stepWidth*2)*i))
cnv.ClipPath(path)
cnv.DrawBitmap(backBmp,getRect(0,0,RootWidth,RootHeight))
cnv.RemoveClip
cnv.Invalidate
Sleep(16)
Next
pnl.RemoveViewFromParent
Return True
End Sub
Public Sub PrepareTransition_RadiusIn (Xui As XUI, RootWidth As Float, RootHeight As Float, CurrentPageRoot As B4XView, NewPageRoot As B4XView) As ResumableSub
Dim pnl As B4XView = Xui.CreatePanel("")
NewPageRoot.AddView(pnl, 0, 0, RootWidth, RootHeight)
pnl.As(Panel).Elevation = 10dip
Dim cnv As B4XCanvas
cnv.Initialize(pnl)
Dim frontBmp As B4XBitmap = CurrentPageRoot.Snapshot
Dim backBmp As B4XBitmap = NewPageRoot.Snapshot
Dim startingSize As Float = IIf(RootHeight>RootWidth,RootHeight,RootWidth)
cnv.ClearRect(cnv.TargetRect)
Dim frames As Int = 22
Dim stepSize As Float = startingSize/frames
For i = 0 To frames-1
cnv.DrawBitmap(backBmp,getRect(0,0,RootWidth,RootHeight))
Dim path As B4XPath
path.InitializeOval(getRect((RootWidth/2)-(startingSize)+(stepSize*i),(RootHeight/2)-(startingSize)+(stepSize*i),(startingSize*2)-((stepSize*2)*i) , (startingSize*2)-((stepSize*2)*i)))
cnv.ClipPath(path)
cnv.DrawBitmap(frontBmp,getRect(0,0,RootWidth,RootHeight))
cnv.RemoveClip
cnv.Invalidate
Sleep(16)
Next
pnl.RemoveViewFromParent
Return True
End Sub
Public Sub PrepareTransition_OpenDoor (Xui As XUI, RootWidth As Float, RootHeight As Float, CurrentPageRoot As B4XView, NewPageRoot As B4XView) As ResumableSub
Dim pnl As B4XView = Xui.CreatePanel("")
NewPageRoot.AddView(pnl, 0, 0, RootWidth, RootHeight)
pnl.As(Panel).Elevation = 10dip
Dim cnv As B4XCanvas
cnv.Initialize(pnl)
Dim leftDoor As B4XBitmap = CurrentPageRoot.Snapshot.Crop(0,0,RootWidth/2, RootHeight)
Dim rightDoor As B4XBitmap = CurrentPageRoot.Snapshot.Crop(RootWidth/2,0,RootWidth/2, RootHeight)
Dim backBmp As B4XBitmap = NewPageRoot.Snapshot
cnv.ClearRect(cnv.TargetRect)
Dim frames As Int = 14
Dim stepWidth As Float = (RootWidth/2)/frames
For i = 0 To frames-1
cnv.DrawBitmap(backBmp,getRect(0,0,RootWidth,RootHeight))
cnv.DrawBitmap(leftDoor,getRect(-(i*stepWidth),0,RootWidth/2,RootHeight))
cnv.DrawBitmap(rightDoor,getRect((RootWidth/2)+(i*stepWidth),0,RootWidth/2,RootHeight))
cnv.Invalidate
Sleep(16)
Next
pnl.RemoveViewFromParent
Return True
End Sub
Public Sub PrepareTransition_CloseDoor (Xui As XUI, RootWidth As Float, RootHeight As Float, CurrentPageRoot As B4XView, NewPageRoot As B4XView) As ResumableSub
Dim pnl As B4XView = Xui.CreatePanel("")
NewPageRoot.AddView(pnl, 0, 0, RootWidth, RootHeight)
pnl.As(Panel).Elevation = 10dip
Dim cnv As B4XCanvas
cnv.Initialize(pnl)
Dim leftDoor As B4XBitmap = NewPageRoot.Snapshot.Crop(0,0,RootWidth/2, RootHeight)
Dim rightDoor As B4XBitmap = NewPageRoot.Snapshot.Crop(RootWidth/2,0,RootWidth/2, RootHeight)
Dim backBmp As B4XBitmap = CurrentPageRoot.Snapshot
cnv.ClearRect(cnv.TargetRect)
Dim frames As Int = 14
Dim stepWidth As Float = (RootWidth/2)/frames
For i = 0 To frames-1
cnv.DrawBitmap(backBmp,getRect(0,0,RootWidth,RootHeight))
cnv.DrawBitmap(leftDoor,getRect(-(RootWidth/2)+(i*stepWidth),0,RootWidth/2,RootHeight))
cnv.DrawBitmap(rightDoor,getRect(RootWidth-(i*stepWidth),0,RootWidth/2,RootHeight))
cnv.Invalidate
Sleep(16)
Next
pnl.RemoveViewFromParent
Return True
End Sub
Public Sub PrepareTransition_FadeOut (Xui As XUI, RootWidth As Float, RootHeight As Float, CurrentPageRoot As B4XView, NewPageRoot As B4XView) As ResumableSub
Dim pnl As B4XView = Xui.CreatePanel("")
NewPageRoot.AddView(pnl, 0, 0, RootWidth, RootHeight)
pnl.As(Panel).Elevation = 10dip
Dim cnv As B4XCanvas
cnv.Initialize(pnl)
Dim backBmp As B4XBitmap = CurrentPageRoot.Snapshot
cnv.ClearRect(cnv.TargetRect)
cnv.DrawBitmap(backBmp,getRect(0,0,RootWidth,RootHeight))
cnv.Invalidate
pnl.Visible = True
pnl.SetVisibleAnimated(600,False)
Sleep(600)
pnl.RemoveViewFromParent
Return True
End Sub
'Direction, choose between "LEFT" "TOP" "RIGHT" "BOTTOM"
Public Sub PrepareTransition_SlideOut (Xui As XUI, RootWidth As Float, RootHeight As Float, CurrentPageRoot As B4XView, NewPageRoot As B4XView, Direction As String) As ResumableSub
Dim pnl As B4XView = Xui.CreatePanel("")
NewPageRoot.AddView(pnl, 0, 0, RootWidth, RootHeight)
pnl.As(Panel).Elevation = 10dip
Dim cnv As B4XCanvas
cnv.Initialize(pnl)
Dim backBmp As B4XBitmap = CurrentPageRoot.Snapshot
cnv.ClearRect(cnv.TargetRect)
cnv.DrawBitmap(backBmp,getRect(0,0,RootWidth,RootHeight))
cnv.Invalidate
Select Direction.ToUpperCase
Case "LEFT"
pnl.SetLayoutAnimated(400,-pnl.Width,pnl.Top,pnl.Width,pnl.Height)
Case "TOP"
pnl.SetLayoutAnimated(400,pnl.left,-pnl.Height,pnl.Width,pnl.Height)
Case "BOTTOM"
pnl.SetLayoutAnimated(400,pnl.left,pnl.Height,pnl.Width,pnl.Height)
Case "RIGHT"
pnl.SetLayoutAnimated(400,pnl.Width,pnl.Top,pnl.Width,pnl.Height)
Case Else
pnl.SetLayoutAnimated(400,-pnl.Width,pnl.Top,pnl.Width,pnl.Height)
End Select
Sleep(400)
pnl.RemoveViewFromParent
Return True
End Sub
Public Sub PrepareTransition_SpiralOut (Xui As XUI, RootWidth As Float, RootHeight As Float, CurrentPageRoot As B4XView, NewPageRoot As B4XView) As ResumableSub
Dim pnl As B4XView = Xui.CreatePanel("")
NewPageRoot.AddView(pnl, 0, 0, RootWidth, RootHeight)
pnl.As(Panel).Elevation = 10dip
Dim cnv As B4XCanvas
cnv.Initialize(pnl)
Dim frontBmp As B4XBitmap = CurrentPageRoot.Snapshot
Dim backBmp As B4XBitmap = NewPageRoot.Snapshot
cnv.ClearRect(cnv.TargetRect)
Dim frames As Int = 35
Dim stepSizeY As Float = RootHeight/frames
Dim stepSizeX As Float = RootWidth/frames
Dim deg As Int = 0
For i = 0 To frames-1
cnv.DrawBitmap(backBmp,getRect(0,0,RootWidth,RootHeight))
deg = deg + 30
cnv.DrawBitmapRotated(frontBmp,getRect((RootWidth/2)-(RootWidth/2)+(stepSizeX*i),(RootHeight/2)-(RootHeight/2)+(stepSizeY*i),(RootWidth)-((stepSizeX*2)*i) , (RootHeight)-((stepSizeY*2)*i)),deg)
cnv.Invalidate
Sleep(16)
Next
pnl.RemoveViewFromParent
Return True
End Sub
Public Sub PrepareTransition_BurnOut (Xui As XUI, RootWidth As Float, RootHeight As Float, CurrentPageRoot As B4XView, NewPageRoot As B4XView) As ResumableSub
Dim pnl As B4XView = Xui.CreatePanel("")
NewPageRoot.AddView(pnl, 0, 0, RootWidth, RootHeight)
pnl.As(Panel).Elevation = 10dip
Dim spritelist As List
spritelist.Initialize
Dim fireSprite As B4XBitmap = Xui.LoadBitmap(File.DirAssets,"fire2.png")
Dim spWidth, spHeight As Float
spWidth = fireSprite.Width/4
spHeight = fireSprite.Height/4
For y = 0 To 3
For x = 0 To 3
spritelist.Add(fireSprite.Crop(x*spWidth,y*spHeight,spWidth,spHeight))
Next
Next
Dim cnv As B4XCanvas
cnv.Initialize(pnl)
Dim frontBmp As B4XBitmap = CurrentPageRoot.Snapshot
Dim backBmp As B4XBitmap = NewPageRoot.Snapshot
cnv.ClearRect(cnv.TargetRect)
Dim frames As Int = 36
Dim stepSize As Float = RootHeight/frames
Dim flameframe As Int = 0
For i = 0 To frames-1
cnv.DrawBitmap(backBmp,getRect(0,0,RootWidth,RootHeight))
Dim path As B4XPath
path.InitializeRoundedRect(getRect(0,0,RootWidth,RootHeight-(i*stepSize)),0)
cnv.ClipPath(path)
cnv.DrawBitmap(frontBmp,getRect(0,0,RootWidth,RootHeight))
cnv.RemoveClip
Dim flame As B4XBitmap = spritelist.Get(flameframe)
cnv.DrawBitmap(flame,getRect(-(pnl.Width*0.2),RootHeight-(pnl.Height*0.35)-(i*stepSize),pnl.Width*1.4,pnl.Height*0.45))
cnv.Invalidate
Sleep(16)
If i Mod 2 = 0 Then _
flameframe = (flameframe+1) Mod spritelist.Size
Next
pnl.RemoveViewFromParent
Return True
End Sub
Private Sub getRect(x As Float, y As Float, w As Float, h As Float) As B4XRect
Dim r As B4XRect
r.Initialize(x,y,x+w,y+h)
Return r
End Sub

126
B4A/BatteryUtilities.bas Normal file
View File

@@ -0,0 +1,126 @@
B4A=true
Group=Default Group
ModulesStructureVersion=1
Type=Class
Version=10.2
@EndOfDesignText@
'Class module
Sub Class_Globals
Private nativeMe As JavaObject
End Sub
'Initializes the object.
Public Sub Initialize
nativeMe = Me
End Sub
'Return information about the battery status. It returns the following 11 values in an integer Array:
'EXTRA_LEVEL = current battery level, from 0 To EXTRA_SCALE.
'EXTRA_SCALE = the maximum battery level possible.
'EXTRA_HEALTH = the current health constant.
'EXTRA_ICON_SMALL = the resource ID of a small status bar icon indicating the current battery state.
'EXTRA_PLUGGED = whether the device is plugged into a Power source; 0 means it is on battery, other constants are different types of Power sources.
'EXTRA_STATUS = the current status constant.
'EXTRA_TEMPERATURE = the current battery temperature.
'EXTRA_VOLTAGE = the current battery voltage level.
'A value indicating if the battery is being charged or fully charged (If neither it returns 0 Else it returns 1)
'A value indicating if it is charging via USB (0 = Not USB, 2 = USB)
'A value indicating if it is charging via AC (0 = Not AC, 1 = AC)
Public Sub getBatteryInformation () As Int()
Dim batteryInfo(11) As Int
batteryInfo = nativeMe.RunMethod("getBatteryInformation",Null)
Return batteryInfo
End Sub
Public Sub getBatteryTechnolgy() As String
Dim batterytech As String
batterytech = nativeMe.RunMethod("getBatteryTechnology",Null)
Return batterytech
End Sub
#If Java
import android.os.BatteryManager;
import android.os.Bundle;
import android.app.Activity;
import android.content.BroadcastReceiver;
import android.content.Context;
import android.content.Intent;
import android.content.IntentFilter;
public int[] getBatteryInformation() {
int[] mybat = new int[11];
Intent batteryIntent = ba.context.getApplicationContext().registerReceiver(null, new IntentFilter(Intent.ACTION_BATTERY_CHANGED));
int level = batteryIntent.getIntExtra(BatteryManager.EXTRA_LEVEL, -1);
mybat[0] = level;
int scale = batteryIntent.getIntExtra(BatteryManager.EXTRA_SCALE, -1);
mybat[1] = scale;
int health = batteryIntent.getIntExtra(BatteryManager.EXTRA_HEALTH,-1);
mybat[2] = health;
int icon_small = batteryIntent.getIntExtra(BatteryManager.EXTRA_ICON_SMALL,-1);
mybat[3] = icon_small;
int plugged = batteryIntent.getIntExtra(BatteryManager.EXTRA_PLUGGED,-1);
mybat[4] = plugged;
// boolean present = batteryIntent.getExtras().getBoolean(BatteryManager.EXTRA_PRESENT);
int status = batteryIntent.getIntExtra(BatteryManager.EXTRA_STATUS,-1);
mybat[5] = status;
// String technology = batteryIntent.getExtras().getString(BatteryManager.EXTRA_TECHNOLOGY);
// BA.Log("Technology = " + technology);
int temperature = batteryIntent.getIntExtra(BatteryManager.EXTRA_TEMPERATURE,-1);
mybat[6] = temperature;
int voltage = batteryIntent.getIntExtra(BatteryManager.EXTRA_VOLTAGE,-1);
mybat[7] = voltage;
// int ac = batteryIntent.getIntExtra("plugged",BatteryManager.BATTERY_PLUGGED_AC);
// mybat[8] = ac;
// int usb = batteryIntent.getIntExtra("plugged",BatteryManager.BATTERY_PLUGGED_USB);
// mybat[9] = usb;
boolean isCharging = status == BatteryManager.BATTERY_STATUS_CHARGING ||
status == BatteryManager.BATTERY_STATUS_FULL;
mybat[8] = 0;
if (isCharging == true) {
mybat[8] = 1;
}
// How are we charging?
mybat[9] = 0;
mybat[10] = 0;
int chargePlug = batteryIntent.getIntExtra(BatteryManager.EXTRA_PLUGGED, -1);
boolean usbCharge = chargePlug == BatteryManager.BATTERY_PLUGGED_USB;
if (usbCharge == true) {
mybat[9] = 2;
}
boolean acCharge = chargePlug == BatteryManager.BATTERY_PLUGGED_AC;
if (acCharge == true) {
mybat[10] = 1;
}
return mybat;
}
public String getBatteryTechnology() {
Intent batteryIntent = ba.context.getApplicationContext().registerReceiver(null, new IntentFilter(Intent.ACTION_BATTERY_CHANGED));
String technology = batteryIntent.getExtras().getString(BatteryManager.EXTRA_TECHNOLOGY);
return technology;
}
#End If

74
B4A/C_UpdateAvailable.bas Normal file
View File

@@ -0,0 +1,74 @@
B4A=true
Group=Default Group
ModulesStructureVersion=1
Type=Class
Version=12.2
@EndOfDesignText@
Sub Class_Globals
Private Root As B4XView 'ignore
Private xui As XUI 'ignore
End Sub
'You can add more parameters here.
Public Sub Initialize As Object
Return Me
End Sub
'This event will be called once, before the page becomes visible.
Private Sub B4XPage_Created (Root1 As B4XView)
Root = Root1
'load the layout to Root
Root.Color = Colors.Transparent
End Sub
Sub B4XPage_Appear
Try
Do While Not(CanRequestPackageInstalls)
MsgboxAsync($"Por favor permita que ${Application.PackageName} instale actualizaciones"$, "Instalar actualización")
Wait For Msgbox_Result(Result As Int)
Dim in As Intent
in.Initialize("android.settings.", "package:" & Application.PackageName)
StartActivity(in)
Loop
Catch
Log("updateAvailable() Error - " & LastException.Message)
End Try
If appUpdater.newApp.update Then
ofreceActualizacion
Else
sinActualizacion
End If
End Sub
'////////////////////////////////////////////////////////////////////////////////////////////
'//// Esta es una actividad usada por el servicio appUpdater para mostrar notificaciones
'//// cuando hay alguna actualizacion de apk.
'////////////////////////////////////////////////////////////////////////////////////////////
public Sub CanRequestPackageInstalls As Boolean
' // https://www.b4x.com/android/forum/threads/version-safe-apk-installation.87667/#content
Dim ctxt As JavaObject
ctxt.InitializeContext
Dim PackageManager As JavaObject = ctxt.RunMethod("getPackageManager", Null)
Return PackageManager.RunMethod("canRequestPackageInstalls", Null)
End Sub
Sub ofreceActualizacion
If Msgbox2(appUpdater.newApp.newMsg,"Actualización disponible","Si","","No",Null) = DialogResponse.Positive Then 'ignore
' StartService(DownloadService)
CallSubDelayed(appUpdater, "download_newApk")
' ToastMessageShow("Descargando actualización", True)
End If
B4XPages.MainPage.login.ocultaProgreso
StartActivity(Main)
' Activity.Finish
B4XPages.ShowPage("Login")
End Sub
Sub sinActualizacion
Msgbox(appUpdater.newApp.okMsg, "Aplicación al corriente") 'ignore
' StartActivity(Main)
B4XPages.MainPage.login.ocultaProgreso
B4XPages.ShowPage("Login")
End Sub

1717
B4A/C_principal.bas Normal file

File diff suppressed because it is too large Load Diff

1507
B4A/C_supervisor.bas Normal file

File diff suppressed because it is too large Load Diff

403
B4A/CameraExClass.bas Normal file
View File

@@ -0,0 +1,403 @@
B4A=true
Group=Default Group
ModulesStructureVersion=1
Type=Class
Version=7.28
@EndOfDesignText@
'Class module
'version 1.30
'See this page for the list of constants:
'http://developer.android.com/intl/fr/reference/android/hardware/Camera.Parameters.html
'Note that you should use the constant values instead of the names.
Sub Class_Globals
Private nativeCam As Object
Private cam As Camera
Private r As Reflector
Private target As Object
Private event As String
Public Front As Boolean
Private parameters As Object
Public PreviewOrientation As Int
End Sub
Public Sub Initialize (Panel1 As Panel, FrontCamera As Boolean, TargetModule As Object, EventName As String)
target = TargetModule
event = EventName
Front = FrontCamera
Dim id As Int
id = FindCamera(Front).id
If id = -1 Then
Front = Not(Front) 'try different camera
id = FindCamera(Front).id
If id = -1 Then
ToastMessageShow("No camera found.", True)
Return
End If
End If
cam.Initialize2(Panel1, "camera", id)
End Sub
Private Sub FindCamera (frontCamera As Boolean) As CameraInfoAndId
Dim ci As CameraInfoAndId
Dim cameraInfo As Object
Dim cameraValue As Int
Log("findCamera")
If frontCamera Then cameraValue = 1 Else cameraValue = 0
cameraInfo = r.CreateObject("android.hardware.Camera$CameraInfo")
Dim numberOfCameras As Int = r.RunStaticMethod("android.hardware.Camera", "getNumberOfCameras", Null, Null)
Log(r.target)
Log(numberOfCameras)
For i = 0 To numberOfCameras - 1
r.RunStaticMethod("android.hardware.Camera", "getCameraInfo", Array As Object(i, cameraInfo), _
Array As String("java.lang.int", "android.hardware.Camera$CameraInfo"))
r.target = cameraInfo
Log("facing: " & r.GetField("facing") & ", " & cameraValue)
If r.GetField("facing") = cameraValue Then 'ignore
ci.cameraInfo = r.target
ci.Id = i
Return ci
End If
Next
ci.id = -1
Return ci
End Sub
Private Sub SetDisplayOrientation
r.target = r.GetActivity
r.target = r.RunMethod("getWindowManager")
r.target = r.RunMethod("getDefaultDisplay")
r.target = r.RunMethod("getRotation")
Dim result, degrees As Int = r.target * 90
Dim ci As CameraInfoAndId = FindCamera(Front)
r.target = ci.CameraInfo
Dim orientation As Int = r.GetField("orientation")
If Front Then
PreviewOrientation = (orientation + degrees) Mod 360
result = PreviewOrientation
PreviewOrientation = (360 - PreviewOrientation) Mod 360
Else
PreviewOrientation = (orientation - degrees + 360) Mod 360
result = PreviewOrientation
Log("Preview Orientation: " & PreviewOrientation)
End If
r.target = nativeCam
r.RunMethod2("setDisplayOrientation", PreviewOrientation, "java.lang.int")
r.target = parameters
r.RunMethod2("setRotation", result, "java.lang.int")
CommitParameters
End Sub
Private Sub Camera_Ready (Success As Boolean)
If Success Then
r.target = cam
nativeCam = r.GetField("camera")
r.target = nativeCam
parameters = r.RunMethod("getParameters")
SetDisplayOrientation
Else
Log("success = false, " & LastException)
End If
CallSub2(target, event & "_ready", Success)
End Sub
'Uncomment this sub if you need to handle the Preview event
Sub Camera_Preview (Data() As Byte)
If SubExists(target, event & "_preview") Then
CallSub2(target, event & "_preview", Data)
End If
End Sub
Public Sub TakePicture
cam.TakePicture
End Sub
Private Sub Camera_PictureTaken (Data() As Byte)
CallSub2(target, event & "_PictureTaken", Data)
End Sub
Public Sub StartPreview
cam.StartPreview
End Sub
Public Sub StopPreview
cam.StopPreview
End Sub
Public Sub Release
cam.Release
End Sub
'Saves the data received from PictureTaken event
Public Sub SavePictureToFile(Data() As Byte, Dir As String, FileName As String)
Dim out As OutputStream = File.OpenOutput(Dir, FileName, False)
out.WriteBytes(Data, 0, Data.Length)
out.Close
End Sub
Public Sub SetParameter(Key As String, Value As String)
r.target = parameters
r.RunMethod3("set", Key, "java.lang.String", Value, "java.lang.String")
End Sub
Public Sub GetParameter(Key As String) As String
r.target = parameters
Return r.RunMethod2("get", Key, "java.lang.String")
End Sub
Public Sub CommitParameters
'Try
r.target = nativeCam
r.RunMethod4("setParameters", Array As Object(parameters), Array As String("android.hardware.Camera$Parameters"))
'Catch
' ToastMessageShow("Error setting parameters.", True)
' Log(LastException)
' End Try
End Sub
Public Sub GetColorEffect As String
Return GetParameter("effect")
End Sub
Public Sub SetColorEffect(Effect As String)
SetParameter("effect", Effect)
End Sub
Public Sub GetSupportedPreviewSizes As CameraSize()
r.target = parameters
Dim list1 As List = r.RunMethod("getSupportedPreviewSizes")
Dim cs(list1.Size) As CameraSize
For i = 0 To list1.Size - 1
r.target = list1.get(i)
cs(i).Width = r.GetField("width")
cs(i).Height = r.GetField("height")
Next
Return cs
End Sub
Public Sub SetPreviewSize(Width As Int, Height As Int)
r.target = parameters
r.RunMethod3("setPreviewSize", Width, "java.lang.int", Height, "java.lang.int")
End Sub
Public Sub GetSupportedPicturesSizes As CameraSize()
r.target = parameters
Dim list1 As List = r.RunMethod("getSupportedPictureSizes")
Dim cs(list1.Size) As CameraSize
For i = 0 To list1.Size - 1
r.target = list1.get(i)
cs(i).Width = r.GetField("width")
cs(i).Height = r.GetField("height")
Next
Return cs
End Sub
Public Sub SetPictureSize(Width As Int, Height As Int)
r.target = parameters
r.RunMethod3("setPictureSize", Width, "java.lang.int", Height, "java.lang.int")
End Sub
Public Sub SetJpegQuality(Quality As Int)
r.target = parameters
r.RunMethod2("setJpegQuality", Quality, "java.lang.int")
End Sub
Public Sub SetFlashMode(Mode As String)
r.target = parameters
r.RunMethod2("setFlashMode", Mode, "java.lang.String")
End Sub
Public Sub GetFlashMode As String
r.target = parameters
Return r.RunMethod("getFlashMode")
End Sub
Public Sub GetSupportedFlashModes As List
r.target = parameters
Return r.RunMethod("getSupportedFlashModes")
End Sub
Public Sub GetSupportedColorEffects As List
r.target = parameters
Return r.RunMethod("getSupportedColorEffects")
End Sub
'Returns a list with the supported preview fps. Each item in the list is an array of two ints (minimum value and maximum value).
Public Sub GetSupportedPreviewFpsRange As List
r.target = parameters
Return r.RunMethod("getSupportedPreviewFpsRange")
End Sub
'Returns the current preview fps range.
'Range is a two elements array. The minimum value and maximum value will be stored in this array.
Public Sub GetPreviewFpsRange(Range() As Int)
r.target = parameters
r.RunMethod4("getPreviewFpsRange", Array As Object(Range), Array As String("[I"))
End Sub
Public Sub SetPreviewFpsRange(MinValue As Int, MaxValue As Int)
r.target = parameters
r.RunMethod4("setPreviewFpsRange", Array As Object(MinValue, MaxValue), _
Array As String("java.lang.int", "java.lang.int"))
End Sub
Public Sub GetPreviewSize As CameraSize
r.target = parameters
r.target = r.RunMethod("getPreviewSize")
Dim cs As CameraSize
cs.Width = r.GetField("width")
cs.Height = r.GetField("height")
Return cs
End Sub
Public Sub GetPictureSize As CameraSize
r.target = parameters
r.target = r.RunMethod("getPictureSize")
Dim cs As CameraSize
cs.Width = r.GetField("width")
cs.Height = r.GetField("height")
Return cs
End Sub
'Converts a preview image formatted in YUV format to JPEG.
'Note that you should not save every preview image as it will slow down the whole process.
Public Sub PreviewImageToJpeg(data() As Byte, quality As Int) As Byte()
Dim size, previewFormat As Object
r.target = parameters
size = r.RunMethod("getPreviewSize")
previewFormat = r.RunMethod("getPreviewFormat")
r.target = size
Dim width = r.GetField("width"), height = r.GetField("height") As Int
Dim yuvImage As Object = r.CreateObject2("android.graphics.YuvImage", _
Array As Object(data, previewFormat, width, height, Null), _
Array As String("[B", "java.lang.int", "java.lang.int", "java.lang.int", "[I"))
r.target = yuvImage
Dim rect1 As Rect
rect1.Initialize(0, 0, r.RunMethod("getWidth"), r.RunMethod("getHeight"))
Dim out As OutputStream
out.InitializeToBytesArray(100)
r.RunMethod4("compressToJpeg", Array As Object(rect1, quality, out), _
Array As String("android.graphics.Rect", "java.lang.int", "java.io.OutputStream"))
Return out.ToBytesArray
End Sub
Public Sub GetSupportedFocusModes As List
r.target = parameters
Return r.RunMethod("getSupportedFocusModes")
End Sub
Public Sub SetContinuousAutoFocus
Dim modes As List = GetSupportedFocusModes
If modes.IndexOf("continuous-picture") > -1 Then
SetFocusMode("continuous-picture")
Else If modes.IndexOf("continuous-video") > -1 Then
SetFocusMode("continuous-video")
Else
Log("Continuous focus mode is not available")
End If
End Sub
Public Sub SetFocusMode(Mode As String)
r.target = parameters
r.RunMethod2("setFocusMode", Mode, "java.lang.String")
End Sub
Public Sub GetFocusDistances As Float()
Dim F(3) As Float
r.target = parameters
r.RunMethod4("getFocusDistances", Array As Object(F), Array As String("[F"))
Return F
End Sub
Public Sub GetSupportedPictureFormats As List
r.target = parameters
Return r.RunMethod("getSupportedPictureFormats")
End Sub
'This method should only be called if you need to immediately release the camera.
'For example if you need to start another application that depends on the camera.
Public Sub CloseNow
cam.Release
r.target = cam
r.RunMethod2("releaseCameras", True, "java.lang.boolean")
End Sub
'Calls AutoFocus and then takes the picture if focus was successfull.
Public Sub FocusAndTakePicture
cam.AutoFocus
End Sub
Private Sub Camera_FocusDone (Success As Boolean)
If Success Then
Sleep(100)
TakePicture
Else
Log("AutoFocus error.")
End If
End Sub
Public Sub IsZoomSupported As Boolean
r.target = parameters
Return r.RunMethod("isZoomSupported")
End Sub
Public Sub GetMaxZoom As Int
r.target = parameters
Return r.RunMethod("getMaxZoom")
End Sub
Public Sub getZoom() As Int
r.target = parameters
Return r.RunMethod("getZoom")
End Sub
Public Sub setZoom(ZoomValue As Int)
r.target = parameters
r.RunMethod2("setZoom", ZoomValue, "java.lang.int")
End Sub
Public Sub getExposureCompensation As Int
r.target = parameters
Return r.RunMethod("getExposureCompensation")
End Sub
Public Sub setExposureCompensation(v As Int)
r.target = parameters
r.RunMethod2("setExposureCompensation", v, "java.lang.int")
End Sub
Public Sub getMinExposureCompensation As Int
r.target = parameters
Return r.RunMethod("getMinExposureCompensation")
End Sub
Public Sub getMaxExposureCompensation As Int
r.target = parameters
Return r.RunMethod("getMaxExposureCompensation")
End Sub
Public Sub SetFaceDetectionListener
Dim jo As JavaObject = nativeCam
Dim e As Object = jo.CreateEvent("android.hardware.Camera.FaceDetectionListener", "FaceDetection", Null)
jo.RunMethod("setFaceDetectionListener", Array(e))
End Sub
Private Sub FaceDetection_Event (MethodName As String, Args() As Object) As Object
Dim faces() As Object = Args(0)
For Each f As Object In faces
Dim jo As JavaObject = f
Dim faceRect As Rect = jo.GetField("rect") 'ignore
Next
Return Null
End Sub
Public Sub StartFaceDetection
Dim jo As JavaObject = nativeCam
jo.RunMethod("startFaceDetection", Null)
End Sub
Public Sub StopFaceDetection
Dim jo As JavaObject = nativeCam
jo.RunMethod("stopFaceDetection", Null)
End Sub

398
B4A/CameraExClass2.bas Normal file
View File

@@ -0,0 +1,398 @@
B4A=true
Group=Default Group
ModulesStructureVersion=1
Type=Class
Version=6
@EndOfDesignText@
'Class module
'version 1.30
'See this page for the list of constants:
'http://developer.android.com/intl/fr/reference/android/hardware/Camera.Parameters.html
'Note that you should use the constant values instead of the names.
Sub Class_Globals
Private nativeCam As Object
Private cam As Camera
Private r As Reflector
Private target As Object
Private event As String
Public Front As Boolean
Private parameters As Object
End Sub
Public Sub Initialize (Panel1 As Panel, FrontCamera As Boolean, TargetModule As Object, EventName As String)
target = TargetModule
event = EventName
Front = FrontCamera
Dim id As Int
id = FindCamera(Front).id
If id = -1 Then
Front = Not(Front) 'try different camera
id = FindCamera(Front).id
If id = -1 Then
ToastMessageShow("No camera found.", True)
Return
End If
End If
cam.Initialize2(Panel1, "camera", id)
End Sub
Private Sub FindCamera (frontCamera As Boolean) As CameraInfoAndId
Dim cI As CameraInfoAndId
Dim cameraInfo As Object
Dim cameraValue As Int
Log("findCamera")
If frontCamera Then cameraValue = 1 Else cameraValue = 0
cameraInfo = r.CreateObject("android.hardware.Camera$CameraInfo")
Dim numberOfCameras As Int = r.RunStaticMethod("android.hardware.Camera", "getNumberOfCameras", Null, Null)
Log(r.target)
Log(numberOfCameras)
For i = 0 To numberOfCameras - 1
r.RunStaticMethod("android.hardware.Camera", "getCameraInfo", Array As Object(i, cameraInfo), _
Array As String("java.lang.int", "android.hardware.Camera$CameraInfo"))
r.target = cameraInfo
Log("facing: " & r.GetField("facing") & ", " & cameraValue)
If r.GetField("facing") = cameraValue Then
cI.cameraInfo = r.target
cI.Id = i
Return cI
End If
Next
cI.id = -1
Return cI
End Sub
Private Sub SetDisplayOrientation
r.target = r.GetActivity
r.target = r.RunMethod("getWindowManager")
r.target = r.RunMethod("getDefaultDisplay")
r.target = r.RunMethod("getRotation")
Dim previewResult, result, degrees As Int = r.target * 90
Dim cI As CameraInfoAndId = FindCamera(Front)
r.target = cI.CameraInfo
Dim orientation As Int = r.GetField("orientation")
If Front Then
previewResult = (orientation + degrees) Mod 360
result = previewResult
previewResult = (360 - previewResult) Mod 360
Else
previewResult = (orientation - degrees + 360) Mod 360
result = previewResult
Log(previewResult)
End If
r.target = nativeCam
r.RunMethod2("setDisplayOrientation", previewResult, "java.lang.int")
r.target = parameters
r.RunMethod2("setRotation", result, "java.lang.int")
CommitParameters
End Sub
Private Sub Camera_Ready (Success As Boolean)
If Success Then
r.target = cam
nativeCam = r.GetField("camera")
r.target = nativeCam
parameters = r.RunMethod("getParameters")
SetDisplayOrientation
Else
Log("success = false, " & LastException)
End If
CallSub2(target, event & "_ready", Success)
End Sub
'Uncomment this sub if you need to handle the Preview event
'Sub Camera_Preview (Data() As Byte)
' If SubExists(target, event & "_preview") Then
' CallSub2(target, event & "_preview", Data)
' End If
'End Sub
Public Sub TakePicture
cam.TakePicture
End Sub
Private Sub Camera_PictureTaken (Data() As Byte)
CallSub2(target, event & "_PictureTaken", Data)
End Sub
Public Sub StartPreview
cam.StartPreview
End Sub
Public Sub StopPreview
cam.StopPreview
End Sub
Public Sub Release
cam.Release
End Sub
'Saves the data received from PictureTaken event
Public Sub SavePictureToFile(Data() As Byte, Dir As String, FileName As String)
Dim out As OutputStream = File.OpenOutput(Dir, FileName, False)
out.WriteBytes(Data, 0, Data.Length)
out.Close
End Sub
Public Sub SetParameter(Key As String, Value As String)
r.target = parameters
r.RunMethod3("set", Key, "java.lang.String", Value, "java.lang.String")
End Sub
Public Sub GetParameter(Key As String) As String
r.target = parameters
Return r.RunMethod2("get", Key, "java.lang.String")
End Sub
Public Sub CommitParameters
'Try
r.target = nativeCam
r.RunMethod4("setParameters", Array As Object(parameters), Array As String("android.hardware.Camera$Parameters"))
'Catch
' ToastMessageShow("Error setting parameters.", True)
' Log(LastException)
' End Try
End Sub
Public Sub GetColorEffect As String
Return GetParameter("effect")
End Sub
Public Sub SetColorEffect(Effect As String)
SetParameter("effect", Effect)
End Sub
Public Sub GetSupportedPreviewSizes As CameraSize()
r.target = parameters
Dim list1 As List = r.RunMethod("getSupportedPreviewSizes")
Dim cS(list1.Size) As CameraSize
For i = 0 To list1.Size - 1
r.target = list1.get(i)
cS(i).Width = r.GetField("width")
cS(i).Height = r.GetField("height")
Next
Return cS
End Sub
Public Sub SetPreviewSize(Width As Int, Height As Int)
r.target = parameters
r.RunMethod3("setPreviewSize", Width, "java.lang.int", Height, "java.lang.int")
End Sub
Public Sub GetSupportedPicturesSizes As CameraSize()
r.target = parameters
Dim list1 As List = r.RunMethod("getSupportedPictureSizes")
Dim cS(list1.Size) As CameraSize
For i = 0 To list1.Size - 1
r.target = list1.get(i)
cS(i).Width = r.GetField("width")
cS(i).Height = r.GetField("height")
Next
Return cS
End Sub
Public Sub SetPictureSize(Width As Int, Height As Int)
r.target = parameters
r.RunMethod3("setPictureSize", Width, "java.lang.int", Height, "java.lang.int")
End Sub
Public Sub SetJpegQuality(Quality As Int)
r.target = parameters
r.RunMethod2("setJpegQuality", Quality, "java.lang.int")
End Sub
Public Sub SetFlashMode(Mode As String)
r.target = parameters
r.RunMethod2("setFlashMode", Mode, "java.lang.String")
End Sub
Public Sub GetFlashMode As String
r.target = parameters
Return r.RunMethod("getFlashMode")
End Sub
Public Sub GetSupportedFlashModes As List
r.target = parameters
Return r.RunMethod("getSupportedFlashModes")
End Sub
Public Sub GetSupportedColorEffects As List
r.target = parameters
Return r.RunMethod("getSupportedColorEffects")
End Sub
'Returns a list with the supported preview fps. Each item in the list is an array of two ints (minimum value and maximum value).
Public Sub GetSupportedPreviewFpsRange As List
r.target = parameters
Return r.RunMethod("getSupportedPreviewFpsRange")
End Sub
'Returns the current preview fps range.
'Range is a two elements array. The minimum value and maximum value will be stored in this array.
Public Sub GetPreviewFpsRange(Range() As Int)
r.target = parameters
r.RunMethod4("getPreviewFpsRange", Array As Object(Range), Array As String("[I"))
End Sub
Public Sub SetPreviewFpsRange(MinValue As Int, MaxValue As Int)
r.target = parameters
r.RunMethod4("setPreviewFpsRange", Array As Object(MinValue, MaxValue), _
Array As String("java.lang.int", "java.lang.int"))
End Sub
Public Sub GetPreviewSize As CameraSize
r.target = parameters
r.target = r.RunMethod("getPreviewSize")
Dim cs As CameraSize
cs.Width = r.GetField("width")
cs.Height = r.GetField("height")
Return cs
End Sub
Public Sub GetPictureSize As CameraSize
r.target = parameters
r.target = r.RunMethod("getPictureSize")
Dim cs As CameraSize
cs.Width = r.GetField("width")
cs.Height = r.GetField("height")
Return cs
End Sub
'Converts a preview image formatted in YUV format to JPEG.
'Note that you should not save every preview image as it will slow down the whole process.
Public Sub PreviewImageToJpeg(data() As Byte, quality As Int) As Byte()
Dim size, previewFormat As Object
r.target = parameters
size = r.RunMethod("getPreviewSize")
previewFormat = r.RunMethod("getPreviewFormat")
r.target = size
Dim width = r.GetField("width"), height = r.GetField("height") As Int
Dim yuvImage As Object = r.CreateObject2("android.graphics.YuvImage", _
Array As Object(data, previewFormat, width, height, Null), _
Array As String("[B", "java.lang.int", "java.lang.int", "java.lang.int", "[I"))
r.target = yuvImage
Dim rect1 As Rect
rect1.Initialize(0, 0, r.RunMethod("getWidth"), r.RunMethod("getHeight"))
Dim out As OutputStream
out.InitializeToBytesArray(100)
r.RunMethod4("compressToJpeg", Array As Object(rect1, quality, out), _
Array As String("android.graphics.Rect", "java.lang.int", "java.io.OutputStream"))
Return out.ToBytesArray
End Sub
Public Sub GetSupportedFocusModes As List
r.target = parameters
Return r.RunMethod("getSupportedFocusModes")
End Sub
Public Sub SetContinuousAutoFocus
Dim modes As List = GetSupportedFocusModes
If modes.IndexOf("continuous-picture") > -1 Then
SetFocusMode("continuous-picture")
Else If modes.IndexOf("continuous-video") > -1 Then
SetFocusMode("continuous-video")
Else
Log("Continuous focus mode is not available")
End If
End Sub
Public Sub SetFocusMode(Mode As String)
r.target = parameters
r.RunMethod2("setFocusMode", Mode, "java.lang.String")
End Sub
Public Sub GetFocusDistances As Float()
Dim F(3) As Float
r.target = parameters
r.RunMethod4("getFocusDistances", Array As Object(F), Array As String("[F"))
Return F
End Sub
Public Sub GetSupportedPictureFormats As List
r.target = parameters
Return r.RunMethod("getSupportedPictureFormats")
End Sub
'This method should only be called if you need to immediately release the camera.
'For example if you need to start another application that depends on the camera.
Public Sub CloseNow
cam.Release
r.target = cam
r.RunMethod2("releaseCameras", True, "java.lang.boolean")
End Sub
'Calls AutoFocus and then takes the picture if focus was successfull.
Public Sub FocusAndTakePicture
cam.AutoFocus
End Sub
Private Sub Camera_FocusDone (Success As Boolean)
If Success Then
TakePicture
Else
Log("AutoFocus error.")
End If
End Sub
Public Sub IsZoomSupported As Boolean
r.target = parameters
Return r.RunMethod("isZoomSupported")
End Sub
Public Sub GetMaxZoom As Int
r.target = parameters
Return r.RunMethod("getMaxZoom")
End Sub
Public Sub getZoom() As Int
r.target = parameters
Return r.RunMethod("getZoom")
End Sub
Public Sub setZoom(ZoomValue As Int)
r.target = parameters
r.RunMethod2("setZoom", ZoomValue, "java.lang.int")
End Sub
Public Sub getExposureCompensation As Int
r.target = parameters
Return r.RunMethod("getExposureCompensation")
End Sub
Public Sub setExposureCompensation(v As Int)
r.target = parameters
r.RunMethod2("setExposureCompensation", v, "java.lang.int")
End Sub
Public Sub getMinExposureCompensation As Int
r.target = parameters
Return r.RunMethod("getMinExposureCompensation")
End Sub
Public Sub getMaxExposureCompensation As Int
r.target = parameters
Return r.RunMethod("getMaxExposureCompensation")
End Sub
Public Sub SetFaceDetectionListener
Dim jo As JavaObject = nativeCam
Dim e As Object = jo.CreateEvent("android.hardware.Camera.FaceDetectionListener", "FaceDetection", Null)
jo.RunMethod("setFaceDetectionListener", Array(e))
End Sub
Private Sub FaceDetection_Event (MethodName As String, Args() As Object) As Object
Dim faces() As Object = Args(0)
For Each f As Object In faces
Dim jo As JavaObject = f
Dim faceRect As Rect = jo.GetField("rect")
Log(faceRect)
Next
Return Null
End Sub
Public Sub StartFaceDetection
Dim jo As JavaObject = nativeCam
jo.RunMethod("startFaceDetection", Null)
End Sub
Public Sub StopFaceDetection
Dim jo As JavaObject = nativeCam
jo.RunMethod("stopFaceDetection", Null)
End Sub

272
B4A/DBRequestManager.bas Normal file
View File

@@ -0,0 +1,272 @@
B4A=true
Group=Default Group
ModulesStructureVersion=1
Type=Class
Version=6.8
@EndOfDesignText@
''Class module
'' Requiere accesRandom File y requiere compressStrings, byte converter y okhhtputuils2
Sub Class_Globals
Private mTarget As Object
Type DBResult (Tag As Object, Columns As Map, Rows As List)
Type DBCommand (Name As String, Parameters() As Object)
Private link As String
Private bc As ByteConverter
Private T_NULL = 0, T_STRING = 1, T_SHORT = 2, T_INT = 3, T_LONG = 4, T_FLOAT = 5 _
,T_DOUBLE = 6, T_BOOLEAN = 7, T_BLOB = 8 As Byte
Private VERSION As Float = 0.9
Private tempArray(1) As Object
Dim jobTagAnterior As String = "" 'Mod por CHV - 211109
End Sub
'Target - The module that handles JobDone (usually Me).
'ConnectorLink - URL of the Java server.
Public Sub Initialize (Target As Object, ConnectorLink As String)
mTarget = Target
link = ConnectorLink
End Sub
'Sends a query request.
'Command - Query name and parameters.
'Limit - Maximum rows to return or 0 for no limit.
'Tag - An object that will be returned in the result.
Public Sub ExecuteQuery(Command As DBCommand, Limit As Int, Tag As Object)
Dim j As HttpJob
Dim ms As OutputStream
Dim out2 As OutputStream = StartJob(j,ms, Tag)
WriteObject(Command.Name, out2)
WriteInt(Limit, out2)
WriteList(Command.Parameters, out2)
out2.Close
j.PostBytes(link & "?method=query", ms.ToBytesArray)
End Sub
'Executes a batch of (non-select) commands.
'ListOfCommands - List of the commands that will be executes.
'Tag - An object that will be returned in the result.
Public Sub ExecuteBatch(ListOfCommands As List, Tag As Object)
Dim j As HttpJob
Dim ms As OutputStream
Dim out2 As OutputStream = StartJob(j,ms, Tag)
WriteInt(ListOfCommands.Size, out2)
For Each Command As DBCommand In ListOfCommands
WriteObject(Command.Name, out2)
WriteList(Command.Parameters, out2)
Next
out2.Close
j.PostBytes(link & "?method=batch", ms.ToBytesArray)
End Sub
'Similar to ExecuteBatch. Sends a single command.
Public Sub ExecuteCommand(Command As DBCommand, Tag As Object)
ExecuteBatch(Array As DBCommand(Command), Tag)
End Sub
Private Sub StartJob(j As HttpJob, MemoryStream As OutputStream, Tag As Object) As OutputStream
j.Initialize("DBRequest", mTarget)
j.Tag = Tag
MemoryStream.InitializeToBytesArray(0)
Dim compress As CompressedStreams
Dim out As OutputStream = compress.WrapOutputStream(MemoryStream, "gzip")
WriteObject(VERSION, out)
Return out
End Sub
Private Sub WriteList(Parameters As List, out As OutputStream)
Dim data() As Byte
If Parameters = Null Or Parameters.IsInitialized = False Then
Dim Parameters As List
Parameters.Initialize
End If
data = bc.IntsToBytes(Array As Int(Parameters.Size))
out.WriteBytes(data, 0, data.Length)
For Each o As Object In Parameters
WriteObject(o, out)
Next
End Sub
Private Sub WriteObject(o As Object, out As OutputStream)
Dim data() As Byte
tempArray(0) = o
If tempArray(0) = Null Then
out.WriteBytes(Array As Byte(T_NULL), 0, 1)
Else If tempArray(0) Is Short Then
out.WriteBytes(Array As Byte(T_SHORT), 0, 1)
data = bc.ShortsToBytes(Array As Short(o))
Else If tempArray(0) Is Int Then
out.WriteBytes(Array As Byte(T_INT), 0, 1)
data = bc.IntsToBytes(Array As Int(o))
Else If tempArray(0) Is Float Then
out.WriteBytes(Array As Byte(T_FLOAT), 0, 1)
data = bc.FloatsToBytes(Array As Float(o))
Else If tempArray(0) Is Double Then
out.WriteBytes(Array As Byte(T_DOUBLE), 0, 1)
data = bc.DoublesToBytes(Array As Double(o))
Else If tempArray(0) Is Long Then
out.WriteBytes(Array As Byte(T_LONG), 0, 1)
data = bc.LongsToBytes(Array As Long(o))
Else If tempArray(0) Is Boolean Then
out.WriteBytes(Array As Byte(T_BOOLEAN), 0, 1)
Dim b As Boolean = 0
Dim data(1) As Byte
If b Then data(0) = 1 Else data(0) = 0
Else If GetType(tempArray(0)) = "[B" Then
data = o
out.WriteBytes(Array As Byte(T_BLOB), 0, 1)
WriteInt(data.Length, out)
Else 'If o Is String Then (treat all other values as string)
out.WriteBytes(Array As Byte(T_STRING), 0, 1)
data = bc.StringToBytes(o, "UTF8")
WriteInt(data.Length, out)
End If
If data.Length > 0 Then out.WriteBytes(data, 0, data.Length)
End Sub
Private Sub ReadObject(In As InputStream) As Object
Dim data(1) As Byte
In.ReadBytes(data, 0, 1)
Select data(0)
Case T_NULL
Return Null
Case T_SHORT
Dim data(2) As Byte
Return bc.ShortsFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_INT
Dim data(4) As Byte
Return bc.IntsFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_LONG
Dim data(8) As Byte
Return bc.LongsFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_FLOAT
Dim data(4) As Byte
Return bc.FloatsFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_DOUBLE
Dim data(8) As Byte
Return bc.DoublesFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_BOOLEAN
Dim b As Byte = ReadByte(In)
Return b = 1
Case T_BLOB
Dim len As Int = ReadInt(In)
Dim data(len) As Byte
Return ReadBytesFully(In, data, data.Length)
Case Else
Dim len As Int = ReadInt(In)
Dim data(len) As Byte
ReadBytesFully(In, data, data.Length)
Return BytesToString(data, 0, data.Length, "UTF8")
End Select
End Sub
Private Sub ReadBytesFully(In As InputStream, Data() As Byte, Len As Int) As Byte()
Dim count = 0, read As Int
Do While count < Len And read > -1
read = In.ReadBytes(Data, count, Len - count)
count = count + read
Loop
Return Data
End Sub
Private Sub WriteInt(i As Int, out As OutputStream)
Dim data() As Byte
data = bc.IntsToBytes(Array As Int(i))
out.WriteBytes(data, 0, data.Length)
End Sub
Private Sub ReadInt(In As InputStream) As Int
Dim data(4) As Byte
Return bc.IntsFromBytes(ReadBytesFully(In, data, data.Length))(0)
End Sub
Private Sub ReadByte(In As InputStream) As Byte
Dim data(1) As Byte
In.ReadBytes(data, 0, 1)
Return data(0)
End Sub
'Handles the Job result and returns a DBResult.
Public Sub HandleJob(Job As HttpJob) As DBResult
Dim start As Long = DateTime.Now 'ignore
Dim In As InputStream = Job.GetInputStream
Dim cs As CompressedStreams
In = cs.WrapInputStream(In, "gzip")
Dim serverVersion As Float = ReadObject(In) 'ignore
Dim method As String = ReadObject(In)
Dim table As DBResult
table.Initialize
table.Columns.Initialize
table.rows.Initialize
table.Tag = Job.Tag
If jobTagAnterior <> Job.Tag Then LogColor("HandleJob: '"&Job.Tag&"'", Colors.Blue) 'Mod por CHV - 211109
jobTagAnterior = Job.Tag 'Mod por CHV - 211109
If method = "query" Then
Dim numberOfColumns As Int = ReadInt(In)
For i = 0 To numberOfColumns - 1
table.Columns.Put(ReadObject(In), i)
Next
Do While ReadByte(In) = 1
Dim rowObjects(numberOfColumns) As Object
table.rows.Add(rowObjects)
For col = 0 To numberOfColumns - 1
Dim o As Object = ReadObject(In)
rowObjects(col) = o
Next
Loop
Else If method = "batch" Then
table.Columns.Put("AffectedRows", 0)
Dim rows As Int = ReadInt(In)
For i = 0 To rows - 1
table.rows.Add(Array As Object(ReadInt(In)))
Next
End If
In.Close
' Log("HandleJob: " & (DateTime.Now - start))'Comentado por CHV - 211112
Return table
End Sub
'Reads a file and returns the file as a bytes array.
Public Sub FileToBytes(Dir As String, FileName As String) As Byte()
Dim out As OutputStream
out.InitializeToBytesArray(0)
Dim In As InputStream = File.OpenInput(Dir, FileName)
File.Copy2(In, out)
out.Close
Return out.ToBytesArray
End Sub
'Converts an image to a bytes array (for BLOB fields).
Public Sub ImageToBytes(Image As Bitmap) As Byte()
Dim out As OutputStream
out.InitializeToBytesArray(0)
Image.WriteToStream(out, 100, "JPEG")
out.Close
Return out.ToBytesArray
End Sub
'Converts a bytes array to an image (for BLOB fields).
Public Sub BytesToImage(bytes() As Byte) As Bitmap
Dim In As InputStream
In.InitializeFromBytesArray(bytes, 0, bytes.Length)
Dim bmp As Bitmap
bmp.Initialize2(In)
Return bmp
End Sub
'Prints the table to the logs.
Public Sub PrintTable(Table As DBResult)
Log("Tag: " & Table.Tag & ", Columns: " & Table.Columns.Size & ", Rows: " & Table.Rows.Size)
Dim sb As StringBuilder
sb.Initialize
For Each col In Table.Columns.Keys
sb.Append(col).Append(TAB)
Next
Log(sb.ToString)
For Each row() As Object In Table.Rows
Dim sb As StringBuilder
sb.Initialize
For Each record As Object In row
sb.Append(record).Append(TAB)
Next
ToastMessageShow(sb.ToString, True)
Next
End Sub

BIN
B4A/Files/alert2.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 632 B

BIN
B4A/Files/atras.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 3.1 KiB

BIN
B4A/Files/camara.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 2.1 KiB

BIN
B4A/Files/derecha.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 8.4 KiB

BIN
B4A/Files/engranes.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 8.7 KiB

BIN
B4A/Files/frintal.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 3.2 KiB

BIN
B4A/Files/from2.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 7.3 KiB

BIN
B4A/Files/gabinete.jpg Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 19 KiB

BIN
B4A/Files/gabinete.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 13 KiB

BIN
B4A/Files/gabinete1.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 19 KiB

BIN
B4A/Files/gestion.bal Normal file

Binary file not shown.

BIN
B4A/Files/gestion_sup.bal Normal file

Binary file not shown.

BIN
B4A/Files/gestiones.bal Normal file

Binary file not shown.

BIN
B4A/Files/izquierda.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 8.4 KiB

BIN
B4A/Files/kmt.db Normal file

Binary file not shown.

BIN
B4A/Files/login.bal Normal file

Binary file not shown.

BIN
B4A/Files/mainpage.bal Normal file

Binary file not shown.

BIN
B4A/Files/mas.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 550 B

BIN
B4A/Files/menos.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 468 B

BIN
B4A/Files/principal.bal Normal file

Binary file not shown.

BIN
B4A/Files/qr.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.1 KiB

BIN
B4A/Files/roit.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 23 KiB

BIN
B4A/Files/supervisor.bal Normal file

Binary file not shown.

253
B4A/FirebaseMessaging.bas Normal file
View File

@@ -0,0 +1,253 @@
B4A=true
Group=Default Group
ModulesStructureVersion=1
Type=Service
Version=10.2
@EndOfDesignText@
'///////////////////////////////////////////////////////////////////////////////////////
'/// Agregar estas lineas al editor de manifiestos
'
' CreateResourceFromFile(Macro, FirebaseAnalytics.GooglePlayBase)
' CreateResourceFromFile(Macro, FirebaseAnalytics.Firebase)
' CreateResourceFromFile(Macro, FirebaseAnalytics.FirebaseAnalytics)
' CreateResourceFromFile(Macro, FirebaseNotifications.FirebaseNotifications)
'
'/// Agregar modulo de servicio nuevo FirebaseMessaging y copiar este modulo
'
'/// Bajar el archivo google-services.json de la consola de Firebase (https://console.firebase.google.com/)
'/// El nombre de la app en el archivo json tiene que ser el mismo que el nombre del paquete (Proyecto/Conf de Compilacion/Paquete)
'
'/// En Starter agregar esta linea
'
' Sub Service_Create
' CallSubDelayed(FirebaseMessaging, "SubscribeToTopics")
' End Sub
'
'/// En Main en Sub Process_Globals agregar esta linea
'
' Private const API_KEY As String = "AAAAv__xxxxxxxxxxxxx-xxxxxxxxxxxxxx-xxxxxxxxxxxx"
'
'/// Esta llave se consigue igualmente en la consola de Firebase, configuracion de proyecto, Cloud Messaging,
'/// es la clave de servidor.
'///
'/// Se necesitan agregar las librerías: FirebaseAnalitics, FirebaseNotifications, JSON y OkHttpUtils2
'/// ... JSON es necesario si se van a enviar mensajes, si solo se van a recibir, no es necesario.
'
'///////////////////////////////////////////////////////////////////////////////////////
Sub Process_Globals
Private fm As FirebaseMessaging
Private const API_KEY As String = "AAAAv1qt3Lk:APA91bECIR-pHn6ul53eYyoVlpPuOo85RO-0zcAgEXwE7vqw8DFSbBtCaCINiqWQAkBBZXxHtQMdpU6B-jHIqgFKVL196UgwHv0Gw6_IgmipfV_NiItjzlH9d2QNpGLp9y_JUKVjUEhP"
Dim locRequest As String
Dim phn As Phone
Dim devModel As String
Dim pe As PhoneEvents
Dim c As Cursor
Public GZip As GZipStrings
Dim Subscrito As String = ""
Dim au As String
Dim puntosRuta As Int = 380
End Sub
Sub Service_Create
' fm.Initialize("fm") 'Inicializamos FirebaseMessaging
pe.Initialize("pe") 'Para obtener la bateria
End Sub
'Public Sub SubscribeToTopics
'' fm.SubscribeToTopic("Trckr") 'Global (you can subscribe to more topics)
' fm.SubscribeToTopic("Trckr") 'Tracker global
' Log("Subscrito al tracker global")
' fm.SubscribeToTopic("Trckr-Durakelo") 'Global (you can subscribe to more topics)
' Log("Subscrito a Trckr-Durakelo")
'' If Starter.usuario <> Subscrito Then
'' fm.SubscribeToTopic(Starter.usuario) 'Propio (you can subscribe to more topics)
'' fm.UnsubscribeFromTopic(Subscrito) 'Unsubscribe from topic
'' End If
'' If Starter.logger Then Log("Subscrito a "&Starter.usuario)
'' Subscrito = Starter.usuario
'End Sub
Sub Service_Start (StartingIntent As Intent)
If StartingIntent.IsInitialized Then fm.HandleIntent(StartingIntent)
Sleep(0)
Service.StopAutomaticForeground 'remove if not using B4A v8+.
StartServiceAt(Me, DateTime.Now + 10 * DateTime.TicksPerMinute, True) 'Iniciamos servicio cada XX minutos
End Sub
'Sub fm_MessageArrived (Message As RemoteMessage)
' If Starter.logger Then Log("Message arrived")
' If Starter.logger Then Log($"Message data: ${Message.GetData}"$)
'' getPhnId
' If Message.GetData.ContainsKey("t") Then
' Dim tipos As List = Regex.Split(",",Message.GetData.Get("t"))
' If tipos.IndexOf("pu") <> -1 Or tipos.IndexOf("au") <> -1 Then 'Si es una peticion de ubicacion
' If Starter.logger Then Log("Es una peticion de ubicacion")
' locRequest="Activa"
' If Starter.logger Then Log("Llamamos StartFLP2Reqs")
' CallSubDelayed(Tracker, "StartFLP2Reqs")
' CallSubDelayed(Tracker, "StartFLP")
' End If
' If tipos.IndexOf("au") <> -1 Then 'Si es una actualizacion de ubicacion
' au = 1
' End If
' If tipos.IndexOf("ping") <> -1 Then 'Si es un ping
' If Starter.logger Then Log("Es un ping")
' If Starter.logger Then Log("Mandamos pong")
'' Dim params As Map = CreateMap("topic":"Sprv-Durakelo","title":"pong", "body":Starter.usuario&" - Recibi mensaje "&Message.GetData.Get("title"), "t":"pong")
'' SendMessage(params)
' End If
' If tipos.IndexOf("bgps") <> -1 Then 'Si es una instruccion de borrar archivo gps
' If Starter.logger Then Log("Es una instruccion de borrar archivo gps")
' If Starter.logger Then Log("Borramos archivo gps")
' borramosArchivoGPS
' End If
' If tipos.IndexOf("dr") <> -1 Then 'Si es una peticion de ruta gps
' If Starter.logger Then Log("Es una peticion de Ruta GPS")
'' Dim rutaGpsCmp As String = dameRuta
'' Dim params As Map = CreateMap("topic":"Sprv-Durakelo","title":"ruta", "body":Starter.usuario&" - Recibi mensaje "&Message.GetData.Get("title"), "t":"ruta", "r":rutaGpsCmp)
'' SendMessage(params)
' End If
' If tipos.IndexOf("bgps2") <> -1 Then 'Si es una instruccion de borrar DB gps
' If Starter.logger Then Log("Es una instruccion de borrar BD gps")
' If Starter.logger Then Log("Borramos BD gps")
' borraGPSHist
' End If
' If tipos.IndexOf("pu") = -1 And tipos.IndexOf("au") = -1 And tipos.IndexOf("ping") = -1 And tipos.IndexOf("dr") = -1 Then
' If Starter.logger Then Log("No es ping ni solicitud de ubicacion o ruta, entonces no hacemos nada")
' End If
' End If
'End Sub
Sub Service_Destroy
End Sub
'Sub SendMessage(params As Map)
'' Dim topic As String= params.Get("topic")
'' Dim title As String= params.Get("title")
'' Dim body As String= params.Get("body")
'' Dim tipo As String= params.Get("t")
'' If params.ContainsKey("r") Then
'' If Starter.logger Then Log("Con ruta")
'' Dim rutaGpsCmp As String= params.Get("r")
'' Else
'' If Starter.logger Then Log("Sin ruta")
'' Dim rutaGpsCmp As String = ""
'' End If
'' Dim Job As HttpJob
'' Job.Initialize("fcm", Me)
'' Dim m As Map = CreateMap("to": $"/topics/${topic}"$)
'' Dim data As Map = CreateMap("title":title, "body":body, "d":Starter.usuario, "t":tipo, "b":Main.batt, "mt":Main.montoActual, "r":rutaGpsCmp, "v":Main.v)
'' m.Put("data", data)
'' Dim jg As JSONGenerator
'' jg.Initialize(m)
'' Job.PostString("https://fcm.googleapis.com/fcm/send", jg.ToString)
'' Job.GetRequest.SetContentType("application/json;charset=UTF-8")
'' Job.GetRequest.SetHeader("Authorization", "key=" & API_KEY)
'' If Starter.logger Then Log(m)
'End Sub
Sub mandamosLoc(coords As String)
' If Starter.logger Then Log("Iniciamos mandamosLoc "&coords)
' If Starter.logger Then Log("locRequest="&locRequest)
' Dim t As String
' guardaInfoEnArchivo(coords)'Escribimos coordenadas y fecha a un archivo de texto
' If locRequest="Activa" Then 'Si hay solicitud de ubicacion, entonces la mandamos ...
' If au = 1 Then
' t = "au" ' es una actualizacion
' Else
' t = "u" ' es una peticion
' End If
' Dim params As Map = CreateMap("topic":"Sprv-Durakelo","title":"ubicacionRecibida", "body":coords, "t":t)
' SendMessage(params)
' locRequest="Enviada"
' CallSubDelayed(Tracker,"CreateLocationRequest")
' End If
End Sub
Sub guardaInfoEnArchivo(coords As String) 'Escribimos coordenadas y fecha a un archivo de texto
'' Cambiamos el formato de la hora
'' Dim OrigFormat As String=DateTime.DateFormat 'save orig date format
'' DateTime.DateFormat="MMM-dd HH:mm:ss"
'' Dim lastUpdate As String=DateTime.Date(DateTime.Now)
'' DateTime.DateFormat=OrigFormat 'return to orig date format
'
' If Starter.logger Then Log("Guardamos ubicacion en db")
' Dim latlon() As String = Regex.Split(",", coords)
' Try
' Main.skmt.ExecNonQuery2("INSERT INTO RUTA_GPS(fecha, lat, lon) VALUES (?,?,?)", Array As Object (latlon(2),latlon(0),latlon(1)))
' Catch
' If Starter.logger Then Log("Error guardando ubicacion") 'Si la horaMinSeg es el mismo no lo guarda
' Log(LastException)
' End Try
End Sub
Sub borramosArchivoGPS
Dim out As OutputStream = File.OpenOutput(File.DirRootExternal, "gps.txt", False)
Dim s As String = ""
Dim t() As Byte = s.GetBytes("UTF-8")
out.WriteBytes(t, 0, t.Length)
out.Close
End Sub
Sub pe_BatteryChanged (Level As Int, Scale As Int, Plugged As Boolean, Intent As Intent)
' Main.batt=Level
End Sub
Sub compress(str As String) As String
' Compression
Private su As StringUtils
Dim compressed() As Byte = GZip.compress(str)
If Starter.logger Then Log($"CompressedBytesLength: ${compressed.Length}"$)
Dim base64 As String = su.EncodeBase64(compressed)
If Starter.logger Then Log($"CompressedBytes converted to base64 Length: ${base64.Length}"$)
If Starter.logger Then Log($"CompressedBytes converted to base64: ${base64}"$)
Return base64
End Sub
Sub decompress(base64 As String) As String
' Decompression
Private su As StringUtils
Dim decompressedbytes() As Byte = su.DecodeBase64(base64)
If Starter.logger Then Log($"decompressedbytesLength: ${decompressedbytes.Length}"$)
Dim bc As ByteConverter
Dim uncompressed As String = bc.StringFromBytes(decompressedbytes,"UTF8")
If Starter.logger Then Log($"uncompressedLength: ${uncompressed.Length}"$) ' 6163 Bytes
If Starter.logger Then Log($"Decompressed String = ${uncompressed}"$)
Return uncompressed
End Sub
Sub dameRuta As String
' If Starter.logger Then Log("dameRuta")
' Dim OrigFormat As String = DateTime.DateFormat 'save orig date format
' DateTime.DateFormat="yyMMdd"
'' Dim lastUpdate As String=DateTime.Date(fecha)
' Dim hoy As String = DateTime.Date(DateTime.Now)&"000000"
' DateTime.DateFormat=OrigFormat 'return to orig date format
' If Starter.logger Then Log(hoy)
' Dim c As Cursor
' c = Main.skmt.ExecQuery("select LAT, LON from RUTA_GPS where fecha > "& hoy &" order by fecha desc limit "&puntosRuta)
' c.Position = 0
' Dim ruta2 As String = ""
' If c.RowCount>0 Then
' For i=0 To c.RowCount -1
' c.Position=i
' ruta2=ruta2&CRLF&c.GetString("LAT")&","&c.GetString("LON")
' Next
' End If
' c.Close
' Return compress(ruta2)
End Sub
Sub borraGPSHist
' c=Main.skmt.ExecQuery("select count(*) as cuantos FROM RUTA_GPS")
' c.Position=0
' If Starter.logger Then Log(c.GetInt("cuantos"))
' Main.skmt.ExecNonQuery("delete from RUTA_GPS")
' c=Main.skmt.ExecQuery("select count(*) as cuantos FROM RUTA_GPS")
' c.Position=0
' Log(c.GetInt("cuantos"))
' Log("Borramos RUTA_GPS")
' c.Close
End Sub

166
B4A/Gabinete roit.b4a Normal file
View File

@@ -0,0 +1,166 @@
Build1=Default,gabinete.keymon.lat
File1=alert2.png
File10=gestion.bal
File11=gestion_sup.bal
File12=gestiones.bal
File13=izquierda.png
File14=kmt.db
File15=login.bal
File16=MainPage.bal
File17=mas.png
File18=menos.png
File19=principal.bal
File2=atras.png
File20=qr.png
File21=Roit.png
File22=supervisor.bal
File3=camara.png
File4=derecha.png
File5=engranes.png
File6=frintal.png
File7=from2.png
File8=gabinete.png
File9=gabinete1.png
FileGroup1=Default Group
FileGroup10=Default Group
FileGroup11=Default Group
FileGroup12=Default Group
FileGroup13=Default Group
FileGroup14=Default Group
FileGroup15=Default Group
FileGroup16=Default Group
FileGroup17=Default Group
FileGroup18=Default Group
FileGroup19=Default Group
FileGroup2=Default Group
FileGroup20=Default Group
FileGroup21=Default Group
FileGroup22=Default Group
FileGroup3=Default Group
FileGroup4=Default Group
FileGroup5=Default Group
FileGroup6=Default Group
FileGroup7=Default Group
FileGroup8=Default Group
FileGroup9=Default Group
Group=Default Group
Library1=accessibility
Library10=core
Library11=fileprovider
Library12=firebaseanalytics
Library13=firebasenotifications
Library14=fusedlocationprovider
Library15=gps
Library16=ime
Library17=javaobject
Library18=nb6
Library19=okhttputils2
Library2=appupdating
Library20=phone
Library21=randomaccessfile
Library22=reflection
Library23=runtimepermissions
Library24=sql
Library25=stringutils
Library26=xcustomlistview
Library27=xui
Library28=xui views
Library3=b4xpages
Library4=batteryprogressview
Library5=bctoast
Library6=bitmapcreator
Library7=byteconverter
Library8=camera
Library9=compressstrings
ManifestCode='This code will be applied to the manifest file during compilation.~\n~'You do not need to modify it in most cases.~\n~'See this link for for more information: https://www.b4x.com/forum/showthread.php?p=78136~\n~AddManifestText(~\n~<uses-sdk android:minSdkVersion="5" android:targetSdkVersion="33"/>~\n~<supports-screens android:largeScreens="true" ~\n~ android:normalScreens="true" ~\n~ android:smallScreens="true" ~\n~ android:anyDensity="true"/>)~\n~SetApplicationAttribute(android:icon, "@drawable/icon")~\n~SetApplicationAttribute(android:label, "$LABEL$")~\n~CreateResourceFromFile(Macro, Themes.LightTheme)~\n~SetApplicationAttribute(android:usesCleartextTraffic, "true")~\n~SetServiceAttribute(Tracker, android:foregroundServiceType, "location")~\n~'SetServiceAttribute(android:requestLegacyExternalStorage, True)~\n~~\n~AddApplicationText(~\n~<meta-data~\n~ android:name="com.google.android.geo.API_KEY"~\n~ android:value="AIzaSyBlBnx3O-DncOSv3oFIp-12wgujOYYcl-U"/>~\n~ <meta-data android:name="com.google.android.gms.version"~\n~ android:value="@integer/google_play_services_version" />~\n~)~\n~~\n~AddManifestText(~\n~<uses-permission~\n~ android:name="android.permission.ACCESS_FINE_LOCATION"~\n~ android:maxSdkVersion="33" />~\n~)~\n~~\n~AddManifestText(~\n~<uses-permission ~\n~ android:name="android.permission.ACCESS_COARSE_LOCATION"~\n~ android:maxSdkVersion="33" />~\n~ )~\n~~\n~AddPermission(android.permission.ACCESS_BACKGROUND_LOCATION)~\n~~\n~AddPermission("android.permission.MANAGE_EXTERNAL_STORAGE")~\n~~\n~~\n~AddManifestText(<uses-permission~\n~android:name="android.permission.WRITE_EXTERNAL_STORAGE"~\n~android:maxSdkVersion="33" />~\n~)~\n~~\n~~\n~'End of default text.~\n~~\n~'/////////////////////// App Updating ////////////////~\n~ AddManifestText(<uses-permission~\n~ android:name="android.permission.WRITE_EXTERNAL_STORAGE"~\n~ android:maxSdkVersion="33" />~\n~ )~\n~ AddApplicationText(~\n~ <provider~\n~ android:name="android.support.v4.content.FileProvider"~\n~ android:authorities="$PACKAGE$.provider"~\n~ android:exported="false"~\n~ android:grantUriPermissions="true">~\n~ <meta-data~\n~ android:name="android.support.FILE_PROVIDER_PATHS"~\n~ android:resource="@xml/provider_paths"/>~\n~ </provider>~\n~ )~\n~ CreateResource(xml, provider_paths,~\n~ <paths>~\n~ <external-files-path name="name" path="" />~\n~ <files-path name="name" path="" />~\n~ <files-path name="name" path="shared" />~\n~ </paths>~\n~ )~\n~AddManifestText(<uses-feature android:name="android.hardware.telephony" android:required="false" />)~\n~AddManifestText(<uses-feature android:name="android.hardware.camera" android:required="false" />)~\n~AddManifestText(<uses-feature android:name="android.hardware.camera.autofocus" android:required="false" />)~\n~AddManifestText(<uses-feature android:name="android.hardware.camera.flash" android:required="false" />)~\n~~\n~AddPermission(android.permission.REQUEST_INSTALL_PACKAGES)~\n~AddPermission(android.permission.INTERNET)~\n~AddPermission(android.permission.INSTALL_PACKAGES)~\n~AddPermission(android.permission.READ_EXTERNAL_STORAGE)~\n~AddPermission(android.permission.WRITE_EXTERNAL_STORAGE)~\n~AddPermission(android.permission.READ_PHONE_STATE)~\n~AddPermission(android.permission.WAKE_LOCK)~\n~CreateResourceFromFile(Macro, JhsIceZxing1.CaturePortrait)~\n~AddPermission("android.permission.MANAGE_EXTERNAL_STORAGE")~\n~SetApplicationAttribute(android:largeHeap, "true")~\n~AddPermission("android.permission.MANAGE_EXTERNAL_STORAGE")~\n~~\n~AddPermission("android.permission.POST_NOTIFICATIONS")~\n~~\n~AddManifestText(<uses-permission android:name="android.permission.ACCESS_NETWORK_STATE" android:maxSdkVersion="33" />)~\n~AddPermission(android.permission.INTERNET)~\n~SetApplicationAttribute(android:allowBackup, "false")~\n~
Module1=appUpdater
Module10=DBRequestManager
Module11=login
Module12=QRGenerator
Module13=Starter
Module14=Subs
Module15=Tracker
Module2=B4x_Transition
Module3=|relative|..\B4XMainPage
Module4=BatteryUtilities
Module5=C_principal
Module6=C_supervisor
Module7=C_UpdateAvailable
Module8=CameraExClass
Module9=CameraExClass2
NumberOfFiles=22
NumberOfLibraries=28
NumberOfModules=15
Version=12.8
@EndOfDesignText@
#Region Project Attributes
#ApplicationLabel: Gabinete
#VersionCode: 1
#VersionName: 4.03.05
'SupportedOrientations possible values: unspecified, landscape or portrait.
#SupportedOrientations: portrait
#CanInstallToExternalStorage: False
#AdditionalJar: com.android.support:support-v4
#AdditionalJar: com.google.android.gms:play-services-location
#End Region
#Region Activity Attributes
#FullScreen: False
#IncludeTitle: False
#End Region
#AdditionalJar: com.google.android.gms:play-services-vision
'#BridgeLogger: True
Sub Process_Globals
Public ActionBarHomeClicked As Boolean
End Sub
Sub Globals
Type CameraInfoAndId (CameraInfo As Object, Id As Int)
Type CameraSize (Width As Int, Height As Int)
End Sub
Sub Activity_Create(FirstTime As Boolean)
Dim pm As B4XPagesManager
pm.Initialize(Activity)
End Sub
'Template version: B4A-1.01
#Region Delegates
Sub Activity_ActionBarHomeClick
ActionBarHomeClicked = True
B4XPages.Delegate.Activity_ActionBarHomeClick
ActionBarHomeClicked = False
End Sub
Sub Activity_KeyPress (KeyCode As Int) As Boolean
Return B4XPages.Delegate.Activity_KeyPress(KeyCode)
End Sub
Sub Activity_Resume
B4XPages.Delegate.Activity_Resume
End Sub
Sub Activity_Pause (UserClosed As Boolean)
B4XPages.Delegate.Activity_Pause
End Sub
Sub Activity_PermissionResult (Permission As String, Result As Boolean)
B4XPages.Delegate.Activity_PermissionResult(Permission, Result)
End Sub
Sub Create_Menu (Menu As Object)
B4XPages.Delegate.Create_Menu(Menu)
End Sub
#if Java
public boolean _onCreateOptionsMenu(android.view.Menu menu) {
processBA.raiseEvent(null, "create_menu", menu);
return true;
}
#End If
#End Region
'Program code should go into B4XMainPage and other pages.

View File

@@ -0,0 +1,51 @@
ModuleBookmarks0=
ModuleBookmarks1=
ModuleBookmarks10=
ModuleBookmarks11=
ModuleBookmarks12=
ModuleBookmarks13=
ModuleBookmarks14=
ModuleBookmarks15=
ModuleBookmarks2=
ModuleBookmarks3=
ModuleBookmarks4=
ModuleBookmarks5=
ModuleBookmarks6=
ModuleBookmarks7=
ModuleBookmarks8=
ModuleBookmarks9=
ModuleBreakpoints0=
ModuleBreakpoints1=
ModuleBreakpoints10=
ModuleBreakpoints11=
ModuleBreakpoints12=
ModuleBreakpoints13=
ModuleBreakpoints14=
ModuleBreakpoints15=
ModuleBreakpoints2=
ModuleBreakpoints3=
ModuleBreakpoints4=
ModuleBreakpoints5=
ModuleBreakpoints6=
ModuleBreakpoints7=
ModuleBreakpoints8=
ModuleBreakpoints9=
ModuleClosedNodes0=
ModuleClosedNodes1=
ModuleClosedNodes10=
ModuleClosedNodes11=
ModuleClosedNodes12=
ModuleClosedNodes13=
ModuleClosedNodes14=
ModuleClosedNodes15=
ModuleClosedNodes2=
ModuleClosedNodes3=
ModuleClosedNodes4=
ModuleClosedNodes5=
ModuleClosedNodes6=
ModuleClosedNodes7=
ModuleClosedNodes8=
ModuleClosedNodes9=
NavigationStack=C_principal,horaentrada,574,0,C_principal,ImageView2_Click,614,6,C_principal,botongestionadas,1627,0,C_principal,b_gestionadas_Click,1606,6,C_principal,b_comidain_Click,1429,0,C_principal,ajustaTamano2,918,5,C_principal,ajustaTamano,900,0,C_supervisor,Class_Globals,0,0,B4XMainPage,Class_Globals,19,0
SelectedBuild=0
VisibleModules=13,3,11,5,6,10,14,15,12,1

491
B4A/QRGenerator.bas Normal file
View File

@@ -0,0 +1,491 @@
B4J=true
Group=Default Group
ModulesStructureVersion=1
Type=Class
Version=6.28
@EndOfDesignText@
'version 1.60
Sub Class_Globals
Private xui As XUI
Public cvs As B4XCanvas
Private ModuleSize As Int
Private GFSize As Int = 256
Private ExpTable(GFSize) As Int
Private LogTable(GFSize) As Int
Private PolyZero() As Int = Array As Int(0)
Private Generator1L() As Int = Array As Int(1, 127, 122, 154, 164, 11, 68, 117)
Private Generator4L() As Int = Array As Int(1, 152, 185, 240, 5, 111, 99, 6, 220, 112, 150, 69, 36, 187, 22, 228, 198, 121, 121, 165, 174) '4L
Private Generator4H() As Int = Array As Int(1, 59, 13, 104, 189, 68, 209, 30, 8, 163, 65, 41, 229, 98, 50, 36, 59)
Private Generator9L() As Int = Array As Int(1, 212, 246, 77, 73, 195, 192, 75, 98, 5, 70, 103, 177, 22, 217, 138, 51, 181, 246, 72, 25, 18, 46, 228, 74, 216, 195, 11, 106, 130, 150)
Private TempBB As B4XBytesBuilder
Private Matrix(0, 0) As Boolean
Private Reserved(0, 0) As Boolean
Private NumberOfModules As Int
Private mBitmapSize As Int
Type QRVersionData (Format() As Byte, Generator() As Int, MaxSize As Int, Version As Int, MaxUsableSize As Int, Alignments() As Int, _
Group1Size As Int, Group2Size As Int, Block1Size As Int, Block2Size As Int, VersionName As String, VersionInformation() As Byte)
Private versions As List
End Sub
Public Sub Initialize (BitmapSize As Int)
TempBB.Initialize
mBitmapSize = BitmapSize
PrepareTables
versions.Initialize
Dim l0() As Byte = Array As Byte(1,1,1,0,1,1,1,1,1,0,0,0,1,0,0)
Dim h0() As Byte = Array As Byte(0,0,1,0,1,1,0,1,0,0,0,1,0,0,1)
versions.Add(CreateVersionData(1, "1L", Generator1L, l0, 19 * 8, 17, Array As Int(), 1, 0, 19, 0, Null))
versions.Add(CreateVersionData(4, "4H", Generator4H, h0 , 36 * 8, 34, Array As Int(6, 26), 4, 0, 9, 0, Null))
versions.Add(CreateVersionData(4, "4L", Generator4L, l0 , 80 * 8, 78, Array As Int(6, 26), 1, 0, 80, 0, Null))
versions.Add(CreateVersionData(9, "9L", Generator9L, l0, 232 * 8, 230, Array As Int(6, 26, 46), 2, 0, 116, 0, Array As Byte(0,0,1,0,0,1,1,0,1,0,1,0,0,1,1,0,0,1)))
versions.Add(CreateVersionData(23, "23H", Generator9L, h0, 464 * 8, 461, Array As Int(6, 30, 54, 78, 102), 16, 14, 15, 16, _
Array As Byte(0,1,0,1,1,1,0,1,1,1,1,1,1,0,1,1,0,0)))
versions.Add(CreateVersionData(40, "40H", Generator9L, h0, 1276 * 8, 1273, Array As Int(6, 30, 58, 86, 114, 142, 170), 20, 61, 15, 16, _
Array As Byte(1,0,1,0,0,0,1,1,0,0,0,1,1,0,1,0,0,1)))
versions.Add(CreateVersionData(40, "40L", Generator9L, l0, 2956 * 8, 2953, Array As Int(6, 30, 58, 86, 114, 142, 170), 19, 6, 118, 119, _
Array As Byte(1,0,1,0,0,0,1,1,0,0,0,1,1,0,1,0,0,1)))
End Sub
Private Sub CreateVersionData (Version As Int, Name As String, Generator() As Int, Format() As Byte, MaxSize As Int, MaxUsableSize As Int, Alignments() As Int, _
Group1Size As Int, Group2Size As Int, Block1Size As Int, Block2Size As Int, VersionInformation() As Byte) As QRVersionData
Dim v As QRVersionData
v.Initialize
v.Version = Version
v.VersionName = Name
v.Generator = Generator
v.Format = Format
v.MaxSize = MaxSize
v.MaxUsableSize = MaxUsableSize
v.Alignments = Alignments
v.Group1Size = Group1Size
v.Group2Size = Group2Size
v.Block1Size = Block1Size
v.Block2Size = Block2Size
v.VersionInformation = VersionInformation
Return v
End Sub
Public Sub Create(Text As String) As B4XBitmap
Dim Bytes() As Byte = Text.GetBytes("utf8") 'non-standard but still recommended
Dim vd As QRVersionData
For Each version As QRVersionData In versions
If version.MaxUsableSize >= Bytes.Length Then
vd = version
Exit
End If
Next
If vd.IsInitialized = False Then
Log("Too long!")
Return Null
End If
Log(vd.VersionName & ", Size: " & Bytes.Length)
NumberOfModules = 17 + vd.Version * 4
ModuleSize = mBitmapSize / (NumberOfModules + 8)
mBitmapSize = ModuleSize * (NumberOfModules + 8)
Dim p As B4XView = xui.CreatePanel("")
p.SetLayoutAnimated(0, 0, 0, mBitmapSize, mBitmapSize)
cvs.Initialize(p)
Dim Matrix(NumberOfModules, NumberOfModules) As Boolean
Dim Reserved(NumberOfModules, NumberOfModules) As Boolean
Dim Mode() As Byte = Array As Byte(0, 1, 0, 0) 'byte mode
Dim ContentCountIndicator() As Byte
If vd.Version >= 10 Then
ContentCountIndicator = IntTo16Bits(Bytes.Length)
Else
ContentCountIndicator = UnsignedByteToBits(Bytes.Length)
End If
Dim EncodedData As B4XBytesBuilder
EncodedData.Initialize
EncodedData.Append(Mode)
EncodedData.Append(ContentCountIndicator)
For Each b As Byte In Bytes
EncodedData.Append(UnsignedByteToBits(Bit.And(0xff, b)))
Next
'add terminator
Dim PadSize As Int = Min(4, vd.MaxSize - EncodedData.Length)
Dim pad(PadSize) As Byte
EncodedData.Append(pad)
Do While EncodedData.Length Mod 8 <> 0
EncodedData.Append(Array As Byte(0))
Loop
Do While EncodedData.Length < vd.MaxSize
EncodedData.Append(Array As Byte(1,1,1,0,1,1,0,0))
If EncodedData.Length < vd.MaxSize Then EncodedData.Append(Array As Byte(0,0,0,1,0,0,0,1))
Loop
VersionWithTwoGroups(vd.Generator, vd.Group1Size, vd.Group2Size, vd.Block1Size, vd.Block2Size, EncodedData)
AddFinders (vd)
AddDataToMatrix(EncodedData.ToArray, vd)
DrawMatrix
cvs.Invalidate
Dim bmp As B4XBitmap = cvs.CreateBitmap
cvs.Release
Return bmp
End Sub
Private Sub VersionWithTwoGroups (generator() As Int, Group1Size As Int, Group2Size As Int, Block1Size As Int, Block2Size As Int, EncodedData As B4XBytesBuilder)
Dim ecs As List
ecs.Initialize
Dim dataBlocks As List
dataBlocks.Initialize
Dim PrevIndex As Int
For block1 = 0 To Group1Size + Group2Size - 1
Dim BlockSize As Int
If block1 < Group1Size Then BlockSize = Block1Size Else BlockSize = Block2Size
Dim Data() As Byte = EncodedData.SubArray2(PrevIndex * 8, (PrevIndex + BlockSize) * 8)
PrevIndex = PrevIndex + BlockSize
Dim DataAsInts(Data.Length / 8) As Int
Dim i As Int
For i = 0 To Data.Length - 1 Step 8
DataAsInts(i / 8) = BitsToUnsignedByte(Data, i)
Next
dataBlocks.Add(DataAsInts)
Dim ec() As Int = CalcReedSolomon(DataAsInts, generator)
If ec.Length < generator.Length - 1 Then
Dim ec2(generator.Length - 1) As Int
IntArrayCopy(ec, 0, ec2, generator.Length - 1 - ec.Length, ec.Length)
ec = ec2
End If
ecs.Add(ec)
Next
Dim Interleaved As B4XBytesBuilder
Interleaved.Initialize
For i = 0 To Max(Block1Size, Block2Size) - 1
For block1 = 0 To dataBlocks.Size - 1
Dim ii() As Int = dataBlocks.Get(block1)
If ii.Length > i Then
Interleaved.Append(UnsignedByteToBits(ii(i)))
End If
Next
Next
For i = 0 To generator.Length - 2
For block1 = 0 To dataBlocks.Size - 1
Dim ii() As Int = ecs.Get(block1)
Interleaved.Append(UnsignedByteToBits(ii(i)))
Next
Next
EncodedData.Clear
EncodedData.Append(Interleaved.ToArray)
End Sub
Private Sub AddDataToMatrix (Encoded() As Byte, vd As QRVersionData)
Dim format() As Byte = vd.Format
Dim order As List = CreateOrder
'mask 0: (row + column) mod 2 == 0
For Each b As Byte In Encoded
Dim xy() As Int = GetNextPosition(order)
Matrix(xy(0), xy(1)) = (b = 1)
If (xy(1) + xy(0)) Mod 2 = 0 Then Matrix(xy(0), xy(1)) = Not(Matrix(xy(0), xy(1)))
Next
For i = 0 To 5
Matrix(i, 8) = format(i) = 1
Matrix(8, NumberOfModules - 1 - i) = format(i) = 1
Next
Matrix(7, 8) = format(6) = 1
Matrix(8, NumberOfModules - 1 - 6) = format(6) = 1
Matrix(8, 8) = format(7) = 1
Matrix(8, 7) = format(8) = 1
For i = 0 To 5
Matrix(8, 5 - i) = format(i + 9) = 1
Next
For i = 0 To 7
Matrix(NumberOfModules - 1 - 7 + i, 8) = format(7 + i) = 1
Next
If vd.Version >= 7 Then
Dim VersionInformation() As Byte = vd.VersionInformation
Dim c As Int = 18
For x = 0 To 5
For y = 0 To 2
c = c - 1
Matrix(x, NumberOfModules - 11 + y) = VersionInformation(c) = 1
Matrix(NumberOfModules - 11 + y, x) = VersionInformation(c) = 1
Next
Next
End If
End Sub
Private Sub GetNextPosition (order As List) As Int()
Do While True
Dim xy() As Int = order.Get(0)
order.RemoveAt(0)
If Reserved(xy(0), xy(1)) = False Then Return xy
Loop
Return Null
End Sub
Private Sub CreateOrder As List
Dim Order As List
Order.Initialize
Dim x As Int = NumberOfModules - 1
Dim y As Int = NumberOfModules - 1
Dim dy As Int = -1
Do While x >= 0 And y >= 0
Order.Add(Array As Int(x, y))
Order.Add(Array As Int(x - 1, y))
y = y + dy
If y = -1 Then
x = x - 2
y = 0
dy = 1
Else If y = NumberOfModules Then
x = x - 2
y = NumberOfModules - 1
dy = -1
End If
If x = 6 Then x = x - 1
Loop
Return Order
End Sub
Private Sub DrawMatrix
cvs.DrawRect(cvs.TargetRect, xui.Color_White, True, 0)
Dim r As B4XRect
For y = 0 To NumberOfModules - 1
For x = 0 To NumberOfModules - 1
r.Initialize((x + 4) * ModuleSize, (y + 4) * ModuleSize, 0, 0)
r.Width = ModuleSize
r.Height = ModuleSize
Dim clr As Int
If Matrix(x, y) Then
clr = xui.Color_Black
'cvs.DrawCircle(r.CenterX, r.CenterY, r.Width / 2, clr, True, 0)
cvs.DrawRect(r, clr, True, 0)
End If
Next
Next
End Sub
Private Sub BitsToUnsignedByte (b() As Byte, Offset As Int) As Int
Dim res As Int
For i = 0 To 7
Dim x As Int = Bit.ShiftLeft(1, 7 - i)
res = res + b(i + Offset) * x
Next
Return res
End Sub
Private Sub UnsignedByteToBits (Value As Int) As Byte()
TempBB.Clear
For i = 7 To 0 Step - 1
Dim x As Int = Bit.ShiftLeft(1, i)
Dim ii As Int = Bit.And(Value, x)
If ii <> 0 Then
TempBB.Append(Array As Byte(1))
Else
TempBB.Append(Array As Byte(0))
End If
Next
Return TempBB.ToArray
End Sub
Private Sub IntTo16Bits (Value As Int) As Byte()
TempBB.Clear
For i = 15 To 0 Step - 1
Dim x As Int = Bit.ShiftLeft(1, i)
Dim ii As Int = Bit.And(Value, x)
If ii <> 0 Then
TempBB.Append(Array As Byte(1))
Else
TempBB.Append(Array As Byte(0))
End If
Next
Return TempBB.ToArray
End Sub
Private Sub AddFinders (vd As QRVersionData)
AddFinder(0, 0, 6)
AddFinder(NumberOfModules - 7, 0, 6)
AddFinder(0, NumberOfModules - 7, 6)
AddAlignments(vd.Alignments)
If vd.Version >= 7 Then
For x = 0 To 2
For y = 0 To 5
Reserved(y, NumberOfModules - 11 + x) = True
Reserved(NumberOfModules - 11 + x, y) = True
Next
Next
End If
For i = 8 To NumberOfModules - 8
Matrix(i, 6) = (i Mod 2 = 0)
Matrix(6, i) = (i Mod 2 = 0)
Reserved(i, 6) = True
Reserved(6, i) = True
Next
Matrix(8, NumberOfModules - 1 - 7) = True
Reserved(8, NumberOfModules - 1 - 7) = True
For i = 0 To 7
Reserved(7, i) = True
Reserved(7, NumberOfModules - 1 - i) = True
Reserved(8, NumberOfModules - 1 - i) = True
Reserved(NumberOfModules -1 - 7, i) = True
Reserved(i, 7) = True
Reserved(i,NumberOfModules -1 - 7) = True
Reserved(NumberOfModules -1 - i, 7) = True
Reserved(NumberOfModules -1 - i, 8) = True
Next
For i = 0 To 8
Reserved(8, i) = True
Reserved(i, 8) = True
Next
End Sub
Private Sub AddAlignments (Positions() As Int)
For Each left As Int In Positions
For Each top As Int In Positions
AddFinder (left - 2, top - 2, 4)
Next
Next
End Sub
Private Sub AddFinder (Left As Int, Top As Int, SizeMinOne As Int)
For y = 0 To SizeMinOne
For x = 0 To SizeMinOne
If Reserved(Left + x, Top + y) Then
Return
End If
Next
Next
For y = 0 To SizeMinOne
For x = 0 To SizeMinOne
Dim value As Boolean
If x = 0 Or x = SizeMinOne Or y = 0 Or y = SizeMinOne Then
value = True
Else if x <> 1 And y <> 1 And x <> SizeMinOne - 1 And y <> SizeMinOne - 1 Then
value = True
End If
Matrix(Left + x, Top + y) = value
Reserved(Left + x, Top + y) = True
Next
Next
End Sub
#Region ReedSolomon
Private Sub CalcReedSolomon (Input() As Int, Generator() As Int) As Int()
Dim ecBytes As Int = Generator.Length - 1
Dim InfoCoefficients(Input.Length) As Int
IntArrayCopy(Input, 0, InfoCoefficients, 0, Input.Length)
InfoCoefficients = CreateGFPoly(InfoCoefficients)
InfoCoefficients = PolyMultiplyByMonomial(InfoCoefficients, ecBytes, 1)
Dim remainder() As Int = PolyDivide(InfoCoefficients, Generator)
Return remainder
End Sub
Private Sub PrepareTables
Dim x = 1 As Int
Dim Primitive As Int = 285
For i = 0 To GFSize - 1
ExpTable(i) = x
x = x * 2
If x >= GFSize Then
x = Bit.Xor(Primitive, x)
x = Bit.And(GFSize - 1, x)
End If
Next
For i = 0 To GFSize - 2
LogTable(ExpTable(i)) = i
Next
End Sub
Private Sub CreateGFPoly(Coefficients() As Int) As Int()
If Coefficients.Length > 1 And Coefficients(0) = 0 Then
Dim FirstNonZero As Int = 1
Do While FirstNonZero < Coefficients.Length And Coefficients(FirstNonZero) = 0
FirstNonZero = FirstNonZero + 1
Loop
If FirstNonZero = Coefficients.Length Then
Return Array As Int(0)
End If
Dim res(Coefficients.Length - FirstNonZero) As Int
IntArrayCopy(Coefficients, FirstNonZero, res, 0, res.Length)
Return res
End If
Return Coefficients
End Sub
Private Sub PolyAddOrSubtract(This() As Int, Other() As Int) As Int()
If This(0) = 0 Then Return Other
If Other(0) = 0 Then Return This
Dim Small() As Int = This
Dim Large() As Int = Other
If Small.Length > Large.Length Then
Dim temp() As Int = Small
Small = Large
Large = temp
End If
Dim SumDiff(Large.Length) As Int
Dim LengthDiff As Int = Large.Length - Small.Length
IntArrayCopy(Large, 0, SumDiff, 0, LengthDiff)
For i = LengthDiff To Large.Length - 1
SumDiff(i) = Bit.Xor(Small(i - LengthDiff), Large(i))
Next
Return CreateGFPoly(SumDiff)
End Sub
Private Sub IntArrayCopy(Src() As Int, SrcOffset As Int, Dest() As Int, DestOffset As Int, Count As Int)
For i = 0 To Count - 1
Dest(DestOffset + i) = Src(SrcOffset + i)
Next
End Sub
Private Sub PolyMultiplyByMonomial (This() As Int, Degree As Int, Coefficient As Int) As Int()
If Coefficient = 0 Then Return PolyZero
Dim product(This.Length + Degree) As Int
For i = 0 To This.Length - 1
product(i) = GFMultiply(This(i), Coefficient)
Next
Return CreateGFPoly(product)
End Sub
Private Sub PolyDivide (This() As Int, Other() As Int) As Int()
Dim quotient() As Int = PolyZero
Dim remainder() As Int = This
Dim denominatorLeadingTerm As Int = Other(0)
Dim inverseDenominatorLeadingTerm As Int = GFInverse(denominatorLeadingTerm)
Do While remainder.Length >= Other.Length And remainder(0) <> 0
Dim DegreeDifference As Int = remainder.Length - Other.Length
Dim scale As Int = GFMultiply(remainder(0), inverseDenominatorLeadingTerm)
Dim term() As Int = PolyMultiplyByMonomial(Other, DegreeDifference, scale)
Dim iterationQuotient() As Int = GFBuildMonomial(DegreeDifference, scale)
quotient = PolyAddOrSubtract(quotient, iterationQuotient)
remainder = PolyAddOrSubtract(remainder, term)
Loop
Return remainder
End Sub
Private Sub GFInverse(a As Int) As Int
Return ExpTable(GFSize - LogTable(a) - 1)
End Sub
Private Sub GFMultiply(a As Int, b As Int) As Int
If a = 0 Or b = 0 Then
Return 0
End If
Return ExpTable((LogTable(a) + LogTable(b)) Mod (GFSize - 1))
End Sub
Private Sub GFBuildMonomial(Degree As Int, Coefficient As Int) As Int()
If Coefficient = 0 Then Return PolyZero
Dim c(Degree + 1) As Int
c(0) = Coefficient
Return c
End Sub
#End Region

120
B4A/Starter.bas Normal file
View File

@@ -0,0 +1,120 @@
B4A=true
Group=Default Group
ModulesStructureVersion=1
Type=Service
Version=9.85
@EndOfDesignText@
#Region Service Attributes
#StartAtBoot: False
#ExcludeFromLibrary: True
#End Region
Sub Process_Globals
'These global variables will be declared once when the application starts.
'These variables can be accessed from all modules.
Public rp As RuntimePermissions
Dim reqManager As DBRequestManager
Dim DBReqServer As String = "http://keymon.lat:1783" '"http://keymon.lat:1782" "http://10.0.0.205:1782" ""' CAMBIAR HACIA AFUERA O DENTRO DE LA OFNA
Dim rutaBD As String = File.DirInternal
Dim skmt As SQL
Dim almacen As String
' tracker
Public rp As RuntimePermissions
Public FLP As FusedLocationProvider
Private flpStarted As Boolean
Dim latitud, longitud As String
Dim logger As Boolean = True
Dim ultimaActualizacionGPS As String = 235959
Dim Timer1 As Timer
Dim Interval As Int = 3600
Dim sDate, sTime As String
Public gps As GPS
Private bu As BatteryUtilities
Dim batterystatus(11) As Int
Dim bateria As Double
Dim muestraProgreso = 0
Dim ubicacionActual As Location
Dim horain As String
Dim horaout As String
Dim horacomin As String
Dim horacomout As String
Dim trabaja As Int
End Sub
Sub Service_Create
'This is the program entry point.
'This is a good place to load resources that are not specific to a single activity.
Timer1.Initialize("Timer1",Interval * 1000)
Timer1.Enabled = True
ubicacionActual.Initialize
End Sub
Sub Service_Start (StartingIntent As Intent)
Service.StopAutomaticForeground 'Starter service can start in the foreground state in some edge cases.
Subs.revisaBD
reqManager.Initialize(Me, DBReqServer)
If Not(skmt.IsInitialized) Then skmt.Initialize(rutaBD, "kmt.db", True)
End Sub
Sub Service_TaskRemoved
'This event will be raised when the user removes the app from the recent apps list.
Timer1.Enabled = False
End Sub
'Return true to allow the OS default exceptions handler to handle the uncaught exception.
Sub Application_Error (Error As Exception, StackTrace As String) As Boolean
Return True
End Sub
Sub Service_Destroy
End Sub
Private Sub Timer1_Tick
' ToastMessageShow("Timer",False)
' If logger Then Log("Siguiente actuaizacion " & DateTime.Time(DateTime.Now + Interval * 1000))
ENVIA_ULTIMA_GPS
' Log("trato de enviar")
End Sub
Sub ENVIA_ULTIMA_GPS 'ignore
If trabaja = 1 Then
' DateTime.DateFormat = "dd/MM/yyyy"
' DateTime.TimeFormat = "HH:mm:ss"
' sDate=DateTime.Date(DateTime.Now)
' sTime=DateTime.Time(DateTime.Now)
Log("Iniciamos ENVIA_ULTIMA_GPS")
Dim skmt As SQL
Dim cmd As DBCommand
Dim reqManager As DBRequestManager
DateTime.TimeFormat = "HHmmss"
ultimaActualizacionGPS = DateTime.Time(DateTime.Now)
reqManager.Initialize(Me, DBReqServer)
skmt.Initialize(File.DirInternal,"kmt.db", True)
LogColor(latitud&","&longitud,Colors.Blue)
DateTime.DateFormat = "dd/MM/yyyy"
DateTime.TimeFormat = "HH:mm:ss"
sDate=DateTime.Date(DateTime.Now)
sTime=DateTime.Time(DateTime.Now)
If bateria = 0 Then bateria = 100
Dim cmd As DBCommand
cmd.Initialize
cmd.Name = "insert_ubicaprom_GABICO"
cmd.Parameters = Array As Object(sDate &" " &sTime, B4XPages.MainPage.login.user, latitud,longitud,B4XPages.MainPage.principal.bateria,almacen,B4XPages.MainPage.login.nom_proyec,B4XPages.MainPage.login.sucursal,B4XPages.MainPage.login.suc_nom)
' cmd.Parameters = Array As Object(sDate &" " &sTime, " ", latitud,longitud," ",almacen," "," "," ")
reqManager.ExecuteCommand(cmd,"inst_GESTION_GPS")
'Reiniciamos el timer para cuando llamamos el Sub desde "seleccion"
Timer1.Enabled = False
Timer1.Interval = Interval * 1000
Timer1.Enabled = True
End If
End Sub
Sub reinicializaReqManager
reqManager.Initialize(Me, DBReqServer)
' B4XPages.MainPage.reqManager.Initialize(Me, server)
If logger Then Log(DBReqServer)
End Sub

67
B4A/Subs.bas Normal file
View File

@@ -0,0 +1,67 @@
B4A=true
Group=Default Group
ModulesStructureVersion=1
Type=StaticCode
Version=11.8
@EndOfDesignText@
'Code module
'Subs in this code module will be accessible from all modules.
Sub Process_Globals
'These global variables will be declared once when the application starts.
'These variables can be accessed from all modules.
End Sub
Sub revisaBD 'ignore
If Not(File.Exists(Starter.rutaBD, "kmt.db")) Then File.Copy(File.DirAssets, "kmt.db", Starter.rutaBD, "kmt.db")
If Not(Starter.skmt.IsInitialized) Then Starter.skmt.Initialize(Starter.rutaBD, "kmt.db", True)
Starter.skmt.ExecNonQuery("CREATE TABLE IF NOT EXISTS SUCURSAL(ID_SUC TEXT, NOMBRE_SUC TEXT)")
Starter.skmt.ExecNonQuery("CREATE TABLE IF NOT EXISTS CHECADO(USUARIO TEXT, ID_EMP TEXT, PERFIL TEXT, PROYECTO TEXT, SUCURSAL TEXT, ESTATUS TEXT, FECHA TEXT)")
Starter.skmt.ExecNonQuery("CREATE TABLE IF NOT EXISTS HIST_CHECADO(USUARIO TEXT, ID_EMP TEXT, PERFIL TEXT, PROYECTO TEXT, SUCURSAL TEXT, ESTATUS TEXT, FECHA TEXT)")
Starter.skmt.ExecNonQuery("CREATE TABLE IF NOT EXISTS HIST_PROMOTORIA (HIST_PM_FECHA TEXT, HIST_PR_NOMBRE TEXT,HIST_PR_TELEFONO TEXT, HIST_PR_CORREO TEXT, HIST_PR_CURP TEXT, HIST_PR_INE BLOB, HIST_PR_ESTATUS TEXT, HIST_PR_EVIDENCIA BLOB, HIST_PR_OBSERVACIONES TEXT, HIST_PR_COMENTARIOERROR TEXT, HIST_PR_IDPROYECTO TEXT, HIST_PR_NOMBREPROYECTO TEXT, HIST_PR_IDSUCURSAL TEXT, HIST_PR_NOMBRESUCURSAL TEXT, HIST_PR_USUARIO TEXT, HIST_PR_LATITUD TEXT, HIST_PR_LONGITUD TEXT, HIST_PR_BATERIA TEXT, ENVIADO INT)")
Starter.skmt.ExecNonQuery("CREATE TABLE IF NOT EXISTS CAT_VARIABLES(CAT_VA_DESCRIPCION TEXT, CAT_VA_VALOR TEXT)")
Starter.skmt.ExecNonQuery("CREATE TABLE IF NOT EXISTS HIST_SUPERVISOR(HIST_CHKS_PROYECTO TEXT, HIST_CHKS_NOMPROY TEXT, HIST_CHKS_SUCURSAL TEXT,HIST_CHKS_FORMATO TEXT, HIST_CHKS_SUPERVISOR TEXT, HIST_CHKS_PROMOTOR TEXT, HIST_CHKS_FECHA TEXT, HIST_CHKS_ID TEXT, HIST_CHKS_CALIF_MULTIPLE TEXT, HIST_CHKS_CALIF_ABIERTA TEXT, HIST_CHKS_HORARIO TEXT, ENVIADO INT)")
' Starter.skmt.ExecNonQuery("DROP TABLE IF EXISTS HIST_SUPERVISOR")
Starter.skmt.ExecNonQuery("CREATE TABLE IF NOT EXISTS trabaja(sitrabaja TEXT)")
End Sub
'Genera una notificacion con importancia alta
Sub notiHigh(title As String, body As String, activity As Object) 'ignore
Private notif As Notification
notif.Initialize2(notif.IMPORTANCE_HIGH)
notif.Icon = "icon"
notif.Vibrate = False
notif.Sound = False
notif.AutoCancel = True
Log("notiHigh: "&title)
notif.SetInfo(title, body, activity)
' Log("notiHigh SetInfo")
notif.Notify(777)
End Sub
'Regresa el objeto de una notificacion con importancia baja
Sub notiLowReturn(title As String, Body As String, id As Int) As Notification 'ignore
Private notification As Notification
notification.Initialize2(notification.IMPORTANCE_LOW)
Log("notiLowReturn: "&title)
notification.Icon = "icon"
notification.Sound = False
notification.Vibrate = False
notification.SetInfo(title, Body, Main)
notification.Notify(id)
' Log("notiLowReturn SetInfo")
Return notification
End Sub
Sub IsConnectedToInternet As Boolean 'ignore
Dim r As Reflector
r.Target = r.GetContext
r.Target = r.RunMethod2("getSystemService", "connectivity", "java.lang.String")
r.Target = r.RunMethod("getActiveNetworkInfo")
If r.Target <> Null Then
' If logger Then LogColor("isConnectedOrConnecting", Colors.green)
Return r.RunMethod("isConnectedOrConnecting")
End If
' If logger Then LogColor("Not connected", Colors.red)
Return False
End Sub

254
B4A/Tracker.bas Normal file
View File

@@ -0,0 +1,254 @@
B4A=true
Group=Default Group
ModulesStructureVersion=1
Type=Service
Version=11
@EndOfDesignText@
#Region Service Attributes
#StartAtBoot: True
#End Region
'******************************************************************************
'No olvidar agregar esta linea al editor de manifiesto:
' SetServiceAttribute(Tracker, android:foregroundServiceType, "location")
'
'En Starter agregar estas lineas en Process_Globals
' Public rp As RuntimePermissions
' Public FLP As FusedLocationProvider
' Private flpStarted As Boolean
'
'En Main agregar estas lineas a Activity_Resume
' Starter.rp.CheckAndRequest(Starter.rp.PERMISSION_ACCESS_FINE_LOCATION)
' Wait For Activity_PermissionResult (Permission As String, Result As Boolean)
' If Result Then
' StartService(Tracker)
' Log("Start Tracker")
' Else
' ToastMessageShow("No permission", True)
' End If
'
'Se necesitan las librerias FusedLocationProvider, GPS, Phone y RunTimePermissions
'
'Y en Main agregar estas dos lineas:
'#AdditionalJar: com.android.support:support-v4
'#AdditionalJar: com.google.android.gms:play-services-location
Sub Process_Globals
' Private nid As Int = 1
Private Tracking As Boolean
Private lock As PhoneWakeState
'Para FusedLocationProvider (2 lineas)
Public FLP As FusedLocationProvider
Dim actualLR As LocationRequest
Private flpStarted As Boolean
' Dim locRequest As String
Dim UUGCoords As Location 'Ultima Ubicacion Guardada
' Dim trackerActividad, pushServiceActividad As String
Dim logger As Boolean
End Sub
Sub Service_Create
Service.AutomaticForegroundMode = Service.AUTOMATIC_FOREGROUND_NEVER 'we are handling it ourselves
UUGCoords.Initialize
logger = False
'Para FusedLocationProvider (2 lineas)
FLP.Initialize("flp")
FLP.Connect
lock.PartialLock
StartFLP
End Sub
Sub flp_ConnectionSuccess
' If logger Then Log("Connected to location provider")
'FLP.GetLastKnownLocation
End Sub
Sub flp_ConnectionFailed(ConnectionResult1 As Int)
If logger Then Log("Failed to connect to location provider")
End Sub
Sub flp_ConnectionSuspended(ConnectionResult1 As Int)
If logger Then Log("FLP conection suspended")
StartFLP
End Sub
Sub Service_Start (StartingIntent As Intent)
LogColor("Iniciando Tracker ...", Colors.Green)
Service.StopAutomaticForeground
Service.StartForeground(51042, Subs.notiLowReturn("Gabinete", "Activo", 51042))
StartServiceAt(Me, DateTime.Now + 10 * DateTime.TicksPerMinute, True)
Track
End Sub
Public Sub Track
If logger Then Log("Inicia Track - Tracking : "&Tracking)
If Tracking Then
' Log(actualLR.GetSmallestDisplacement)
Return 'Si ya estamos "rastreando" no hacemos nada (return)
End If
If Starter.rp.Check(Starter.rp.PERMISSION_ACCESS_FINE_LOCATION) = False Then
If logger Then Log("Sin permisos de ublicación.")
Return
End If
StartFLP 'Iniciamos FusedLocationProvider
Tracking = True
End Sub
Public Sub StartFLP
If logger Then Log("StartFLP - flpStarted="&flpStarted)
Do While FLP.IsConnected = False
Sleep(500)
If logger Then Log("sleeping")
Loop
' If flpStarted = False Then
' If logger Then Log("RequestLocationUpdates")
FLP.RequestLocationUpdates(CreateLocationRequest) 'Buscamos ubicacion
If logger Then LogColor("Buscamos ubicacion (movimientoMinimo = "&actualLR.GetSmallestDisplacement&")", Colors.Magenta)
' If logger Then Log(actualLR.GetSmallestDisplacement)
flpStarted = True
' End If
End Sub
Public Sub StartFLPSmall
' Log("StartFLPSmall - flpStarted="&flpStarted)
Do While FLP.IsConnected = False
Sleep(500)
Log("sleeping")
Loop
dameUltimaUbicacionConocida 'Regresamos ultima ubicacion conocida
FLP.RequestLocationUpdates(CreateLocationRequestSmallD) 'Buscamos ubicacion 2 peticiones
' Log("Buscamos ubicacion Small displacement")
' Log("GPSSmallestDisplacement = " & actualLR.GetSmallestDisplacement)
End Sub
Private Sub CreateLocationRequestSmallD As LocationRequest
' Log("Iniciamos CreateLocationRequestSmallD")
Dim lr As LocationRequest
lr.Initialize
lr.SetInterval(2000) 'Intervalo deseado para actualizaciones de ubicacion
lr.SetFastestInterval(lr.GetInterval / 2) 'Intervalo minimo para actualizaciones de ubicacion
lr.setNumUpdates(2) 'Solicitamos solo 2 actualizaciones con estos parametros
lr.SetSmallestDisplacement(0) 'Solo registra cambio de ubicacion si es mayor a XX mts
lr.SetPriority(lr.Priority.PRIORITY_HIGH_ACCURACY)
actualLR=lr
Return lr
End Sub
Public Sub StartFLP2
If logger Then Log("StartFLP2 - flpStarted="&flpStarted)
Do While FLP.IsConnected = False
Sleep(500)
If logger Then Log("sleeping")
Loop
dameUltimaUbicacionConocida 'Regresamos ultima ubicacion conocida
FLP.RequestLocationUpdates(CreateLocationRequest2) 'Buscamos ubicacion 2 peticiones
If logger Then LogColor("Buscamos ubicacion (movimientoMinimo = "&actualLR.GetSmallestDisplacement&")", Colors.Magenta)
' If logger Then Log(actualLR.GetSmallestDisplacement)
End Sub
Private Sub CreateLocationRequest As LocationRequest
' If logger Then Log("CreateLocationRequest")
Dim lr As LocationRequest
lr.Initialize
lr.SetInterval(10000) 'Intervalo deseado para actualizaciones de ubicacion
lr.SetFastestInterval(lr.GetInterval / 2) 'Intervalo minimo para actualizaciones de ubicacion
lr.SetSmallestDisplacement(0) 'Solo registra cambio de ubicacion si es mayor a XX mts
lr.SetPriority(lr.Priority.PRIORITY_HIGH_ACCURACY)
actualLR=lr
Return lr
End Sub
Private Sub CreateLocationRequest2 As LocationRequest
If logger Then Log("Iniciamos CreateLocationRequest2")
Dim lr As LocationRequest
lr.Initialize
lr.SetInterval(2000) 'Intervalo deseado para actualizaciones de ubicacion
lr.SetFastestInterval(lr.GetInterval / 2) 'Intervalo minimo para actualizaciones de ubicacion
lr.setNumUpdates(2) 'Solicitamos solo 2 actualizaciones con estos parametros
lr.SetSmallestDisplacement(1) 'Solo registra cambio de ubicacion si es mayor a XX mts
lr.SetPriority(lr.Priority.PRIORITY_HIGH_ACCURACY)
actualLR=lr
Return lr
End Sub
Sub dameUltimaUbicacionConocida
If FLP.GetLastKnownLocation.IsInitialized Then 'Mandamos ultima ubicacion guardada
' If logger Then LogColor($"Mandamos UUC "${Subs.fechaKMT(FLP.GetLastKnownLocation.Time)}|Acc:$0.2{FLP.GetLastKnownLocation.Accuracy}|$0.8{FLP.GetLastKnownLocation.Latitude}|$0.8{FLP.GetLastKnownLocation.Longitude}|Spd:$0.2{FLP.GetLastKnownLocation.Speed}|"$, Colors.RGB(255,112,35))
' Dim coords As String = FLP.GetLastKnownLocation.Latitude&","&FLP.GetLastKnownLocation.Longitude&","&formatoFecha(FLP.GetLastKnownLocation.Time)
' CallSubDelayed2(FirebaseMessaging,"mandamosLoc",coords)
' Subs.mandamosLoc(coords)
End If
End Sub
Public Sub StopFLP
'Log("StopFLP")
If flpStarted Then
FLP.RemoveLocationUpdates 'Eliminamos todas las solicitudes de ubicacion
flpStarted = False
End If
End Sub
Sub flp_LocationChanged (Location1 As Location)
Starter.latitud = Location1.Latitude
Starter.longitud = Location1.Longitude
' LogColor($"Location changed lat=${Location1.Latitude}, lon=${Location1.Longitude}, Acc=${Location1.Accuracy}, SD=$1.0{actualLR.GetSmallestDisplacement}"$, Colors.green)
UUGCoords = Location1
' If logger Then Log("SmallestDisplacement="&actualLR.GetSmallestDisplacement)
' CallSub2(Starter, "GPS_LocationChanged", Location1)
' CallSub2(gestion, "GPS_LocationChanged", Location1)
' Starter.ubicacionActual.Latitude = Starter.lat_gps
' Starter.ubicacionActual.Longitude = Starter.lon_gps
' Starter.ubicacionActual.Accuracy = Location1.Accuracy
If Starter.latitud = 0 Or Starter.longitud = Null And FLP.GetLastKnownLocation.IsInitialized Then
Starter.latitud = FLP.GetLastKnownLocation.Latitude
Starter.longitud = FLP.GetLastKnownLocation.Longitude
Starter.ubicacionActual = FLP.GetLastKnownLocation
LogColor("Coords en CERO - Guardamos ultima ubicacion conocida", Colors.red)
End If
'/////// para la ultima ubicacion FL
Dim sDate,sTime As String
DateTime.DateFormat = "MM/dd/yyyy"
DateTime.TimeFormat = "HHmmss"
sDate=DateTime.Date(DateTime.Now)
sTime=DateTime.Time(DateTime.Now)
' If Starter.lat_gps <> 0 And Starter.lat_gps <> Null Then
' Try
' Starter.skmt.ExecNonQuery("DELETE FROM HIST_GPS")
' Starter.skmt.ExecNonQuery2("INSERT INTO HIST_GPS (HGDATE, HGLAT, HGLON) VALUES(?,?,?) ", Array As Object (sDate & sTime, Starter.lat_gps, Starter.lon_gps))
' Catch
' If logger Then Log("Error al borrar o insertar nuevas coordendas en HIST_GPS")
' End Try
' End If
' Dim minsDif As Int = DateTime.Time(DateTime.Now) - Starter.ultimaActualizacionGPS
' If Location1.Accuracy < 100 And minsDif > 240 Then 'Si precision de 100 y 4 min transcurridos manda a web
' If Starter.logger Then Log("actualizamos Ubicacion")
' CallSubDelayed(Starter, "ENVIA_ULTIMA_GPS")
' End If
B4XPages.MainPage.principal.GPS_LocationChanged(Location1)
End Sub
Sub CreateNotification (Body As String) As Notification 'ignore
Dim notification As Notification
notification.Initialize2(notification.IMPORTANCE_HIGH)
notification.Icon = "icon"
notification.SetInfo("Gabinete", Body, Main)
Return notification
End Sub
Sub Service_Destroy
If Tracking Then
StopFLP
End If
Tracking = False
lock.ReleasePartialLock
End Sub
Sub formatoFecha(fecha As String) As String 'ignore 'Convierte una fecha al formato yyMMddHHmmss
' Log(fecha)
Dim OrigFormat As String = DateTime.DateFormat 'save orig date format
DateTime.DateFormat="yyMMddHHmmss"
Dim lastUpdate As String=DateTime.Date(fecha)
DateTime.DateFormat=OrigFormat 'return to orig date format
' Log(lastUpdate)
Return lastUpdate
End Sub

282
B4A/appUpdater.bas Normal file
View File

@@ -0,0 +1,282 @@
B4A=true
Group=Default Group
ModulesStructureVersion=1
Type=Service
Version=10.2
@EndOfDesignText@
#Region Service Attributes
#StartAtBoot: False
#End Region
'////////////////////////////////////////////////////////////////////////////////////////////
'//// Servicio para revisar si hay actualizacion de aplicación, usa la
'//// actividad "updateAvailable" para mostrar mensajes.
'////
'//// https://www.b4x.com/android/forum/threads/update-your-app-without-using-the-gplaystore.109720/#content
'////
'//// En la actividad del la cual se va a llamar la revision de actualizacion
'//// hay que agregar los siguientes Subs:
'////
' Sub boton_que_llama_revision_Click
' StartService(appUpdater)
' End Sub
'
' appUpdater - Mostramos el anuncio de que se esta descargando el nuevo apk
' Sub muestraProgreso
' ProgressDialogShow("Descargando actualización")
' End Sub
'
' appUpdater - Ocultamos el anuncio de que se esta descargando el nuevo apk
' Sub ocultaProgreso
' ProgressDialogHide
' End Sub
'////
'//// Requiere las siguientes librerias:
'////
'//// * appUpdating
'//// * JavaObject
'//// * OkHttpUtils2
'//// * Phone
'//// * RuntimePermissions
'////
'//// Requiere las siguientes lineas en el manifiesto:
'////
' 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,
' <paths>
' <external-files-path name="name" path="" />
' <files-path name="name" path="" />
' <files-path name="name" path="shared" />
' </paths>
' )
' AddPermission(android.permission.REQUEST_INSTALL_PACKAGES)
' AddPermission(android.permission.INTERNET)
' AddPermission(android.permission.INSTALL_PACKAGES)
' AddPermission(android.permission.READ_EXTERNAL_STORAGE)
' AddPermission(android.permission.WRITE_EXTERNAL_STORAGE)
' AddPermission(android.permission.READ_PHONE_STATE)
' AddPermission(android.permission.WAKE_LOCK)
'////
'////////////////////////////////////////////////////////////////////////////////////////////
Sub Process_Globals
'These global variables will be declared once when the application starts.
'These variables can be accessed from all modules.
'Aqui va la liga al archivo .ver en el servidor que contiene la información de la aplicacion
Public lnk As String = "https://keymon.lat/Movil/gabinete/Gabinete.ver"
'/// En el servidor se necesita un archivo de texto (.ver) que tenga los siguientes
'/// datos separados por un tabulador
'/// contents of ver file, each field is seperated by a tab
' Field 0 = 2.226.19.09.19.01a <-- Esta es la version de la aplicación disponible
' Field 1 = A new version of the MyAPP is available, Download and update now ? <-- Mensaje para cuando hay actualización
' Field 2 = MyApp is up to date <--- Mensaje para cuando no hay actualización
' Field 3 = http://www.mydomain.com/Public/myapp.apk <--- Liga al apk de la actualización
Public nNewApp As Notification
Public nNewAppnID As Int = 16
'Para Download
Dim nativeMe As JavaObject
Dim n2 As Notification
Dim n2ID As Int = 16
'Para fileProvider
Public SharedFolder As String
Public UseFileProvider As Boolean
Private rp As RuntimePermissions
Type mNewVersion(update As Boolean, nonewAPP As Boolean, notifyUser As Boolean, _
version As String, newMsg As String, okMsg As String, appLink As String)
Public newApp As mNewVersion
End Sub
Sub Service_Create
Log("appUpdater(), Service_Create")
newApp.Initialize
Service.AutomaticForegroundMode = Service.AUTOMATIC_FOREGROUND_NEVER
n2.Initialize
nativeMe.InitializeContext
End Sub
Sub Service_Start (StartingIntent As Intent)
Log("appUpdater(), Service_Start")
' CallSubDelayed2(Main, "muestraProgreso", "Buscando actualización")
B4XPages.MainPage.login.muestraProgreso("Buscando actualización")
Log("Buscando actualización")
fileProvider_init
Wait For (Download(Me, lnk)) JobDone (j As HttpJob)
If j.Success Then
Try
Dim app() As String = Regex.Split(Chr(9),j.GetString)
' // Set the data
newApp.appLink = app(3) 'Liga a nueva app
newApp.newMsg = app(1) 'Texto de que hay actualizacion
newApp.okMsg = app(2) 'Texto de app al corriente
newApp.version = app(0) 'Version actual
Log($"Application.VersionName=${Application.VersionName}, newApp=${newApp}"$)
' // App version check
If newApp.version = Application.VersionName Then
newApp.update = False
Log("No new app")
B4XPages.ShowPage("updateAvailable")
'Se puede mandar tambien una notificacion avisando que NO hay actualizaciones
CreateNotification2("Aplicacion al corriente","No hay actualizaciones disponibles","ic_file_download_white_24dp",Main,True,True,nNewApp,nNewAppnID)
End If
If newApp.version <> Application.VersionName Then
newApp.update = True
Log("New app true")
B4XPages.ShowPage("updateAvailable")
'Se puede mandar tambien una notificacion avisando que hay actualizacion disponible
' CreateNotification2("Nueva aplicación disponible","Haga clic para descargar.","ic_file_download_white_24dp",C_UpdateAvailable,True,True,nNewApp,nNewAppnID)
End If
Catch
Log("appUpdater(), Job Failed, error " & LastException.Message)
End Try
Else
Log("appUpdater(), Job Failed " & lnk)
End If
j.Release
' StopService(Me)
End Sub
Sub download_Start (StartingIntent As Intent)
download_newApk
End Sub
Sub download_newApk
' CreateNotification("Descargando actualización", "Descargando apk", "ic_file_download_white_24dp", Main, False, True)
' CallSubDelayed2(Main, "muestraProgreso", "Descargando actualización")
Log("Descargando actualización")
B4XPages.ShowPage("Login")
Starter.muestraProgreso = 1
Dim job_newAPP As HttpJob
job_newAPP.Initialize("job_newAPP",Me)
job_newAPP.Download(newApp.appLink)
Wait for (job_newAPP) JobDone (job_newAPP As HttpJob)
If job_newAPP.Success = True Then
' // Delete existing file
If File.Exists(SharedFolder,"newapp.apk") Then
File.Delete(SharedFolder,"newapp.apk")
End If
' // Save new file
Dim outNewAPK As OutputStream = File.OpenOutput(SharedFolder,"newapp.apk", False)
File.Copy2(job_newAPP.GetInputStream, outNewAPK)
outNewAPK.Close
If Starter.Logger Then Log("APK dir: "&SharedFolder)
End If
job_newAPP.Release
' // Install the app
Dim in As Intent
in.Initialize(in.ACTION_VIEW,"" )
SetFileUriAsIntentData(in, "newapp.apk")
' // Type must be set after calling SetFileUriAsIntentData
in.SetType("application/vnd.android.package-archive")
StartActivity(in)
n2.Cancel(nNewAppnID)
B4XPages.MainPage.login.ocultaProgreso
' Service.StopForeground(nNewAppnID)
StopService(Me)
' CallSubDelayed(Main,"ocultaProgreso")
End Sub
Sub download_Destroy
n2.Cancel(n2ID)
Service.StopForeground(n2ID)
End Sub
Sub Download (Callback As Object, link As String) As HttpJob
Dim j As HttpJob
j.Initialize("", Callback)
j.Download(link)
Return j
End Sub
Private Sub CreateNotification2(Title As String, Content As String, _ 'ignore
Icon As String, TargetActivity As Object, Sound As Boolean, _
Vibrate As Boolean, pN As Notification,pNID As Int) As Notification
pN.Initialize2(pN.IMPORTANCE_HIGH)
' pN.Number = pNID
' pN.Light = False
pN.Vibrate = Vibrate
pN.Sound = Sound
' pN.OnGoingEvent = False
pN.Icon = Icon
pN.AutoCancel = True
pN.SetInfo(Title, Content, TargetActivity)
pN.Notify(pNID)
Return pN
End Sub
Private Sub CreateNotification(Title As String, Content As String, Icon As String, TargetActivity As Object, Sound As Boolean, Vibrate As Boolean) As Notification 'ignore
n2.Initialize
n2.Light = False
n2.Vibrate = Vibrate
n2.Sound = Sound
n2.OnGoingEvent = True
n2.Icon = Icon
n2.SetInfo(Title, Content, TargetActivity)
n2.Notify(nNewAppnID)
End Sub
Sub Service_Destroy
Log("appUpdater(), Service_Destroy")
End Sub
Sub fileProvider_init
Dim p As Phone
If p.SdkVersion >= 24 Or File.ExternalWritable = False Then
UseFileProvider = True
SharedFolder = File.Combine(File.DirInternal, "shared")
If Not(File.IsDirectory(File.DirInternal,"shared")) Then
File.MakeDir("", SharedFolder)
End If
Else
UseFileProvider = False
SharedFolder = rp.GetSafeDirDefaultExternal("shared")
End If
Log($"Using FileProvider? ${UseFileProvider}"$)
End Sub
'Returns the file uri.
Sub GetFileUri (FileName As String) As Object
Try
If Not(UseFileProvider) Then
Dim uri As JavaObject
Return uri.InitializeStatic("android.net.Uri").RunMethod("parse", Array("file://" & File.Combine(SharedFolder, FileName)))
End If
Dim f As JavaObject
f.InitializeNewInstance("java.io.File", Array(SharedFolder, FileName))
Dim fp As JavaObject
Dim context As JavaObject
context.InitializeContext
fp.InitializeStatic("android.support.v4.content.FileProvider")
Return fp.RunMethod("getUriForFile", Array(context, Application.PackageName & ".provider", f))
Catch
Log("FileProvider::GetFileUri - error - " & LastException.Message)
Return ""
End Try
End Sub
'Replaces the intent Data field with the file uri.
'Resets the type field. Make sure to call Intent.SetType after calling this method
Sub SetFileUriAsIntentData (Intent As Intent, FileName As String)
Dim jo As JavaObject = Intent
jo.RunMethod("setData", Array(GetFileUri(FileName)))
Intent.Flags = Bit.Or(Intent.Flags, 1) 'FLAG_GRANT_READ_URI_PERMISSION
End Sub

395
B4A/login.bas Normal file
View File

@@ -0,0 +1,395 @@
B4A=true
Group=Default Group
ModulesStructureVersion=1
Type=Class
Version=11.8
@EndOfDesignText@
Sub Class_Globals
Public Root As B4XView 'ignore
Private xui As XUI 'ignore
' Base de datos
Dim reqManager As DBRequestManager
Dim user As String
Dim perfil As String
Dim ID_EMP As String
Dim formato_suc As String
Dim nombre As String
Dim lat_suc As String
Dim long_suc As String
' Elementos
Private b_inicio As Button
Private et_user As EditText
Private et_pass As EditText
Dim sucursal As String
Dim suc_nom As String
Dim nom_proyec As String
Private ImageView5 As ImageView
Private b_regresa As Button
Private b_actualizar_app As Button
Private b_enviarbd As Button
Private b_guarda_server As Button
Private et_server As EditText
Private lv_server As ListView
Private p_configuracion As Panel
Public Provider As FileProvider
Dim horain As String
Dim horaout As String
Dim horacomin As String
Dim horacomout As String
Private p_adorno As Panel
Private l_version As Label
End Sub
'You can add more parameters here.
Public Sub Initialize As Object
Return Me
End Sub
'This event will be called once, before the page becomes visible.
Private Sub B4XPage_Created (Root1 As B4XView)
Root = Root1
Root1.LoadLayout("login")
reqManager.Initialize(Me, Starter.DBReqServer)
Provider.Initialize
l_version.Text = Application.VersionName
End Sub
Sub B4XPage_Appear
If Starter.muestraProgreso = 1 Then
muestraProgreso("Descargando actualización")
Starter.muestraProgreso = 0
End If
p_configuracion.Width = Root.Width
p_configuracion.Height = Root.Height
p_configuracion.Visible = False
p_adorno.Width = Root.Width * 0.85
p_adorno.Height = Root.Height * 0.80
Log("inicio1")
StartService(Tracker)
Starter.rp.CheckAndRequest(Starter.rp.PERMISSION_ACCESS_FINE_LOCATION)
Wait For B4XPage_PermissionResult (Permission As String, Result As Boolean)
If Result Then
StartService(Tracker)
Log("Start Tracker")
Else
ToastMessageShow("Sin permisos para GPS", True)
End If
Log(Result)
' Dim p As Period
' p.Days = 0
' p.Hours = 0
' p.Minutes = 0
' Dim newDate As Long = DateUtils.AddPeriod(DateTime.Now, p)
' Log(newDate)
'
' ' Verificar si hoy es lunes
' If EsLunes(newDate) Then
' Log("¡Hoy es lunes!")
' Else If EsMartes(newDate) Then
' Log("¡Hoy es Martes!")
' Else If EsMiercoles(newDate) Then
' Log("¡Hoy es Miercoles!")
' Else If Esjueves(newDate) Then
' Log("¡Hoy es jueves!")
' Else If Esviernes(newDate) Then
' Log("¡Hoy es Viernes!")
' Else If Essabado(newDate) Then
' Log("¡Hoy es Sabado!")
' Else If EsDomingo(newDate) Then
' Log("¡Hoy es Domingo!")
' End If
End Sub
Private Sub b_inicio_Click
If et_user.Text <> "" Then
Dim cmd As DBCommand
cmd.Initialize
cmd.Name = "select_usuario_GABICO"
cmd.Parameters = Array As Object(et_user.Text, et_pass.Text)
reqManager.ExecuteQuery(cmd , 0, "usuario")
user = et_user.Text
End If
Log(Starter.latitud)
Log(Starter.longitud)
' B4XPages.ShowPage ("Principal")
End Sub
Sub JobDone (Job As HttpJob)
If Job.Success = False Then
ToastMessageShow("Error: " & Job.ErrorMessage, True)
Else
LogColor("JobDone: '" & reqManager.HandleJob(Job).tag & "' - Registros: " & reqManager.HandleJob(Job).Rows.Size, Colors.Green)
If Job.JobName = "DBRequest" Then
Dim result As DBResult = reqManager.HandleJob(Job)
If result.Tag = "usuario" Then 'query tag
For Each records() As Object In result.Rows
For Each k As String In result.Columns.Keys
Log(result.Tag & ": " & k & ": " & records(result.Columns.Get(k)))
Next
If records(result.Columns.Get ("USUARIO")) = "OKActivo" Then
Starter.almacen = records(result.Columns.Get ("CAT_LO_AGENCIA"))
nom_proyec = records(result.Columns.Get ("PRO_NOM"))
perfil = records(result.Columns.Get ("CAT_LO_PERFIL"))
sucursal = records(result.Columns.Get ("CAT_EMP_SUCURSAL"))
suc_nom = records(result.Columns.Get ("SUC_NOMBRE"))
ID_EMP = records(result.Columns.Get ("CAT_LO_ID"))
formato_suc = records(result.Columns.Get ("CAT_SUC_FORMATO"))
nombre = records(result.Columns.Get ("CAT_LO_NOMBRE"))
lat_suc = records(result.Columns.Get ("CAT_SUC_LATITUD"))
long_suc = records(result.Columns.Get ("CAT_SUC_LONGITUD"))
user = et_user.Text
horain = records(result.Columns.Get ("CAT_EMP_HORA_ENTRA"))
horaout = records(result.Columns.Get ("CAT_EMP_HORA_SALE"))
horacomin = records(result.Columns.Get ("CAT_EMP_COMIDA_ENTRA"))
horacomout = records(result.Columns.Get ("CAT_EMP_COMIDA_SALE"))
Dim cmd As DBCommand
cmd.Initialize
cmd.Name = "select_sitrabaja_GABICO"
cmd.Parameters = Array As Object(et_user.Text)
reqManager.ExecuteQuery(cmd , 0, "diatraba")
Else
ToastMessageShow ("Datos incorrectos",True)
End If
Next
If result.Rows.Size = 0 Then
ToastMessageShow ("Datos incorrectos",True)
End If
End If
If result.Tag = "diatraba" Then 'query tag
For Each records() As Object In result.Rows
Starter.trabaja = records(result.Columns.Get("TRABAJA"))
Log(Starter.trabaja)
If Starter.trabaja = 1 Then
If perfil = 3 Then
CallSubDelayed(Starter,"ENVIA_ULTIMA_GPS")
B4XPages.ShowPage("Principal")
Log("AQUI ANDO")
Else If perfil = 2 Then
CallSubDelayed(Starter,"ENVIA_ULTIMA_GPS")
Log("AQUI ACA")
B4XPages.ShowPage("Supervisor")
End If
Else If Starter.trabaja = 0 Then
MsgboxAsync("Hoy es día de descanso","Atención")
End If
Next
' ToastMessageShow(" Historico Clientes Promociones Actualizado." , True)
End If
End If
End If
End Sub
Private Sub B4XPage_CloseRequest As ResumableSub
If p_configuracion.Visible = True Then
p_configuracion.Visible = False
Else
B4XPages.ShowPage("login")
End If
' Return True
Return False
End Sub
Private Sub ImageView5_Click
p_configuracion.Visible = True
lv_server.Clear
lv_server.AddSingleLine("http://keymon.lat:1783")
If et_user.Text = "KMTS1" Then lv_server.AddSingleLine("http://11.0.0.196:1783")
' l_server.Text = Starter.server
et_server.Text = Starter.DBReqServer
End Sub
Private Sub p_configuracion_Click
End Sub
Private Sub lv_server_ItemClick (Position As Int, Value As Object)
Starter.DBReqServer = Value
' l_server.Text = Value
et_server.Text = Value
Starter.reqManager.Initialize(Me, Value)
Log(Value)
ToastMessageShow("Servidor modificado", False)
End Sub
Private Sub b_guarda_server_Click
Starter.skmt.ExecNonQuery2("delete from CAT_VARIABLES where CAT_VA_DESCRIPCION = ?", Array As Object ("SERVER"))
Starter.skmt.ExecNonQuery2("INSERT INTO CAT_VARIABLES(CAT_VA_DESCRIPCION, CAT_VA_VALOR) VALUES (?,?)", Array As Object ("SERVER",et_server.text))
Starter.DBReqServer = et_server.text
Log("Inicializamos reqManager con " & Starter.DBReqServer)
reqManager.Initialize(Me, Starter.DBReqServer)
CallSubDelayed(Starter, "reinicializaReqManager")
p_configuracion.Visible= False
End Sub
Private Sub b_regresa_Click
p_configuracion.Visible = False
End Sub
Private Sub b_enviarbd_Click
' copiaDB
' Sleep(1000)
Dim FileName As String = "kmt.db"
'copy the shared file to the shared folder
Log("xxxxxx:"&Provider.SharedFolder)
Sleep(1000)
File.Copy(File.DirInternal, FileName, Provider.SharedFolder, FileName)
Dim email As Email
email.To.Add("soporte@keymonsoft.com")
email.Subject = "Envio Base de dados Gabinete"
email.Attachments.Add(Provider.GetFileUri(FileName))
' email.Attachments.Add(Provider.GetFileUri(FileName)) 'second attachment
Dim in As Intent = email.GetIntent
in.Flags = 1 'FLAG_GRANT_READ_URI_PERMISSION
StartActivity(in)
End Sub
Private Sub b_actualizar_app_Click
StartService(appUpdater)
End Sub
' appUpdater - Mostramos el anuncio de que se esta descargando el nuevo apk
Sub muestraProgreso(mensaje As String)
ProgressDialogShow(mensaje)
End Sub
'
' appUpdater - Ocultamos el anuncio de que se esta descargando el nuevo apk
Sub ocultaProgreso
ProgressDialogHide
End Sub
Sub notiLowReturn(title As String, Body As String, id As Int) As Notification 'ignore
Private notification As Notification
notification.Initialize2(notification.IMPORTANCE_LOW)
Log("notiLowReturn: "&title)
notification.Icon = "icon"
notification.Sound = False
notification.Vibrate = False
notification.SetInfo(title, Body, Main)
notification.Notify(id)
' Log("notiLowReturn SetInfo")
Return notification
End Sub
'' Función para verificar si la fecha actual es un lunes
'Sub EsLunes(fecha As Long) As Boolean
' ' Crear un objeto Calendar
' Dim cal As JavaObject
' cal.InitializeNewInstance("java.util.GregorianCalendar", Null)
'
' ' Establecer la fecha actual en el objeto Calendar
' cal.RunMethod("setTimeInMillis", Array(fecha))
'
' ' Obtener el día de la semana (1 para domingo, 2 para lunes, ..., 7 para sábado)
' Dim diaSemana As Int = cal.RunMethod("get", Array(7))
'
' ' Verificar si es lunes (día de la semana = 2)
' Return diaSemana = 2
'End Sub
'
'Sub EsMartes(fecha As Long) As Boolean
' ' Crear un objeto Calendar
' Dim cal As JavaObject
' cal.InitializeNewInstance("java.util.GregorianCalendar", Null)
'
' ' Establecer la fecha actual en el objeto Calendar
' cal.RunMethod("setTimeInMillis", Array(fecha))
'
' ' Obtener el día de la semana (1 para domingo, 2 para lunes, ..., 7 para sábado)
' Dim diaSemana As Int = cal.RunMethod("get", Array(7))
'
' ' Verificar si es lunes (día de la semana = 2)
' Return diaSemana = 3
'End Sub
'
'Sub EsMiercoles(fecha As Long) As Boolean
' ' Crear un objeto Calendar
' Dim cal As JavaObject
' cal.InitializeNewInstance("java.util.GregorianCalendar", Null)
'
' ' Establecer la fecha actual en el objeto Calendar
' cal.RunMethod("setTimeInMillis", Array(fecha))
'
' ' Obtener el día de la semana (1 para domingo, 2 para lunes, ..., 7 para sábado)
' Dim diaSemana As Int = cal.RunMethod("get", Array(7))
'
' ' Verificar si es lunes (día de la semana = 2)
' Return diaSemana = 4
'End Sub
'
'Sub Esjueves(fecha As Long) As Boolean
' ' Crear un objeto Calendar
' Dim cal As JavaObject
' cal.InitializeNewInstance("java.util.GregorianCalendar", Null)
'
' ' Establecer la fecha actual en el objeto Calendar
' cal.RunMethod("setTimeInMillis", Array(fecha))
'
' ' Obtener el día de la semana (1 para domingo, 2 para lunes, ..., 7 para sábado)
' Dim diaSemana As Int = cal.RunMethod("get", Array(7))
'
' ' Verificar si es lunes (día de la semana = 2)
' Return diaSemana = 5
'End Sub
'
'Sub Esviernes(fecha As Long) As Boolean
' ' Crear un objeto Calendar
' Dim cal As JavaObject
' cal.InitializeNewInstance("java.util.GregorianCalendar", Null)
'
' ' Establecer la fecha actual en el objeto Calendar
' cal.RunMethod("setTimeInMillis", Array(fecha))
'
' ' Obtener el día de la semana (1 para domingo, 2 para lunes, ..., 7 para sábado)
' Dim diaSemana As Int = cal.RunMethod("get", Array(7))
'
' ' Verificar si es lunes (día de la semana = 2)
' Return diaSemana = 6
'End Sub
'
'Sub Essabado(fecha As Long) As Boolean
' ' Crear un objeto Calendar
' Dim cal As JavaObject
' cal.InitializeNewInstance("java.util.GregorianCalendar", Null)
'
' ' Establecer la fecha actual en el objeto Calendar
' cal.RunMethod("setTimeInMillis", Array(fecha))
'
' ' Obtener el día de la semana (1 para domingo, 2 para lunes, ..., 7 para sábado)
' Dim diaSemana As Int = cal.RunMethod("get", Array(7))
'
' ' Verificar si es lunes (día de la semana = 2)
' Return diaSemana = 7
'End Sub
'
'Sub EsDomingo(fecha As Long) As Boolean
' ' Crear un objeto Calendar
' Dim cal As JavaObject
' cal.InitializeNewInstance("java.util.GregorianCalendar", Null)
'
' ' Establecer la fecha actual en el objeto Calendar
' cal.RunMethod("setTimeInMillis", Array(fecha))
'
' ' Obtener el día de la semana (1 para domingo, 2 para lunes, ..., 7 para sábado)
' Dim diaSemana As Int = cal.RunMethod("get", Array(7))
'
' ' Verificar si es lunes (día de la semana = 2)
' Return diaSemana = 1
'End Sub

110
B4XMainPage.bas Normal file
View File

@@ -0,0 +1,110 @@
B4A=true
Group=Default Group
ModulesStructureVersion=1
Type=Class
Version=9.85
@EndOfDesignText@
#Region Shared Files
'Ctrl + click to sync files: ide://run?file=%WINDIR%\System32\Robocopy.exe&args=..\..\Shared+Files&args=..\Files&FilesSync=True
'###########################################################################################################
'###################### PULL #############################################################
'Ctrl + click ide://run?file=%WINDIR%\System32\cmd.exe&Args=/c&Args=git&Args=pull
'###########################################################################################################
'###################### PUSH #############################################################
'Ctrl + click ide://run?file=%WINDIR%\System32\WindowsPowerShell\v1.0\powershell.exe&Args=github&Args=..\..\
'###########################################################################################################
'###################### PUSH TORTOISE GIT #########################################################
'Ctrl + click ide://run?file=%WINDIR%\System32\WindowsPowerShell\v1.0\powershell.exe&Args=TortoiseGitProc&Args=/command:commit&Args=/path:"./../../"&Args=/closeonend:2
'###########################################################################################################
#End Region
'Ctrl + click to export as zip: ide://run?File=%B4X%\Zipper.jar&Args=Project.zip
Sub Class_Globals
Public Root As B4XView
Private xui As XUI
Dim timer As Timer
' Clases
Public login As login
Dim principal As C_principal
Dim supervisor As C_supervisor
Public updateAvailable As C_UpdateAvailable
End Sub
Public Sub Initialize
' B4XPages.GetManager.LogEvents = True
End Sub
'This event will be called once, before the page becomes visible.
Private Sub B4XPage_Created (Root1 As B4XView)
Root = Root1
Root.LoadLayout("MainPage")
B4XPages.GetManager.TransitionAnimationDuration = 0
login.Initialize
B4XPages.AddPageAndCreate("login",login.Initialize)
timer.Initialize("Timerconteo",1000)
timer.Enabled = True
principal.Initialize
B4XPages.AddPage("Principal", principal)
supervisor.Initialize
B4XPages.AddPage("Supervisor", supervisor)
updateAvailable.Initialize
B4XPages.AddPage("updateAvailable", updateAvailable)
' auxiliar.Initialize
' B4XPages.AddPage("Auxiliar", auxiliar)
' tecnico.Initialize
' B4XPages.AddPage("Tecnico", tecnico)
' salida.Initialize
' B4XPages.AddPage("Salida",salida)
' Tracker
Starter.rp.CheckAndRequest(Starter.rp.PERMISSION_ACCESS_FINE_LOCATION)
Wait For Activity_PermissionResult (Permission As String, Result As Boolean)
If Result Then
StartService(Tracker)
Log("Start Tracker")
Else
ToastMessageShow("No permission", True)
End If
CheckAndRequestNotificationPermission
End Sub
Private Sub B4XPage_Appear
Wait For (CheckAndRequestNotificationPermission) Complete (HasPermission As Boolean)
If HasPermission Then
Log("Con permisos de notificación")
Else
ToastMessageShow("No permission to show notification", True)
End If
End Sub
'Make sure that targetSdkVersion >= 33
Private Sub CheckAndRequestNotificationPermission As ResumableSub
Dim p As Phone
If p.SdkVersion < 33 Then Return True
Dim ctxt As JavaObject
ctxt.InitializeContext
Dim targetSdkVersion As Int = ctxt.RunMethodJO("getApplicationInfo", Null).GetField("targetSdkVersion")
If targetSdkVersion < 33 Then Return True
Dim NotificationsManager As JavaObject = ctxt.RunMethod("getSystemService", Array("notification"))
Dim NotificationsEnabled As Boolean = NotificationsManager.RunMethod("areNotificationsEnabled", Null)
If NotificationsEnabled Then Return True
Dim rp As RuntimePermissions
rp.CheckAndRequest(rp.PERMISSION_POST_NOTIFICATIONS)
Wait For B4XPage_PermissionResult (Permission As String, Result As Boolean) 'change to Activity_PermissionResult if non-B4XPages.
Return Result
End Sub
'You can see the list of page related events in the B4XPagesManager object. The event name is B4XPage.
Sub Timerconteo_tick
B4x_Transition.PrepareTransition_FadeOut(xui, Root.Width, Root.Height, Root, login.Root)
B4XPages.ShowPageAndRemovePreviousPages("login")
timer.Enabled = False
End Sub

1
gitpull.bat Normal file
View File

@@ -0,0 +1 @@
git pull