image
External Storage - Simple Example

2021-04-21 12:11:16 by Omar
Original Link Author Link
                                    'Creates folder in the destination folder selected
'Copies file from DirInternal
Sub FiletoExtStorage(DirName As String,FileToCopy As String)
        Dim inpstr As InputStream          = File.OpenInput(File.DirInternal,FileToCopy)         'Create an Inputstream from the Sourcefile to copy

        Dim DirName1 As ExternalFile     = Storage.FindDirOrCreate(Storage.Root, DirName)       'creates the folder
        Dim destfile As ExternalFile     = Storage.CreateNewFile(DirName1,FileToCopy)           'create the file
        Dim os As OutputStream             = Storage.OpenOutputStream(destfile)                    'Create an Outputstream to the destfile
        
        File.Copy2(inpstr,os)                                                                  'Copy file
        inpstr.Close                                                                        'Close inputstr
        os.Close                                                                              'Close Outputstream
End Sub


Sub SetTestFiles
    FileName1= "RodTest1.txt"
    File.WriteString(File.DirInternal, FileName1, "jaklsdjalksdjalskdjasld")               
    
    Filename2= "RodTest2.txt"
    File.WriteString(File.DirInternal, Filename2, "qwertyqwerty")               
    
End Sub


Sub btnTest_Click
    SetTestFiles
    Storage.SelectDir(True)
    Wait For Storage_ExternalFolderAvailable
    FiletoExtStorage("Terminations",FileName1)            ' Directory and File to Send
    FiletoExtStorage("Terminations",Filename2)            ' Directory and File to Send
End Sub

Public Sub FindDirOrCreate(Parent As ExternalFile, Name As String) As ExternalFile
    Dim f As ExternalFile = FindFile(Parent, Name)
    If f.IsInitialized = False Then
        Return DocumentFileToExternalFile(Parent.Native.RunMethod("createDirectory", Array(Name)))
    Else
        Return f
    End If
End Sub


                                

Android - B4A Multiplatform - B4X

TAGS : External Storage,b4a
image
SaveAs - Let the user select a target folder

2021-04-22 13:21:55 by Omar
Original Link Author Link
                                    Sub SaveAs (Source As InputStream, MimeType As String, Title As String) As ResumableSub
    Dim intent As Intent
    intent.Initialize("android.intent.action.CREATE_DOCUMENT", "")
    intent.AddCategory("android.intent.category.OPENABLE")
    intent.PutExtra("android.intent.extra.TITLE", Title)
    intent.SetType(MimeType)
    StartActivityForResult(intent)
    Wait For ion_Event (MethodName As String, Args() As Object)
    If -1 = Args(0) Then 'resultCode = RESULT_OK
        Dim result As Intent = Args(1)
        Dim jo As JavaObject = result
        Dim ctxt As JavaObject
        Dim out As OutputStream = ctxt.InitializeContext.RunMethodJO("getContentResolver", Null).RunMethod("openOutputStream", Array(jo.RunMethod("getData", Null)))
        File.Copy2(Source, out)
        out.Close
        Return True
    End If
    Return False
End Sub

Sub StartActivityForResult(i As Intent)
    Dim jo As JavaObject = GetBA
    ion = jo.CreateEvent("anywheresoftware.b4a.IOnActivityResult", "ion", Null)
    jo.RunMethod("startActivityForResult", Array(ion, i))
End Sub

Sub GetBA As Object
    Dim jo As JavaObject = Me
    Return jo.RunMethod("getBA", Null)
End Sub


HOW TO USE (B4XPages)

Private Sub Button1_Click
    File.WriteString(File.DirInternal, "test.txt", "test") 'just for the example.
    Wait For (SaveAs(File.OpenInput(File.DirInternal, "test.txt"), "application/octet-stream", "test.txt")) Complete (Success As Boolean)
    Log("File saved successfully? " & Success)
End Sub

HOW TO USE (SIMPLE)

Sub GetBA As Object
   Dim jo As JavaObject
   Dim cls As String = Me
   cls = cls.SubString("class ".Length)
   jo.InitializeStatic(cls)
   Return jo.GetField("processBA")
End Sub

                                

Android - B4A iOS - B4i Desktop - B4J Multiplatform - B4X

TAGS : ContentChooser, SAVE AS, user select target folder
image
Firestore API REST

2021-04-22 13:26:53 by Omar
Original Link Author Link
                                    ' READ DOCUMENT

Public Sub getDocument(Coleccion As String) As ResumableSub
   
    Dim link As String = $"https://firestore.googleapis.com/v1/projects/{projectId}/databases/(default)/documents/${Coleccion}"$

       
    Dim okHttp As HttpJob
    okHttp.Initialize("HTTP", Me)
   
    okHttp.Download(link & "info_chats")
    Wait For (okHttp) JobDone(j As HttpJob)
       
    If j.Success Then
       
        Log(j.GetString)
        Dim jsonString As JSONParser
        jsonString.Initialize(j.GetString)
        Dim map As Map = jsonString.NextObject

        Return map
       
    Else
        Log(j.ErrorMessage)
    End If

End Sub

Example:
Wait For (getDocument("server/names")) Complete(m As Map)

' VALUES:


Public Sub patchValues(Token As String, collection As String, Campos As Map) As ResumableSub
   
    Dim url As String = $"https://firestore.googleapis.com/v1/projects/{projectId}/databases/(default)/documents${collection}"$'?documentId=${Documento}"$
    Dim Json As JSONGenerator
    Json.Initialize(CreateMap("fields":Campos))
   
    Dim j As HttpJob : j.Initialize("",Me)
    Log(Json.ToString)
   
    j.PatchString(url,Json.ToString)
    j.GetRequest.SetHeader("Authorization","Bearer " & Token)
    j.GetRequest.SetContentType("application/json")
   
    Wait For (j) JobDone(j As HttpJob)
    Return GenerateResult(j)

End Sub

' Example:


Wait For (patchValues(UserTokenId, "info_chats/id_group_chat1", CreateMap("name" : CreateMap("stringValue": "Paolo")))) Complete(m As Map)


' Create document:



Public Sub createDocument(Token As String, collection As String, Documento As String, Campos As Map) As ResumableSub
   
    Dim url As String = $"https://firestore.googleapis.com/v1/projects/{projectId}/databases/(default)/documents/${collection}?documentId=${Documento}"$
    Dim json As JSONGenerator
    json.Initialize(CreateMap("fields":Campos))
   
    Dim j As HttpJob : j.Initialize("",Me)
    Log(json.ToString)
    j.PostString(url,json.ToString)
    j.GetRequest.SetHeader("Authorization","Bearer " & Token)
    j.GetRequest.SetContentType("application/json")
   
    Wait For (j) JobDone(j As HttpJob)
    Return GenerateResult(j)

End Sub

' Example:
Wait For (Firestore.createDocument(UserTokenId, "info_chats","Profile", CreateMap("name" : CreateMap("stringValue": "Paolo")))) Complete(m As Map)

' Deletedocument:


Public Sub deleteDocument(Token As String, collection As String) As ResumableSub
   
    Dim url As String = $"https://firestore.googleapis.com/v1/projects/{projectid}/databases/(default)/documents/${collection}"$'?documentId=${Documento}"$

    Dim j As HttpJob : j.Initialize("",Me)
    j.Delete(url)
    j.GetRequest.SetHeader("Authorization","Bearer " & Token)
   
    Wait For (j) JobDone(j As HttpJob)
    Return GenerateResult(j)

End Sub

'EXAMPLE:
Wait For (Firestore.deleteDocument(UserTokenId, "info_chats/Profile")) Complete(m As Map)

' SUJESTED USE OF CODE WITH MAP
Private Sub GenerateResult(j As HttpJob) As Map
    Dim response As String = ""
    If j.Success Then
        response = j.GetString
        Log(j.GetString)
    Else
        response = j.ErrorMessage
    End If
    
    Dim parser As JSONParser
    parser.Initialize(response)
    Dim tmp_result As Map = parser.NextObject
    tmp_result.Put("success",j.Success)
    
    j.Release
    Return tmp_result
End Sub








                                

Android - B4A iOS - B4i Desktop - B4J Multiplatform - B4X

TAGS : Firestore API REST, firestore, api
image
B4XDialog - show with animation

2021-04-22 13:29:04 by Omar
Original Link Author Link
                                    

Sub AnimateDialog (dlg As B4XDialog, FromEdge As String)
    Dim base As B4XView = dlg.Base
    Dim top As Int = base.Top
    Dim left As Int = base.Left
    Select FromEdge.ToLowerCase
        Case "bottom"
            base.Top = base.Parent.Height
        Case "top"
            base.Top = -base.Height
        Case "left"
            base.Left = -base.Width
        Case "right"
            base.Left = base.Parent.Width
    End Select
    base.SetLayoutAnimated(300, left, top, base.Width, base.Height)
End Sub


' HOW TO USE:
Sub Globals
    Private dialog As B4XDialog
    Private xui As XUI
End Sub

Sub Activity_Create(FirstTime As Boolean)
    dialog.Initialize(Activity)
    dialog.Title = "test"
End Sub

Sub Activity_Click
    Dim rs As Object = dialog.Show("aaa", "Ok", "Not Ok", "")
    AnimateDialog(dialog, "right")
    Wait For (rs) Complete (Result As Int)
    If Result = xui.DialogResponse_Positive Then
        '...
    End If
End Sub

 
                                

Android - B4A iOS - B4i Desktop - B4J Multiplatform - B4X

TAGS : dialog, animation, dialog animation
image
Wait for - Example

2021-04-26 23:35:50 by Omar
Original Link Author Link
                                    Dim j As HttpJob
j.Initialize("", Me)
j.Download("https://www.google.com")
Wait For (j) JobDone(j As HttpJob)
If j.Success Then
   Log(j.GetString)
End If
j.Release
                                

Android - B4A iOS - B4i Desktop - B4J Multiplatform - B4X

TAGS : WAIT FOR, download
image
Download quote from API

2021-04-26 23:42:57 by Omar
Original Link Author Link
                                    Sub DownloadQuote
   Dim j As HttpJob
   j.Initialize("", Me) 'name is empty as it is no longer needed
   j.Download("http://quotesondesign.com/wp-json/posts?filter[orderby]=rand")
   Wait For (j) JobDone(j As HttpJob)
   If j.Success Then
     'The result is a json string. We parse it and log the fields.
     Dim jp As JSONParser
     jp.Initialize(j.GetString)
     Dim quotes As List = jp.NextArray
     For Each quot As Map In quotes
       Log("Title: " & quot.Get("title"))
       Log("Content: " & quot.Get("content"))
     Next
   End If
   j.Release
End Sub
                                

Android - B4A iOS - B4i Desktop - B4J Multiplatform - B4X

TAGS : download quote, download, wait for
image
Download Multiple resources one after another

2021-04-27 12:46:18 by Omar
Original Link Author Link
                                    

Sub Activity_Create(FirstTime As Boolean)
   DownloadMany(Array("http://www.google.com", "http://duckduckgo.com", "http://bing.com"))
End Sub

Sub DownloadMany (links As List)
   For Each link As String In links
     Dim j As HttpJob
     j.Initialize("", Me) 'name is empty as it is no longer needed
     j.Download(link)
     Wait For (j) JobDone(j As HttpJob)
     If j.Success Then
       Log("Current link: " & link)
       Log(j.GetString)
     End If
     j.Release
   Next
End Sub


                                

Android - B4A iOS - B4i Desktop - B4J Multiplatform - B4X

TAGS : wait for, donwload
image
Download Image an set on Imageview

2021-04-27 12:48:38 by Omar
Original Link Author Link
                                    

Sub DownloadImage(Link As String, iv As ImageView)
   Dim j As HttpJob
   j.Initialize("", Me)
   j.Download(Link)
   Wait For (j) JobDone(j As HttpJob)
   If j.Success Then
     iv.Bitmap = j.GetBitmap
   End If
   j.Release
End Sub


                                

Android - B4A iOS - B4i Desktop - B4J Multiplatform - B4X

TAGS : download image , imageview
image
Download an Image an save locally

2021-04-27 12:50:26 by Omar
Original Link Author Link
                                    Sub DownloadAndSaveFile (Link As String)
   Dim j As HttpJob
   j.Initialize("", Me)
   j.Download(Link)
   Wait For (j) JobDone(j As HttpJob)
   If j.Success Then
       Dim out As OutputStream = File.OpenOutput(File.DirInternal, "filename.dat", False)
     File.Copy2(j.GetInputStream, out)
     out.Close ------ very important
   End If
   j.Release
End Sub
                                

Android - B4A iOS - B4i Desktop - B4J Multiplatform - B4X

TAGS : download image, save image locally
image
FTP Server implemented with Socket and AsyncStreams

2021-04-28 15:01:05 by Omar
Original Link Author Link
                                    

server.Initialize(Main, "FTPServer")
server.SetPorts(51041, 51042, 51142)
server.AddUser("Test", "test") 'user name and password.
server.BaseDir = File.DirRootExternal
server.Start


                                

Android - B4A Multiplatform - B4X

TAGS : ftp server
62a4941d7937a718c0342804f093e85f.zip62a4941d7937a718c0342804f093e85f.zip
image
FTP Server implemented with Socket and AsyncStreams

files are included

2021-04-28 18:55:34 by Omar
Original Link Author Link
                                    server.Initialize(Main, "FTPServer")
server.SetPorts(51041, 51042, 51142)
server.AddUser("Test", "test") 'user name and password.
server.BaseDir = File.DirRootExternal
server.Start
                                

Android - B4A iOS - B4i Desktop - B4J Multiplatform - B4X

TAGS : ftp server
FTPServer_b4xsnippets.com.b4xlibB4A_FTPServer_b4xsnippets.com.zip
image
Confirm Dialog

The sample shows how to delete a file, previously shows a dialog with 3 options the "yes" return -1, the rest cancel the dialog

2022-02-10 03:05:05 by Omar
Original Link Author Link
                                    Private Sub swbtnDelete_Click
	Dim confirmDialog As B4XDialog
	confirmDialog.Initialize(Root)
	
	Wait For (confirmDialog.Show("Sure?", "YES", "NO", "CANCEL")) Complete (Result As Int)
	If Result = xui.DialogResponse_Positive Then
		Log(Result)
		File.Delete(xui.DefaultFolder & "privateCABINET" ,listofpics.Get(currentPreviewIndexfile))
		pnlPreview.Visible=False
	End If
	
End Sub
                                

Android - B4A iOS - B4i Desktop - B4J Multiplatform - B4X

TAGS : confirm dialog, confim, dialog
image
Save Bitmap on file

Note XUI.DefaultFolder, image could be rotated on iOS

2022-02-13 17:58:27 by Omar
Original Link Author Link
                                    Dim Out As OutputStream
Out = File.OpenOutput(XUI.DefaultFolder, "Test.png", False)
Bitmap1.WriteToStream(out, 100, "PNG")
Out.Close
                                

Multiplatform - B4X

TAGS : save, bitmap
image
Number of weeks between 2 dates

2022-02-17 13:19:30 by Omar
Original Link Author Link
                                    Public Sub NumberOfWeeksBetween(StartDate As Long,EndDate As Long) As Int
    Return Round(DateUtils.PeriodBetweenInDays(StartDate,EndDate).Days / 7)
End Sub
                                

Multiplatform - B4X

TAGS : date,weeks
image
Count specific week days in a month

2022-02-17 13:24:07 by Omar
Original Link Author Link
                                    Sub CountSpecificDaysInMonth (Year As Int, Month As Int, RelevantDays As B4XSet) As Int
    Dim day As Long = DateUtils.SetDate(Year, Month, 1)
    Dim p As Period
    p.Days = 1
    Dim total As Int
    Do While DateTime.GetMonth(day) = Month
        If RelevantDays.Contains(DateTime.GetDayOfWeek(day)) Then total = total + 1
        day = DateUtils.AddPeriod(day, p)
    Loop
    Return total
End Sub

HOW TO USE :


Sub AppStart (Args() As String)
    Dim InterestingDays As B4XSet = B4XCollections.CreateSet2(Array(1, 2, 3, 4, 5)) 'number of days excluding Friday and Saturday
    Log(CountSpecificDaysInMonth(2020, 12, InterestingDays)) 'December 2020
End Sub


                                

Multiplatform - B4X

TAGS : date,days,month
image
Custome Font CreateB4XFont

How to use a custom Font

2022-02-17 20:45:17 by Omar
Original Link Author Link
                                    REQUIRED ON iOS
#Region  Project Attributes
    #AppFont: D3-Biscuitism-Bold.ttf
#End Region
REQUIRED ON iOS

Public Sub CreateB4XFont(FontFileName As String, FontSize As Float, NativeFontSize As Float) As B4XFont
	#IF B4A
		Return xui.CreateFont(Typeface.LoadFromAssets(FontFileName), FontSize)
	#ELSE IF B4I
		Return xui.CreateFont(Font.CreateNew2(FontFileName, NativeFontSize), FontSize)
	#ELSE ' B4J
		Return xui.CreateFont(FX.LoadFont(File.DirAssets, FontFileName, NativeFontSize), FontSize)
	#END IF
End Sub

on a button click event :
Private Sub Button1_Click
	Label1.Font = CreateB4XFont("D3_Biscuitism_Bold.ttf", 30, 30)
End Sub

******* OTHER SAMPLE FROM OMAR PARRA ****


    'Add in main APP B4i
    '#AppFont: Courier-New.ttf
    
    Dim FontCourierNew As B4XFont
    
    #If B4A
    FontCourierNew = xui.CreateFont(Typeface.LoadFromAssets("Courier-New.ttf"),62)
    #Else If B4J
    Dim fx As JFX
    FontCourierNew = xui.CreateFont(fx.LoadFont(File.DirAssets,"Courier-New.ttf",62),62)
    #Else
    FontCourierNew = xui.CreateFont(Font.CreateNew2("Courier-New.ttf",62),62)
    #End If
    
    Button1.Font = FontCourierNew
    Button1.TextSize = 18


                                

Multiplatform - B4X

TAGS : custome font, fonts
image
Using CURL on B4X

CURL usage on B4X

2022-02-18 05:04:30 by Omar
Original Link Author Link
                                    * Search image in imgur by keyword:
curl --location -g --request GET 'https://api.imgur.com/3/gallery/search?q=monkey' --header 'Authorization: Client-ID {{clientId}}'



' Search keyword of image (i.e. anonymous get)
Public Sub sendGetRequest() As ResumableSub
    Dim url2 As String = "https://api.imgur.com/3/gallery/search"
    Dim auth As String = "Client-ID " & m_clientid    '<-- your client id
    Dim job As HttpJob
    job.Initialize("get", Me)
    job.Download2(url2, Array As String("q", "monkey"))
    job.GetRequest.SetHeader("authorization", auth)
    Wait For (job) JobDone(j As HttpJob)
    If j.Success Then
        Log(j.GetString)
        Return True
    End If
    Return False
End Sub

*Upload image anonymously to imgur:


curl --location --request POST 'https://api.imgur.com/3/image' --header 'Authorization: Client-ID {{clientId}}' --form 'image="R0lGODlhAQABAIAAAAAAAP///yH5BAEAAAAALAAAAAABAAEAAAIBRAA7"'



' Anonymous upload
Public Sub sendPostRequest() As ResumableSub
    Dim url As String = "https://api.imgur.com/3/image"
    Dim auth As String = "Client-ID " & m_clientid '<-- your client id
    Dim job As HttpJob
    job.Initialize("post", Me)
    Dim mapData As Map
    mapData.Initialize
    mapData.Put("image", "R0lGODlhAQABAIAAAAAAAP///yH5BAEAAAAALAAAAAABAAEAAAIBRAA7")
    mapData.Put("type", "base64")
    'Dim jsonGen As JSONGenerator
    'jsonGen.Initialize(mapData)
    job.PostMultipart(url, mapData, Null)
    job.GetRequest.SetHeader("Authorization", auth)
    Wait For (job) JobDone(j As HttpJob)
    If j.Success Then
        Log(j.GetString)
        Return True
    End If
    Return False
End Sub

* Upload image to imgur account (i.e. non-anonymous):


curl -X POST -H "Authorization: Bearer {{accessToken}}" -F "image=R0lGODlhAQABAIAAAAAAAP///yH5BAEAAAAALAAAAAABAAEAAAIBRAA7" https://api.imgur.com/3/upload




' Non-anonymous upload to user's account
Public Sub sendPostRequest2() As ResumableSub
    Dim url As String = "https://api.imgur.com/3/upload"
    Dim auth As String = "BEARER " & m_accesstoken '<-- your access token
    Dim job As HttpJob
    job.Initialize("post", Me)
    Dim mapData As Map
    mapData.Initialize
    mapData.Put("image", "R0lGODlhAQABAIAAAAAAAP///yH5BAEAAAAALAAAAAABAAEAAAIBRAA7")
    mapData.Put("type", "base64")
    job.PostMultipart(url, mapData, Null)
    job.GetRequest.SetHeader("Authorization", auth)
    Wait For (job) JobDone(j As HttpJob)
    If j.Success Then
        Log(j.GetString)
        Return True
    End If
    Return False
End Sub





                                

Multiplatform - B4X

TAGS : curl,upload,download,imgur
image
Check if an Email is valid

2022-02-18 05:34:22 by Omar
Original Link Author Link
                                    

Private Sub EmailAddressCheck(email As String) As Boolean   
    Return Regex.IsMatch("^[a-zA-Z][\w\.-]*[a-zA-Z0-9]@[a-zA-Z0-9][\w\.-]*[a-zA-Z0-9]\.[a-zA-Z][a-zA-Z\.]*[a-zA-Z]$",email)
End Sub

HOW TO USE IT


If EmailAddressCheck("test@b4x.de") = True Then
        Log("E-Mail is valid")
        Else
        Log("E-Mail is not valid")
    End If



                                

Multiplatform - B4X

TAGS : email,verify,check
image
Create a Square thumbnail

2022-02-18 05:38:39 by Omar
Original Link Author Link
                                    
Sub CreateSquareThumbnail(Input As B4XBitmap) As B4XBitmap
    If Input.Width <> Input.Height Then
        'if the image is not square then we crop it to be a square.
        Dim l As Int = Min(Input.Width, Input.Height)
        Return Input.Crop(Input.Width / 2 - l / 2, Input.Height / 2 - l / 2, l, l)
    Else
        Return Input
    End If
End Sub


USAGE 


CreateSquareThumbnail(xui.LoadBitmapResize(File.DirAssets,"Snapchat-248558753.jpg",150dip,150dip,True))


                                

Multiplatform - B4X

TAGS : thumbnail,square
image
Create a round image

2022-02-18 05:51:09 by Omar
Original Link Author Link
                                    
'xui is a global XUI variable.
Sub CreateRoundBitmap (Input As B4XBitmap, Size As Int) As B4XBitmap
   If Input.Width <> Input.Height Then
       'if the image is not square then we crop it to be a square.
       Dim l As Int = Min(Input.Width, Input.Height)
       Input = Input.Crop(Input.Width / 2 - l / 2, Input.Height / 2 - l / 2, l, l)
   End If
   Dim c As B4XCanvas
   Dim xview As B4XView = xui.CreatePanel("")
   xview.SetLayoutAnimated(0, 0, 0, Size, Size)
   c.Initialize(xview)
   Dim path As B4XPath
   path.InitializeOval(c.TargetRect)
   c.ClipPath(path)
   c.DrawBitmap(Input.Resize(Size, Size, False), c.TargetRect)
   c.RemoveClip
   c.DrawCircle(c.TargetRect.CenterX, c.TargetRect.CenterY, c.TargetRect.Width / 2 - 2dip, xui.Color_White, False, 5dip) 'comment this line to remove the border
   c.Invalidate
   Dim res As B4XBitmap = c.CreateBitmap
   c.Release
   Return res
End Sub

HOW TO USE 


'ImageView1 type is B4XView
Dim img As B4XBitmap = xui.LoadBitmap(File.DirAssets, "myimage.jpg")
ImageView1.SetBitmap(CreateRoundBitmap(img, ImageView1.Width))


OR


Dim xIV As B4XView = ImageView1
xIV.SetBitmap(CreateRoundBitmap(img, xIV .Width))


                                

Multiplatform - B4X

TAGS : thumbnail,round,circle
image
JWT Login

2022-02-25 13:41:06 by Omar
Original Link Author Link
                                    Sub Login
    Dim j As HttpJob
    j.Initialize("", Me) 'name is empty as it is no longer needed
    j.Download("http://xxx.xxx/peru/api/?action=login&username=admin&password=master")
    Wait For (j) JobDone(j As HttpJob)
    If j.Success Then
        Dim parser As JSONParser
        parser.Initialize(j.GetString)
        Dim root As Map = parser.NextObject
        Dim JWT As String = root.Get("JWT")
        Pass = JWT
        Log("Password: " & Pass)
    End If
    j.Release
End Sub

' after login and save the token, we can use :
Sub AddTask
    Dim j As HttpJob
    j.Initialize("", Me) 'name is empty as it is no longer needed
    j.Download("http://192.168.1.136/peru/api/?action=add&object=tareas&descripcion=PRUEBA DE METER&fecha='2019-04-17'&asignada='SI'&completada='NO'")
    j.GetRequest.SetHeader("X-Authorization","Bearer " & Pass)
    Wait For (j) JobDone(j As HttpJob)
    If j.Success Then
        Log("Añadido con éxito: " & j.GetString)
    End If
    j.Release
End Sub
                                

Multiplatform - B4X Other

TAGS : jwt,login,token
image
MAP to Json convert

2022-02-25 22:19:30 by Omar
Original Link Author Link
                                    

Sub MapToJSON(sm As Map, bEnclose As Boolean) As String
    ' convert a map to a json string and specify if you want the
    ' returned string enclosed, the default behavour is true
    ' clean the map values and ensure there is no quoted values or keys
    Dim mout As Map
    mout.Initialize 
    For Each mKey As String In sm.Keys
        ' get value for each key
        Dim mValue As String = sm.Get(mKey)
        mValue = mValue.Replace(QUOTE, "")
        mKey = mKey.Replace(QUOTE,"")
        mout.Put(mKey, mValue)
    Next
    ' convert map to list
    Dim values As List = Array(mout)
    Dim jsonG As JSONGenerator
    ' pass list to json generator
    jsonG.Initialize2(values)
    Dim output As String = jsonG.ToString 
    If bEnclose = True Then
        Return output
    Else
        output = output.Replace("[{","")
        output = output.Replace("}]","")
        Return output
    End If
End Sub


                                

Multiplatform - B4X

TAGS : json,map,convert
image
B4XEncryption

Needs the Library B4XEncryption

2022-03-04 12:22:44 by Omar
Original Link Author Link
                                    Sub EncryptText(text As String, password As String) As Byte()
   Dim c As B4XCipher
   Return c.Encrypt(text.GetBytes("utf8"), password)
End Sub

Sub DecryptText(EncryptedData() As Byte, password As String) As String
   Dim c As B4XCipher
   Dim b() As Byte = c.Decrypt(EncryptedData, password)
   Return BytesToString(b, 0, b.Length, "utf8")
End Sub

Dim encryptedData() As Byte = EncryptText("confidential", "123456")
Log(DecryptText(encryptedData, "123456"))
                                

Multiplatform - B4X

TAGS : B4XEncryption,encryption
image
Multipart file upload with progress

2022-03-04 19:35:25 by rufus
Original Link Author Link
                                    

Public Sub CreateMultipartJob(Link As String, NameValues As Map, Files As List) As HttpJob
    Dim boundary As String = "---------------------------1461124740692"
    TempCounter = TempCounter + 1
    Dim TempFileName As String = "post-" & TempCounter
    Dim stream As OutputStream = File.OpenOutput(xui.DefaultFolder, TempFileName, False)
    Dim b() As Byte
    Dim eol As String = Chr(13) & Chr(10)
    Dim empty As Boolean = True
    If NameValues <> Null And NameValues.IsInitialized Then
        For Each key As String In NameValues.Keys
            Dim value As String = NameValues.Get(key)
            empty = MultipartStartSection (stream, empty)
            Dim s As String = _
$"--${boundary}
Content-Disposition: form-data; name="${key}"

${value}"$
            b = s.Replace(CRLF, eol).GetBytes("UTF8")
            stream.WriteBytes(b, 0, b.Length)
        Next
    End If
    If Files <> Null And Files.IsInitialized Then
        For Each fd As MultipartFileData In Files
            empty = MultipartStartSection (stream, empty)
            Dim s As String = _
$"--${boundary}
Content-Disposition: form-data; name="${fd.KeyName}"; filename="${fd.FileName}"
Content-Type: ${fd.ContentType}

"$
            b = s.Replace(CRLF, eol).GetBytes("UTF8")
            stream.WriteBytes(b, 0, b.Length)
            Dim in As InputStream = File.OpenInput(fd.Dir, fd.FileName)
            File.Copy2(in, stream)
        Next
    End If
    empty = MultipartStartSection (stream, empty)
    s = _
$"--${boundary}--
"$
    b = s.Replace(CRLF, eol).GetBytes("UTF8")
    stream.WriteBytes(b, 0, b.Length)
    Dim job As HttpJob
    job.Initialize("", Me)
    stream.Close
    Dim length As Int = File.Size(xui.DefaultFolder, TempFileName)
    Dim in As InputStream = File.OpenInput(xui.DefaultFolder, TempFileName)
    Dim cin As CountingInputStream
    cin.Initialize(in)
    Dim req As OkHttpRequest = job.GetRequest
    req.InitializePost(Link, cin, length)
    req.SetContentType("multipart/form-data; boundary=" & boundary)
    req.SetContentEncoding("UTF8")
    TrackProgress(cin, length)
    job.Tag = TempFileName
    CallSubDelayed2(HttpUtils2Service, "SubmitJob", job)
    Return job
End Sub

Private Sub MultipartStartSection (stream As OutputStream, empty As Boolean) As Boolean
    If empty = False Then
        stream.WriteBytes(Array As Byte(13, 10), 0, 2)
    Else
        empty = False
    End If
    Return empty
End Sub

Private Sub TrackProgress (cin As CountingInputStream, length As Int)
    TrackerIndex = TrackerIndex + 1
    Dim MyIndex As Int = TrackerIndex
    Do While MyIndex = TrackerIndex
        Log($"$1.2{cin.Count * 100 / length}%"$)
        If cin.Count = length Then Exit
        Sleep(100)
    Loop
End Sub


                                

Multiplatform - B4X

TAGS : multipart,upload