Files
ADM2/B4A/Starter.bas
Jose Alberto Guerra Ugalde f4fa1e08d1 VERSION 6.01.05
- Se cambio el nombre de las imagenes cuando se realiza a primera venta.
- Se agrego la fecha de la bitacora en todos lados para que siempre ponga inicioi y fin
2026-01-08 20:51:07 -06:00

252 lines
10 KiB
QBasic

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 gps As GPS
Dim skmt As SQL
Dim s As C_Subs
Dim ph As Phone
Public rp As RuntimePermissions
Public FLP As FusedLocationProvider
' Private flpStarted As Boolean
Dim reqManager As DBRequestManager
Dim DBReqServer As String = "http://keymon.net:1781"
' Dim DBReqServer As String = "http://11.0.0.107:1781"
' Dim DBReqServer As String = "http://10.0.0.205:1783"
' Dim DBReqServer As String = "http://192.168.100.10:1781"
Dim Timer1 As Timer
Dim Interval As Int = 300
Dim ruta As String = File.DirInternal
'Para los Logs
Private logs As StringBuilder
Private logcat As LogCat
Dim muestraProgreso = 0
Dim logger As Boolean = False
Dim MAC_IMPRESORA As String
Dim marcaCel As String = ph.manufacturer
Dim tabla As String
Dim pre_viejo As Float
Private BTAdmin As BluetoothAdmin
Public BluetoothState As Boolean
Public fFileProvider As FileProvider
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.
fFileProvider.Initialize
gps.Initialize("GPS")
s.Initialize(Me, "Subs") 'Inicializamos la clase Subs
skmt = s.inicializaBD(File.DirInternal, "kmt.db")
BTAdmin.Initialize("admin")
' CallSubDelayed(FirebaseMessaging, "SubscribeToTopics") 'Para Push FirebaseMessaging
Timer1.Initialize("Timer1", Interval * 1000)
Timer1.Enabled = True
' 'Para los Logs
#if RELEASE
logcat.LogCatStart(Array As String("-v","raw","*:F","B4A:v"), "logcat")
#end if
logs.Initialize
' CallSubDelayed(FirebaseMessaging, "SubscribeToTopics") 'Para Push FirebaseMessaging
End Sub
Private Sub BTAdmin_StateChanged (NewState As Int, OldState As Int)
If logger Then Log("BT state changed: " & NewState)
BluetoothState = NewState = BTAdmin.STATE_ON
' StateChanged
End Sub
Sub Service_Start (StartingIntent As Intent)
Service.StopAutomaticForeground 'Starter service can start in the foreground state in some edge cases.
Subs.revisaBD
' Log(marcaCel)
If s.traeDBReqServerDeBD(skmt) <> "N/A" And s.traeDBReqServerDeBD(skmt) <> "" Then DBReqServer = s.traeDBReqServerDeBD(skmt)
reqManager.Initialize(Me, DBReqServer)
Log($"Starter - |${DBReqServer}|"$)
End Sub
Private Sub Timer1_Tick
' Log("Next run " & DateTime.Time(DateTime.Now + Interval * 1000))
ENVIA_ULTIMA_GPS
End Sub
Sub GPS_LocationChanged (Location1 As Location)
' CallSub2(Main, "GPS_LocationChanged", Location1)
End Sub
Sub Service_TaskRemoved
'This event will be raised when the user removes the app from the recent apps list.
End Sub
Sub Service_Destroy
End Sub
Sub ENVIA_ULTIMA_GPS
Dim logger As Boolean = False
If logger Then LogColor("Iniciamos ENVIA_ULTIMA_GPS", Colors.Magenta)
Dim cmd As DBCommand
' cmd.Initialize
' cmd.Name = "select_fechat"
' B4XPages.MainPage.reqManager.ExecuteQuery(cmd , 0, "fechat")
Dim cmd As DBCommand
cmd.Initialize
cmd.Name = "UPDATE_ADM3_ACTUAL2_GPS"
If B4XPages.MainPage.lat_gps.Length < 15 Then B4XPages.MainPage.lat_gps = B4XPages.MainPage.lat_gps&"0"
cmd.Parameters = Array As Object(B4XPages.MainPage.montoActual, B4XPages.MainPage.clientestotal, B4XPages.MainPage.clientesventa,B4XPages.MainPage.clientesvisitados,B4XPages.MainPage.lat_gps,B4XPages.MainPage.lon_gps,B4XPages.MainPage.batt,0, 0, 0,B4XPages.MainPage.ALMACEN,B4XPages.MainPage.rutapreventa)
If logger Then Log($"montoActual: ${B4XPages.MainPage.montoActual}, cTotal: ${B4XPages.MainPage.clientestotal}, cVenta: ${B4XPages.MainPage.clientesventa}, cVisitados: ${B4XPages.MainPage.clientesvisitados}, ${B4XPages.MainPage.lat_gps}, ${B4XPages.MainPage.lon_gps}, Batt: ${B4XPages.MainPage.batt}, 0, 0, 0, Almacen: ${B4XPages.MainPage.ALMACEN}, Ruta: ${B4XPages.MainPage.rutapreventa}"$)
reqManager.ExecuteCommand(cmd, "inst_visitas")
skmt.ExecNonQuery2("Update cat_variables set CAT_VA_VALOR = ? WHERE CAT_VA_DESCRIPCION = ?" , Array As String(DateTime.Time(DateTime.Now),"HoraIngreso"))
'Reiniciamos el timer para cuando llamamos el Sub desde "seleccion"
Timer1.Enabled = False
Timer1.Interval = Interval * 1000
Timer1.Enabled = True
End Sub
'Para los Logs
Private Sub logcat_LogCatData (Buffer() As Byte, Length As Int)
logs.Append(BytesToString(Buffer, 0, Length, "utf8"))
If logs.Length > 4000 Then
logs.Remove(0, logs.Length - 2000) 'Obtenemos log de 2000 ~ 4000 chars
End If
End Sub
'Return true to allow the OS default exceptions handler to handle the uncaught exception. 'Para los Logs
Sub Application_Error (Error As Exception, StackTrace As String) As Boolean
'wait for 500ms to allow the logs to be updated.
Dim jo As JavaObject
Dim l As Long = 500: jo.InitializeStatic("java.lang.Thread").RunMethod("sleep", Array(l)) 'Sleep 500ms
logcat.LogCatStop
logs.Append(StackTrace)
Subs.revisaBD
Subs.errorLog.ExecNonQuery2("INSERT INTO errores(fecha, error) VALUES (?,?)", Array As Object (Subs.fechaKMT(DateTime.now), logs))
Return True
End Sub
'Inicializa el reqServer con la dirección dada y lo guarda en CAT_VARIABLES.
Sub reinicializaReqManager(srv As String)
skmt.ExecNonQuery2("delete from CAT_VARIABLES where CAT_VA_DESCRIPCION = ?", Array As Object ("SERVER"))
skmt.ExecNonQuery2("INSERT INTO CAT_VARIABLES(CAT_VA_DESCRIPCION, CAT_VA_VALOR) VALUES (?,?)", Array As Object ("SERVER", srv))
DBReqServer = srv
reqManager.Initialize(Me, srv)
LogColor(srv, Colors.red)
End Sub
Sub JobDone(Job As HttpJob)
Log("JOBDONE STARTER")
Try
If reqManager.reqsList.IsInitialized Then 'Si tenemos lista de requests, la procesamos.
If reqManager.reqsList.IndexOf(Job.tag) <> -1 Then
reqManager.reqsList.RemoveAt(reqManager.reqsList.IndexOf(Job.tag))
' LogColor($">>>>>> Quitamos ${Job.tag}"$, Colors.Blue)
End If
' LogColor(">>>>>> " & reqManager.reqsList.Size & " - " & reqManager.reqsList, Colors.Blue)
End If
If Job.Success = False Then
LogColor("############################################", Colors.red)
LogColor("###### JobError: " & Job.Tag & CRLF & Job.ErrorMessage, Colors.red)
LogColor("############################################", Colors.red)
' LogColor("Error2: " & Job.ErrorMessage, Colors.red)
' LogColor("Error1: " & reqManager.HandleJob(Job).tag, Colors.red)
' LogColor("Error: " & reqManager.HandleJob(Job).tag & " : " & Job.ErrorMessage, Colors.red)
' Job.Release
Else 'If Job Success then ...
' Log(3)
LogColor("JobDone: '" & reqManager.HandleJob(Job).tag & "' - Registros: " & reqManager.HandleJob(Job).Rows.Size, Colors.RGB(0,160,0)) 'Mod por CHV - 211027
'Verificamos que el usuario guardado en BD sea VALIDO.
If Job.JobName = "DBRequest" Then
Dim result As DBResult = reqManager.HandleJob(Job)
' For Each records() As Object In result.Rows
' Log("==========================REGISTROS="&result.Rows)
' For Each k As String In result.Columns.Keys
' Log(result.Tag & ": " & k & ": " & records(result.Columns.Get(k)))
' Next
' Next
'HISTORIAL DE UBICACIONES (Tracker)
If result.Tag.As(String).StartsWith("guardaHistorialUbicaciones_") Then
For Each records() As Object In result.Rows
Private id() As String = Regex.Split("_", result.tag)
If id.Length > 1 Then
For Each k As String In result.Columns.Keys
' Log(result.Tag & ": " & k & ": " & records(result.Columns.Get(k)))
skmt.ExecNonQuery($"update HIST_UBICACIONES set HU_ENVIADO = 1 where HU_ID = '${id(1)}'"$)
' Log($"update bitacoragps set enviado = 1 where id = '${id(1)}'"$)
Next
End If
Next
End If
End If
End If
' Log(">>>>> Job.Release Starter")
Job.Release
Catch
Log(LastException)
End Try
End Sub
Sub mandaForma(almacen_ As String, ruta_ As String, cliente_ As String, imagen_ As String)
' 1. Inicializa un nuevo HttpJob
Dim job As HttpJob
job.Initialize("", Me)
' 2. Define la URL del servidor
Dim url As String = "https://keymon.net/ADM/POST_IMAGEN.aspx"
' 3. Crea un Map para los campos de texto del formulario
Dim params As Map
params.Initialize
params.Put("Almacen", almacen_)
params.Put("Ruta", ruta_)
params.Put("Cliente", cliente_)
params.Put("btnUpload", "Subir Imagen") ' El botón de submit también envía su valor
' --- CAMPOS OCULTOS DE ASP.NET ---
' Estos valores suelen ser dinámicos. Para este ejemplo, los ponemos fijos.
' Si falla, es posible que primero necesites hacer un GET a la página para obtener los valores actualizados.
' params.Put("__VIEWSTATE", "/wEPDwUKMjA1ODU4NjY1MGRkhSExd19qC1l3GdX6jvTnbM9pxPQR8urGAvs76UsqsDU=")
' params.Put("__VIEWSTATEGENERATOR", "6050E242")
' params.Put("__EVENTVALIDATION", "/wEdAAX5q9hoCUC745WBVO+/1ZWhraEDRZI2xn7OC3a5LAUoRlfyZCZSVcs/gLubOxTf2dCyEN4makXuwRjezU2tU1hn5vhDofrSSRcWtmHPtJVt4HHStaEfV6fkOi3uRRJDHybxwaB9FuVcVFxi7uoxeGMX")
' 4. Crea una lista de archivos a subir
Dim files As List
files.Initialize
' Creamos el objeto MultipartFileData para nuestra imagen
' KeyName: Es el atributo "name" del input en HTML ("Imagen")
' ContentType: El tipo de archivo
Dim mfd As MultipartFileData = Subs.CreateMultipartFileData(File.DirInternal, imagen_, "Imagen", "image/jpeg")
files.Add(mfd)
' 5. Realiza la petición POST de tipo multipart
job.PostMultipart(url, params, files)
' 6. Espera a que el trabajo termine
Wait For (job) JobDone(job As HttpJob)
If job.Success Then
' El servidor respondió correctamente (HTTP 200 OK)
Log("Respuesta del servidor: " & job.GetString)
skmt.ExecNonQuery2("delete from CAT_VARIABLES where CAT_VA_DESCRIPCION = ?", Array As Object ("FOTO_INICIAL"))
skmt.ExecNonQuery2("INSERT INTO CAT_VARIABLES(CAT_VA_DESCRIPCION, CAT_VA_VALOR) VALUES (?,?)", Array As Object ("FOTO_INICIAL", "ENVIADA"))
' MsgboxAsync("¡Imagen subida con éxito!", "Completado")
Else
' Hubo un error en la conexión o el servidor respondió con un error
Log("Error al subir la imagen: " & job.ErrorMessage)
' MsgboxAsync("Error: " & job.ErrorMessage, "Fallo")
End If
' Libera los recursos del job
job.Release
End Sub