Commit inicial
2
.gitignore
vendored
Normal file
@@ -0,0 +1,2 @@
|
||||
**/Objects
|
||||
**/AutoBackups
|
||||
223
B4A/B4x_Transition.bas
Normal 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
@@ -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
@@ -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
1507
B4A/C_supervisor.bas
Normal file
403
B4A/CameraExClass.bas
Normal 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
@@ -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
@@ -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
|
After Width: | Height: | Size: 632 B |
BIN
B4A/Files/atras.png
Normal file
|
After Width: | Height: | Size: 3.1 KiB |
BIN
B4A/Files/camara.png
Normal file
|
After Width: | Height: | Size: 2.1 KiB |
BIN
B4A/Files/derecha.png
Normal file
|
After Width: | Height: | Size: 8.4 KiB |
BIN
B4A/Files/engranes.png
Normal file
|
After Width: | Height: | Size: 8.7 KiB |
BIN
B4A/Files/frintal.png
Normal file
|
After Width: | Height: | Size: 3.2 KiB |
BIN
B4A/Files/from2.png
Normal file
|
After Width: | Height: | Size: 7.3 KiB |
BIN
B4A/Files/gabinete.jpg
Normal file
|
After Width: | Height: | Size: 19 KiB |
BIN
B4A/Files/gabinete.png
Normal file
|
After Width: | Height: | Size: 13 KiB |
BIN
B4A/Files/gabinete1.png
Normal file
|
After Width: | Height: | Size: 19 KiB |
BIN
B4A/Files/gestion.bal
Normal file
BIN
B4A/Files/gestion_sup.bal
Normal file
BIN
B4A/Files/gestiones.bal
Normal file
BIN
B4A/Files/izquierda.png
Normal file
|
After Width: | Height: | Size: 8.4 KiB |
BIN
B4A/Files/kmt.db
Normal file
BIN
B4A/Files/login.bal
Normal file
BIN
B4A/Files/mainpage.bal
Normal file
BIN
B4A/Files/mas.png
Normal file
|
After Width: | Height: | Size: 550 B |
BIN
B4A/Files/menos.png
Normal file
|
After Width: | Height: | Size: 468 B |
BIN
B4A/Files/principal.bal
Normal file
BIN
B4A/Files/qr.png
Normal file
|
After Width: | Height: | Size: 1.1 KiB |
BIN
B4A/Files/roit.png
Normal file
|
After Width: | Height: | Size: 23 KiB |
BIN
B4A/Files/supervisor.bal
Normal file
253
B4A/FirebaseMessaging.bas
Normal 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
@@ -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.
|
||||
51
B4A/Gabinete roit.b4a.meta
Normal 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -0,0 +1 @@
|
||||
git pull
|
||||