Author Topic: Simple APK Installer for WSA (Windows Subsystem for Android (11 Insider)) (Read 3541 times)

SpriggsySpriggs · « **on:** October 23, 2021, 11:26:21 pm »

"Simple" is a relative term. For those of you who are on Windows 11 Insider builds, you should have access to Windows Subsystem for Android (WSA). This code assumes you have downloaded the Android Debug Bridge (adb) binaries. It's a lot of code to just show a tiny window and run a couple of commands. I probably won't expand it but I thought I'd share it anyways because @mpgcan and @Petr both made some good Win32 code recently. Maybe they can make use of some of the wrappers.

Code: QB64 $NOPREFIX: [Select]

Option Explicit
$Console:Only
$NoPrefix
 
ConsoleTitle "QB64 APK Installer for WSA (Console)"
Console Off
 
$VersionInfo:CompanyName=SpriggsySpriggs
$VersionInfo:FileDescription=APK installer for WSA
$VersionInfo:ProductName=QB64 APK Installer for WSA
 
Const IDI_APPLICATION = 32512
Const IDC_ARROW = 32512
Const COLOR_WINDOW = 5
 
Const WS_EX_CLIENTEDGE = &H00000200
Const WS_OVERLAPPED = &H00000000
Const WS_CAPTION = &H00C00000
Const WS_SYSMENU = &H00080000
Const WS_THICKFRAME = &H00040000
Const WS_MINIMIZEBOX = &H00020000
Const WS_MAXIMIZEBOX = &H00010000
Const WS_OVERLAPPEDWINDOW = WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX
Const CW_USEDEFAULT = &H80000000
Const WS_TABSTOP = &H00010000
Const WS_CHILD = &H40000000
Const WS_VISIBLE = &H10000000
 
Const WS_VSCROLL = &H00200000
Const WS_HSCROLL = &H00100000
 
 
Const BS_PUSHBUTTON = 0
Const BS_AUTOCHECKBOX = 3
Const BS_GROUPBOX = 7
Const BS_AUTORADIOBUTTON = 9
Const BS_TEXT = 0
Const BS_SPLITBUTTON = &HC
Const BS_DEFPUSHBUTTON = &H00000001
 
Const SW_SHOWDEFAULT = &HA
 
Const WM_DESTROY = 2
Const WM_GETTEXT = &H000D
Const WM_CLOSE = &H0010
Const WM_COMMAND = &H0111
Const WM_ENTERSIZEMOVE = &H0231
Const WM_EXITSIZEMOVE = &H0232
 
Const IDCANCEL = 2
Const IDNO = 7
Const IDOK = 1
Const IDRETRY = 4
Const IDYES = 6
 
Const LF_FACESIZE = 32
 
Const SPI_GETNONCLIENTMETRICS = &H0029
Const WM_SETFONT = &H0030
 
Const BM_GETCHECK = &HF0
 
Const PROGRESS_CLASS = "msctls_progress32"
Const PBS_SMOOTH = &H1
Const PBS_VERTICAL = &H4
 
Const CCM_FIRST = &H2000
Const CCM_LAST = CCM_FIRST + &H200
Const CCM_SETBKCOLOR = CCM_FIRST + 1
Const CCM_SETCOLORSCHEME = CCM_FIRST + 2
Const CCM_GETCOLORSCHEME = CCM_FIRST + 3
Const CCM_GETDROPTARGET = CCM_FIRST + 4
Const CCM_SETUNICODEFORMAT = CCM_FIRST + 5
Const CCM_GETUNICODEFORMAT = CCM_FIRST + 6
Const CCM_SETVERSION = CCM_FIRST + &H7
Const CCM_GETVERSION = CCM_FIRST + &H8
Const CCM_SETNOTIFYWINDOW = CCM_FIRST + &H9
Const CCM_SETWINDOWTHEME = CCM_FIRST + &HB
Const CCM_DPISCALE = CCM_FIRST + &HC
 
Const COMCTL32_VERSION = 6
 
Const WM_USER = &H0400
Const PBM_SETRANGE = WM_USER + 1
Const PBM_SETPOS = WM_USER + 2
Const PBM_DELTAPOS = WM_USER + 3
Const PBM_SETSTEP = WM_USER + 4
Const PBM_STEPIT = WM_USER + 5
Const PBM_SETRANGE32 = WM_USER + 6
Const PBM_SETSTATE = WM_USER + 16
 
Const PBST_NORMAL = 1
Const PBST_ERROR = 2
Const PBST_PAUSED = 3
 
Const PBM_GETRANGE = WM_USER + 7
Const PBM_GETPOS = WM_USER + 8
Const PBM_SETBARCOLOR = WM_USER + 9
Const PBM_SETBKCOLOR = CCM_SETBKCOLOR
 
Const WC_EDIT = "Edit"
Const WM_SETTEXT = &H000C
 
Const ES_LEFT = 0
Const ES_MULTILINE = 4
Const ES_AUTOVSCROLL = &H0040
Const ES_AUTOHSCROLL = &H0080
Const ES_WANTRETURN = &H1000
Const ES_READONLY = &H0800
 
Const WC_COMBOBOX = "ComboBox"
 
Const WM_ENABLE = &H000A
Const WM_CTLCOLORBTN = &H0135
 
Const WM_ERASEBKGND = &H0014
 
Type POINT
    As Long x, y
End Type
 
Type MSG
    As Offset hwnd
    As Unsigned Long message
    As Unsigned Offset wParam
    As Offset lParam
    As Long time
    As POINT pt
    As Long lPrivate
End Type
 
Type WNDCLASSEX
    As Unsigned Long cbSize, style
    As Offset lpfnWndProc
    As Long cbClsExtra, cbWndExtra
    As Offset hInstance, hIcon, hCursor, hbrBackground, lpszMenuName, lpszClassName, hIconSm
End Type
 
Type RECT
    As Long left, top, right, bottom
End Type
 
Type PBRANGE
    As Long iLow, iHigh
End Type
 
Declare CustomType Library
    Function SendMessage%& (ByVal hWnd As Offset, Byval Msg As Unsigned Long, Byval wParam As Unsigned Offset, Byval lParam As Offset)
    Sub SendMessage (ByVal hWnd As Offset, Byval Msg As Unsigned Long, Byval wParam As Unsigned Offset, Byval lParam As Offset)
    Function DefWindowProc%& (ByVal hWnd As Offset, Byval Msg As Unsigned Long, Byval wParam As Unsigned Offset, Byval lParam As Offset)
    Sub PostQuitMessage (ByVal nExitCode As Long)
    Function LoadCursor%& (ByVal hInstance As Offset, Byval lpCursorName As Offset)
    Function LoadIcon%& (ByVal hInstance As Offset, Byval lpIconName As Offset)
    Function RegisterClassEx% (ByVal wndclassex As Offset)
    Function CreateWindowEx%& (ByVal dwExStyle As Long, Byval lpClassName As Offset, Byval lpWindowName As Offset, Byval dwStyle As Long, Byval X As Long, Byval Y As Long, Byval nWidth As Long, Byval nHeight As Long, Byval hWndParent As Offset, Byval wMenu As Offset, Byval hInstance As Offset, Byval lpParam As Offset)
    Sub CreateWindowEx (ByVal dwExStyle As Long, Byval lpClassName As Offset, Byval lpWindowName As Offset, Byval dwStyle As Long, Byval X As Long, Byval Y As Long, Byval nWidth As Long, Byval nHeight As Long, Byval hWndParent As Offset, Byval wMenu As Offset, Byval hInstance As Offset, Byval lpParam As Offset)
    Sub ShowWindow (ByVal hWnd As Offset, Byval nCmdShow As Long)
    Sub UpdateWindow (ByVal hWnd As Offset)
    Function GetMessage%% (ByVal lpMsg As Offset, Byval hWnd As Offset, Byval wMsgFilterMin As Unsigned Long, Byval wMsgFilterMax As Unsigned Long)
    Sub TranslateMessage (ByVal lpMsg As Offset)
    Sub DispatchMessage (ByVal lpMsg As Offset)
    Function GetModuleHandle%& (ByVal lpModulename As Offset)
    Sub SystemParametersInfo (ByVal uiAction As Unsigned Long, Byval uiParam As Unsigned Long, Byval pvParam As Offset, Byval fWinIni As Unsigned Long)
    Sub SetWindowPos (ByVal hWnd As Offset, Byval hWndInsertAfter As Offset, Byval X As Long, Byval Y As Long, Byval cx As Long, Byval cy As Long, Byval uFlags As Unsigned Long)
    Sub EndDialog (ByVal hDlg As Offset, Byval nResult As Offset)
    Sub EnableWindow (ByVal hWnd As Offset, Byval bEnable As Long)
    Sub GetWindowRect (ByVal hWnd As Offset, Byval lpRect As Offset)
    Function GetDC%& (ByVal hWnd As Offset)
    Function GetDlgItem%& (ByVal hDlg As Offset, Byval nIDDlgItem As Long)
    Function GetDlgCtrlID& (ByVal hWnd As Offset)
    Sub GetWindowText (ByVal hWnd As Offset, Byval lpString As Offset, Byval nMaxCount As Long)
    Sub SetWindowText (ByVal hWnd As Offset, Byval lpString As Offset)
End Declare
 
$If GETLASTERROR = UNDEFINED Then
    Declare Library
        Function GetLastError~& ()
    End Declare
    $Let GETLASTERROR = TRUE
$End If
 
Declare CustomType Library "makeint"
    Function MAKEINTRESOURCE%& Alias "MAKEINTRSC" (ByVal i As Offset)
End Declare
 
Declare Library
    Function MAKELPARAM%& (ByVal l As Integer, Byval h As Integer)
    Function __RGB~& Alias "RGB" (ByVal r As Unsigned Byte, Byval g As Unsigned Byte, Byval b As Unsigned Byte)
End Declare
 
Declare Dynamic Library "Gdi32"
    'Function CreateFontIndirect%& Alias "CreateFontIndirectA" (ByVal lplf As Offset)
    Function CreateFont%& Alias "CreateFontA" (ByVal cHeight As Long, Byval cWidth As Long, Byval cEscapement As Long, Byval cOrientation As Long, Byval cWeight As Long, Byval bItalic As Unsigned Long, Byval bUnderline As Unsigned Long, Byval bStrikeout As Unsigned Long, Byval iCharSet As Unsigned Long, Byval iOutPrecision As Unsigned Long, Byval iClipPrecision As Unsigned Long, Byval iQuality As Unsigned Long, Byval iPitchAndFamily As Unsigned Long, pszFaceName As String)
    Sub SetBkColor (ByVal hdc As Offset, Byval color As Unsigned Long)
    Sub SetDCBrushColor (ByVal hdc As Offset, Byval color As Unsigned Long)
    Function CreateSolidBrush%& (ByVal color As Unsigned Long)
End Declare
 
Declare CustomType Library ".\internal\c\c_compiler\x86_64-w64-mingw32\include\shellapi"
    Function ExtractIcon%& Alias "ExtractIconA" (ByVal hInst As Offset, pszExeFileName As String, Byval nIconIndex As Unsigned Long)
End Declare
 
Declare Library "win"
    Function GetWindowProc%& ()
End Declare
 
Rem $Include:'OpenSave.BI'
 
Const DEFEXT = "APK"
 
Dim As WNDCLASSEX wc
Dim As String className: className = "main" + Chr$(0)
Dim Shared As Offset hInstance: hInstance = GetModuleHandle(0)
Dim As MSG msg
 
Dim Shared As String APKfile
 
wc.cbSize = Len(wc)
wc.lpfnWndProc = GetWindowProc
wc.hInstance = hInstance
wc.hCursor = LoadCursor(0, MAKEINTRESOURCE(IDC_ARROW))
wc.hIcon = ExtractIcon(0, _CWD$ + "\WSA-icon.ico" + Chr$(0), 0)
wc.hbrBackground = CreateSolidBrush(__RGB(61, 219, 134))
wc.lpszClassName = Offset(className)
 
Dim As Unsigned Integer reg: reg = RegisterClassEx(Offset(wc))
If reg = 0 Then System GetLastError
 
Dim As String childTitle: childTitle = "QB64 APK Installer for WSA" + Chr$(0)
Dim Shared As Offset parentWin: parentWin = CreateWindowEx(0, MAKELPARAM(reg, 0), Offset(childTitle), WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX, CW_USEDEFAULT, CW_USEDEFAULT, 320, 120, 0, 0, hInstance, 0)
 
If parentWin = 0 Then System GetLastError
 
Dim As String t0: t0 = "BUTTON" + Chr$(0)
Dim As String t1: t1 = "Browse" + Chr$(0)
Dim Shared As Offset browseBtn: browseBtn = CreateWindowEx(0, Offset(t0), Offset(t1), WS_TABSTOP Or WS_VISIBLE Or WS_CHILD Or BS_DEFPUSHBUTTON, 5, 10, 50, 25, parentWin, 0, hInstance, 0)
 
 
t1 = "Install" + Chr$(0)
Dim Shared As Offset installBtn: installBtn = CreateWindowEx(0, Offset(t0), Offset(t1), WS_TABSTOP Or WS_VISIBLE Or WS_CHILD Or BS_DEFPUSHBUTTON, 80, 10, 50, 25, parentWin, 0, hInstance, 0)
 
Dim Shared As Offset outputBox: outputBox = NewEditBox(5, 50, 300, 20, "READONLY", "")
 
SetFont browseBtn, "Arial", 12, "", "BLACK"
SetFont installBtn, "Arial", 12, "", "BLACK"
SetFont outputBox, "Arial", 16, "", ""
 
ShowWindow parentWin, SW_SHOWDEFAULT
UpdateWindow parentWin
 
While GetMessage(Offset(msg), 0, 0, 0)
    TranslateMessage Offset(msg)
    DispatchMessage Offset(msg)
Wend
 
System Val(Str$(msg.wParam))
 
Function WindowProc%& (hwnd As Offset, uMsg As Unsigned Long, wParam As Unsigned Offset, lParam As Offset)
    Select Case uMsg
        Case WM_CLOSE
            WindowProc = DefWindowProc(hwnd, uMsg, wParam, lParam)
        Case WM_DESTROY
            PostQuitMessage 0
            WindowProc = 0
            Exit Function
        Case WM_COMMAND
            Select Case lParam
                Case browseBtn
                    APKfile = ComDlgFileName("Open APK Package", Dir$("downloads"), "Android APK Files(*.APK)|*.APK", 1, 0) + Chr$(0)
                    SetWindowText outputBox, Offset(APKfile)
                Case installBtn
                    If APKfile <> "" And APKfile <> Chr$(0) Then
                        Dim As String stdout
                        stdout = pipecom_lite("adb connect 127.0.0.1:58526")
                        If InStr(stdout, "cannot connect") = 0 Then
                            Console On
                            Shell "adb install " + APKfile
                            Console Off
                        Else
                            SoftError "Connection failure", "adb failed to connect to the Windows Subsystem for Android host"
                        End If
                    End If
            End Select
        Case Else
            WindowProc = DefWindowProc(hwnd, uMsg, wParam, lParam)
    End Select
End Function
 
Function NewEditBox%& (x As Long, y As Long, w As Long, h As Long, style As String, defaultText As String)
    Dim As Long flags
    style = UCase$(style)
    flags = WS_CHILD Or WS_VISIBLE
    If InStr(style, "NOWRAP") Then
        flags = flags Or WS_VSCROLL Or WS_HSCROLL Or ES_AUTOHSCROLL Or ES_AUTOVSCROLL Or ES_LEFT Or ES_MULTILINE Or ES_WANTRETURN
    ElseIf InStr(style, "WRAP") Then
        flags = flags Or WS_VSCROLL Or ES_AUTOVSCROLL Or ES_LEFT Or ES_MULTILINE Or ES_WANTRETURN
    Else
        flags = flags Or ES_LEFT
    End If
    If InStr(style, "READONLY") Then
        flags = flags Or ES_READONLY
    End If
    Dim As String class: class = WC_EDIT + Chr$(0)
    defaultText = defaultText + Chr$(0)
    NewEditBox = CreateWindowEx(0, Offset(class), Offset(defaultText), flags, x, y, w, h, parentWin, 0, hInstance, 0)
End Function
 
Function WindowHeight& ()
    Dim As RECT rect
    GetWindowRect parentWin, Offset(rect)
    WindowHeight = rect.bottom - rect.top
End Function
 
Function WindowWidth& ()
    Dim As RECT rect
    GetWindowRect parentWin, Offset(rect)
    WindowWidth = rect.right - rect.left
End Function
 
Sub MoveWindow (X As Long, Y As Long)
    Const SWP_NOSIZE = &H0001
    SetWindowPos parentWin, 0, X, Y, 0, 0, SWP_NOSIZE
End Sub
 
Sub ResizeWindow (w As Long, h As Long)
    Const SWP_NOMOVE = &H0002
    SetWindowPos parentWin, 0, 0, 0, w, h, SWP_NOMOVE
End Sub
 
Function WindowTitle$ ()
    Dim As String wintitle: wintitle = Space$(260)
    GetWindowText parentWin, Offset(wintitle), Len(wintitle)
    WindowTitle = wintitle
End Function
 
Sub SetFont (controlHandle As Offset, fontName As String * 32, __height As Long, style As String, weightStyle As String)
    Dim As Offset __font
    Dim As Byte bold, underline, strikeout, italic
    Dim As Long weight
    style = UCase$(style)
    If InStr(style, "UNDERLINE") Then underline = -1
    If InStr(style, "STRIKEOUT") Then strikeout = -1
    If InStr(style, "ITALIC") Then italic = -1
    Select Case UCase$(weightStyle)
        Case "THIN"
            weight = 100
        Case "EXTRALIGHT", "ULTRALIGHT"
            weight = 200
        Case "LIGHT"
            weight = 300
        Case "NORMAL", "REGULAR"
            weight = 400
        Case "MEDIUM"
            weight = 500
        Case "SEMIBOLD", "DEMIBOLD"
            weight = 600
        Case "BOLD"
            weight = 700
        Case "EXTRABOLD", "ULTRABOLD"
            weight = 800
        Case "HEAVY", "BLACK"
            weight = 900
        Case Else
            weight = 0
    End Select
    Dim As Long FF_DECORATIVE: FF_DECORATIVE = _SHL(5, 4)
    Dim As Long FF_MODERN: FF_MODERN = _SHL(3, 4)
    Dim As Long FF_ROMAN: FF_ROMAN = _SHL(1, 4)
    Dim As Long FF_SCRIPT: FF_SCRIPT = _SHL(4, 4)
    Dim As Long FF_SWISS: FF_SWISS = _SHL(2, 4)
    __font = CreateFont(__height, 0, 0, 0, weight, italic, underline, strikeout, 0, 0, 0, 5, FF_DECORATIVE Or FF_MODERN Or FF_ROMAN Or FF_SCRIPT Or FF_SWISS, fontName + Chr$(0))
    If Font Then
        SendMessage controlHandle, WM_SETFONT, __font, MAKELPARAM(-1, 0)
    End If
End Sub
 
Sub ToggleEnable (controlHandle As Offset, __toggle As Byte)
    Select Case __toggle
        Case 1
            EnableWindow controlHandle, -1
        Case 0
            EnableWindow controlHandle, 0
    End Select
End Sub
 
Sub StepProgressBar (pbHandle As Offset, amount As Unsigned Long)
    Dim As PBRANGE range
    SendMessage pbHandle, PBM_GETRANGE, 0, Offset(range)
    Dim As Offset currentpos: currentpos = SendMessage(pbHandle, PBM_GETPOS, 0, 0)
    If currentpos >= range.iHigh Then Exit Sub
    SendMessage pbHandle, PBM_DELTAPOS, amount, 0
End Sub
 
Sub SetProgressBarVal (pbHandle As Offset, newValue As Unsigned Long)
    Dim As PBRANGE range
    SendMessage pbHandle, PBM_GETRANGE, 0, Offset(range)
    Dim As Offset currentpos: currentpos = SendMessage(pbHandle, PBM_GETPOS, 0, 0)
    If currentpos >= range.iHigh Or newValue > range.iHigh Or newValue < range.iLow Then Exit Sub
    SendMessage pbHandle, PBM_SETPOS, newValue, 0
End Sub
 
Sub UpdateProgressBar (pbHandle As Offset)
    Dim As PBRANGE range
    SendMessage pbHandle, PBM_GETRANGE, 0, Offset(range)
    Dim As Offset currentpos: currentpos = SendMessage(pbHandle, PBM_GETPOS, 0, 0)
    If currentpos >= range.iHigh Then Exit Sub
    SendMessage pbHandle, PBM_STEPIT, 0, 0
End Sub
 
Sub SetProgressBarState (pbHandle As Offset, state As Unsigned Byte)
    Select Case state
        Case 1
            SendMessage pbHandle, PBM_SETSTATE, PBST_NORMAL, 0
        Case 2
            SendMessage pbHandle, PBM_SETSTATE, PBST_ERROR, 0
        Case 3
            SendMessage pbHandle, PBM_SETSTATE, PBST_PAUSED, 0
    End Select
End Sub
 
Rem $Include:'pipecomqb64.bas'
Rem $Include:'OpenSave.BM'
Rem $Include:'MessageBox.BM'

A couple videos showing the code in action:

Petr · « **Reply #1 on:** October 24, 2021, 12:47:48 pm »

@SpriggsySpriggs

Thanks for sharing, I can't test it yet because I don't have the necessary operating system.

jack · « **Reply #2 on:** October 24, 2021, 01:08:36 pm »

Quote

Windows Subsystem for Android™️ enables your Windows 11 device to run Android applications that are available in the Amazon Appstore.

Windows 11 for android applications?

SpriggsySpriggs · « **Reply #3 on:** October 24, 2021, 01:14:52 pm »

@jack Windows 11 allows you to run Android apps similar to how 10 allowed for Linux applications.

News:

Author Topic: Simple APK Installer for WSA (Windows Subsystem for Android (11 Insider)) (Read 3541 times)

SpriggsySpriggs

Simple APK Installer for WSA (Windows Subsystem for Android (11 Insider))

Petr

Re: Simple APK Installer for WSA (Windows Subsystem for Android (11 Insider))

jack

Re: Simple APK Installer for WSA (Windows Subsystem for Android (11 Insider))

SpriggsySpriggs

Re: Simple APK Installer for WSA (Windows Subsystem for Android (11 Insider))