├── APKIcon.res ├── APKIcon.tlb ├── F11Hook.res ├── W1nDro1d.res ├── WinDroid.res ├── Style ├── Style.vsf ├── style.pfi ├── WinEleven.style └── images │ ├── style.png │ ├── style15x.png │ └── style20x.png ├── SystemHooks.res ├── assets ├── icons.xar ├── wsapk.ico ├── wsapk.png ├── wsapk2.ico └── wsapk2.png ├── APKIconProject.res ├── APKIconProject.tlb ├── Win32 └── Debug │ ├── en.lng │ └── es.lng ├── gitassets ├── f11.mp4 └── snapshot01.jpg ├── icons8_android.ico ├── icons8-android-24.ico ├── icons8-android-24.png ├── icons8_android_16.png ├── icons8_android_32.png ├── icons8_android-white.ico ├── icons8_android-white_16.png ├── icons8_android-white_32.png ├── APKIconClass.pas ├── APKIcon.dpr ├── README.md ├── W1nDro1d.dpr ├── LICENSE ├── APKIcon.ridl ├── frmApkViewer.pas ├── WinDroid.dpr ├── AndroidPermissions.json ├── .gitignore ├── WinDroidProject.groupproj ├── frmApkInstaller.fmx ├── frmBrowser.dfm ├── APKIcon_TLB.pas ├── frmApkViewer.dfm ├── APKIconUnit.pas ├── WinDroid.mes ├── adb.pas ├── FMX.Windows.TrayIcon.pas ├── RegChangeThread.pas ├── F11Hook.dpr ├── frmBrowser.pas ├── TaskbarPinner.pas ├── wsa.pas ├── frmApkInstaller.dfm ├── frmApkInstaller.pas ├── helperFuncs.pas └── main.pas /APKIcon.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/W1nDro1d/HEAD/APKIcon.res -------------------------------------------------------------------------------- /APKIcon.tlb: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/W1nDro1d/HEAD/APKIcon.tlb -------------------------------------------------------------------------------- /F11Hook.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/W1nDro1d/HEAD/F11Hook.res -------------------------------------------------------------------------------- /W1nDro1d.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/W1nDro1d/HEAD/W1nDro1d.res -------------------------------------------------------------------------------- /WinDroid.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/W1nDro1d/HEAD/WinDroid.res -------------------------------------------------------------------------------- /Style/Style.vsf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/W1nDro1d/HEAD/Style/Style.vsf -------------------------------------------------------------------------------- /Style/style.pfi: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/W1nDro1d/HEAD/Style/style.pfi -------------------------------------------------------------------------------- /SystemHooks.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/W1nDro1d/HEAD/SystemHooks.res -------------------------------------------------------------------------------- /assets/icons.xar: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/W1nDro1d/HEAD/assets/icons.xar -------------------------------------------------------------------------------- /assets/wsapk.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/W1nDro1d/HEAD/assets/wsapk.ico -------------------------------------------------------------------------------- /assets/wsapk.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/W1nDro1d/HEAD/assets/wsapk.png -------------------------------------------------------------------------------- /APKIconProject.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/W1nDro1d/HEAD/APKIconProject.res -------------------------------------------------------------------------------- /APKIconProject.tlb: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/W1nDro1d/HEAD/APKIconProject.tlb -------------------------------------------------------------------------------- /Win32/Debug/en.lng: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/W1nDro1d/HEAD/Win32/Debug/en.lng -------------------------------------------------------------------------------- /Win32/Debug/es.lng: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/W1nDro1d/HEAD/Win32/Debug/es.lng -------------------------------------------------------------------------------- /assets/wsapk2.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/W1nDro1d/HEAD/assets/wsapk2.ico -------------------------------------------------------------------------------- /assets/wsapk2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/W1nDro1d/HEAD/assets/wsapk2.png -------------------------------------------------------------------------------- /gitassets/f11.mp4: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/W1nDro1d/HEAD/gitassets/f11.mp4 -------------------------------------------------------------------------------- /icons8_android.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/W1nDro1d/HEAD/icons8_android.ico -------------------------------------------------------------------------------- /Style/WinEleven.style: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/W1nDro1d/HEAD/Style/WinEleven.style -------------------------------------------------------------------------------- /icons8-android-24.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/W1nDro1d/HEAD/icons8-android-24.ico -------------------------------------------------------------------------------- /icons8-android-24.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/W1nDro1d/HEAD/icons8-android-24.png -------------------------------------------------------------------------------- /icons8_android_16.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/W1nDro1d/HEAD/icons8_android_16.png -------------------------------------------------------------------------------- /icons8_android_32.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/W1nDro1d/HEAD/icons8_android_32.png -------------------------------------------------------------------------------- /Style/images/style.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/W1nDro1d/HEAD/Style/images/style.png -------------------------------------------------------------------------------- /Style/images/style15x.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/W1nDro1d/HEAD/Style/images/style15x.png -------------------------------------------------------------------------------- /Style/images/style20x.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/W1nDro1d/HEAD/Style/images/style20x.png -------------------------------------------------------------------------------- /gitassets/snapshot01.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/W1nDro1d/HEAD/gitassets/snapshot01.jpg -------------------------------------------------------------------------------- /icons8_android-white.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/W1nDro1d/HEAD/icons8_android-white.ico -------------------------------------------------------------------------------- /icons8_android-white_16.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/W1nDro1d/HEAD/icons8_android-white_16.png -------------------------------------------------------------------------------- /icons8_android-white_32.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/W1nDro1d/HEAD/icons8_android-white_32.png -------------------------------------------------------------------------------- /APKIconClass.pas: -------------------------------------------------------------------------------- 1 | 2 | 3 | initialization 4 | TIconHandlerFactory.Create( 5 | ComServer, TAPKIcon, Class_APKIcon, ciMultiInstance, tmApartment 6 | ); 7 | 8 | end. 9 | -------------------------------------------------------------------------------- /APKIcon.dpr: -------------------------------------------------------------------------------- 1 | library APKIcon; 2 | 3 | uses 4 | ComServ, 5 | APKIcon_TLB in 'APKIcon_TLB.pas', 6 | APKIconUnit in 'APKIconUnit.pas' {APKIcon: CoClass}; 7 | 8 | exports 9 | DllGetClassObject, 10 | DllCanUnloadNow, 11 | DllRegisterServer, 12 | DllUnregisterServer, 13 | DllInstall; 14 | 15 | {$R *.TLB} 16 | 17 | {$R *.RES} 18 | 19 | begin 20 | end. 21 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # W1nDro1d // DISCONTINUED 2 | A simple tool to manage Windows 11's Subsystem for Android manually, install APK and XAPK, toggle fullscreen, list installed Android Apps, among other things. 3 | 4 | ![snapshot01](https://raw.githubusercontent.com/vhanla/W1nDro1d/main/gitassets/snapshot01.jpg) 5 | 6 | FullScreen (F11) 7 | 8 | https://user-images.githubusercontent.com/1015823/138936990-a5867d1f-3e8a-4bb3-a1c6-aef2d9f738e5.mp4 9 | 10 | 11 | # DISCONTINUED DUE TO LACK OF A DECENT WINDOWS 11 CAPABLE MACHINE :( TOO SLOW TO DEBUG 12 | -------------------------------------------------------------------------------- /W1nDro1d.dpr: -------------------------------------------------------------------------------- 1 | program W1nDro1d; 2 | 3 | {$R *.dres} 4 | 5 | uses 6 | 7 | Vcl.Forms, 8 | System.StartUpCopy, 9 | FMX.Forms, 10 | FMX.Platform.Win, 11 | System.SysUtils, 12 | Winapi.Windows, 13 | main in 'main.pas' {WinDroidHwnd}, 14 | frmApkInstaller in 'frmApkInstaller.pas' {frmInstaller}; 15 | 16 | {$R *.res} 17 | 18 | begin 19 | // WsaClient process Mutex {42CEB0DF-325A-4FBE-BBB6-C259A6C3F0BB} 20 | if CreateMutex(nil, True, '{42CEB0DF-325A-4FBE-BBB6-C259A6C3F0BC}') = 0 then 21 | RaiseLastOSError; 22 | 23 | if GetLastError = ERROR_ALREADY_EXISTS then 24 | begin 25 | Exit; 26 | end; 27 | 28 | Application.Initialize; 29 | Application.CreateForm(TWinDroidHwnd, WinDroidHwnd); 30 | Application.CreateForm(TfrmInstaller, frmInstaller); 31 | Application.RealCreateForms; 32 | Application.MainForm.Visible := False; 33 | Application.Run; 34 | end. 35 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2021 vhanla 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /APKIcon.ridl: -------------------------------------------------------------------------------- 1 | // ************************************************************************ // 2 | // WARNING 3 | // ------- 4 | // This file is generated by the Type Library importer or Type Library Editor. 5 | // Barring syntax errors, the Editor will parse modifications made to the file. 6 | // However, when applying changes via the Editor this file will be regenerated 7 | // and comments or formatting changes will be lost. 8 | // ************************************************************************ // 9 | // File generated on 08/11/2021 10:07:56 p. m. (- $Rev: 12980 $, 12361093). 10 | 11 | [ 12 | uuid(C33485E7-F1BF-4B06-BABD-29192A42CF0B), 13 | version(1.0) 14 | 15 | ] 16 | library APKIcon 17 | { 18 | 19 | importlib("stdole2.tlb"); 20 | 21 | interface IAPKIcon; 22 | coclass APKIcon; 23 | 24 | 25 | [ 26 | uuid(27BAA846-0F3A-4D42-AF31-7B9E60ADE9FF), 27 | helpstring("Interface for APKIcon Object"), 28 | oleautomation 29 | ] 30 | interface IAPKIcon: IUnknown 31 | { 32 | }; 33 | 34 | [ 35 | uuid(3CDC901D-6551-43CE-A82A-1A643D58BED0), 36 | helpstring("APKIcon") 37 | ] 38 | coclass APKIcon 39 | { 40 | [default] interface IAPKIcon; 41 | }; 42 | 43 | }; 44 | -------------------------------------------------------------------------------- /frmApkViewer.pas: -------------------------------------------------------------------------------- 1 | unit frmApkViewer; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Menus, Vcl.ExtCtrls, Vcl.WinXCtrls, 8 | SynEditHighlighter, SynEditCodeFolding, SynHighlighterJava, SynEdit, 9 | Vcl.ComCtrls, Vcl.WinXPanels; 10 | 11 | type 12 | TfrmApkViewerWnd = class(TForm) 13 | SplitView1: TSplitView; 14 | MainMenu1: TMainMenu; 15 | CardPanel1: TCardPanel; 16 | Card1: TCard; 17 | PageControl1: TPageControl; 18 | TabSheet1: TTabSheet; 19 | SynEdit1: TSynEdit; 20 | SynJavaSyn1: TSynJavaSyn; 21 | TreeView1: TTreeView; 22 | File1: TMenuItem; 23 | Edit1: TMenuItem; 24 | Help1: TMenuItem; 25 | Open1: TMenuItem; 26 | Close1: TMenuItem; 27 | Save1: TMenuItem; 28 | N1: TMenuItem; 29 | Exit1: TMenuItem; 30 | N2: TMenuItem; 31 | N3: TMenuItem; 32 | StatusBar1: TStatusBar; 33 | private 34 | { Private declarations } 35 | public 36 | { Public declarations } 37 | end; 38 | 39 | var 40 | frmApkViewerWnd: TfrmApkViewerWnd; 41 | 42 | implementation 43 | 44 | {$R *.dfm} 45 | 46 | end. 47 | -------------------------------------------------------------------------------- /WinDroid.dpr: -------------------------------------------------------------------------------- 1 | program WinDroid; 2 | 3 | 4 | 5 | uses 6 | FastMM4, 7 | madExcept, 8 | madLinkDisAsm, 9 | madListHardware, 10 | madListProcesses, 11 | madListModules, 12 | Vcl.Forms, 13 | System.SysUtils, 14 | Winapi.Windows, 15 | WSAManager in 'WSAManager.pas' {frmWinDroid}, 16 | frmApkInstaller in 'frmApkInstaller.pas' {frmInstaller}, 17 | Vcl.Themes, 18 | Vcl.Styles, 19 | frmBrowser in 'frmBrowser.pas' {frmWeb}, 20 | helperFuncs in 'helperFuncs.pas', 21 | adb in 'adb.pas', 22 | frmApkViewer in 'frmApkViewer.pas' {frmApkViewerWnd}, 23 | RegChangeThread in 'RegChangeThread.pas', 24 | TaskbarPinner in 'TaskbarPinner.pas', 25 | wsa in 'wsa.pas'; 26 | 27 | {$R *.res} 28 | 29 | begin 30 | ReportMemoryLeaksOnShutdown := True; 31 | // WsaClient process Mutex {42CEB0DF-325A-4FBE-BBB6-C259A6C3F0BB} 32 | if CreateMutex(nil, True, '{42CEB0DF-325A-4FBE-BBB6-C259A6C3F0BC}') = 0 then 33 | RaiseLastOSError; 34 | 35 | if GetLastError = ERROR_ALREADY_EXISTS then 36 | begin 37 | Exit; 38 | end; 39 | 40 | Application.Initialize; 41 | // Application.MainFormOnTaskbar := False; 42 | // Application.ShowMainForm := False; 43 | Application.CreateForm(TfrmWinDroid, frmWinDroid); 44 | Application.CreateForm(TfrmInstaller, frmInstaller); 45 | Application.CreateForm(TfrmWeb, frmWeb); 46 | Application.CreateForm(TfrmApkViewerWnd, frmApkViewerWnd); 47 | Application.Run; 48 | end. 49 | -------------------------------------------------------------------------------- /AndroidPermissions.json: -------------------------------------------------------------------------------- 1 | { 2 | "permissions" :[ 3 | { 4 | "title": "Make phone calls", 5 | "shortDesc": "Services that cost you money", 6 | "URI": "android.permission.CALL_PHONE", 7 | "risk": "HIGH", 8 | "protectionLevel": "DANGEROUS", 9 | "officialDesc": "Allows an application to initiate a phone call without going through the Dialer user interface for the user to confirm the call being placed.", 10 | "details": "This permission is of high importance. This could let an application call a 1-900 number and charge you money. However, this is not as common a way to cheat people in today's world as it used to be. Legitimate applications that use this include: Google Voice and Google Maps.\nAnother important point to note here is that any app can launch the phone screen and pre-fill a number for you. However, in order to make the call, you would need to press [Send] or [Call] yourself. The difference with this permission is that an app could make the entire process automatic and hidden." 11 | }, 12 | { 13 | "title": "Send SMS or MMS", 14 | "shortDesc": "Services that cost you money", 15 | "URI": "android.permission.SEND_SMS", 16 | "risk": "HIGH", 17 | "protectionLevel": "DANGEROUS", 18 | "officialDesc": "Allows an application to send SMS messages.", 19 | "details": "This permission is of high importance. This could let an application send an SMS on your behalf, and much like the phone call permission, it could cost you money by sending SMS to for-pay numbers. Certain SMS numbers work much like 1-900 numbers and automatically charge your phone company money when you send them an SMS." 20 | 21 | } 22 | ] 23 | } 24 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Uncomment these types if you want even more clean repository. But be careful. 2 | # It can make harm to an existing project source. Read explanations below. 3 | # 4 | # Resource files are binaries containing manifest, project icon and version info. 5 | # They can not be viewed as text or compared by diff-tools. Consider replacing them with .rc files. 6 | #*.res 7 | # 8 | # Type library file (binary). In old Delphi versions it should be stored. 9 | # Since Delphi 2009 it is produced from .ridl file and can safely be ignored. 10 | #*.tlb 11 | # 12 | # Diagram Portfolio file. Used by the diagram editor up to Delphi 7. 13 | # Uncomment this if you are not using diagrams or use newer Delphi version. 14 | #*.ddp 15 | # 16 | # Visual LiveBindings file. Added in Delphi XE2. 17 | # Uncomment this if you are not using LiveBindings Designer. 18 | #*.vlb 19 | # 20 | # Deployment Manager configuration file for your project. Added in Delphi XE2. 21 | # Uncomment this if it is not mobile development and you do not use remote debug feature. 22 | #*.deployproj 23 | # 24 | # C++ object files produced when C/C++ Output file generation is configured. 25 | # Uncomment this if you are not using external objects (zlib library for example). 26 | #*.obj 27 | # 28 | 29 | # Delphi compiler-generated binaries (safe to delete) 30 | *.exe 31 | *.dll 32 | *.bpl 33 | *.bpi 34 | *.dcp 35 | *.so 36 | *.apk 37 | *.drc 38 | *.map 39 | *.dres 40 | *.rsm 41 | *.tds 42 | *.dcu 43 | *.lib 44 | *.a 45 | *.o 46 | *.ocx 47 | 48 | # Delphi autogenerated files (duplicated info) 49 | *.cfg 50 | *.hpp 51 | *Resource.rc 52 | 53 | # Delphi local files (user-specific info) 54 | *.local 55 | *.identcache 56 | *.projdata 57 | *.tvsconfig 58 | *.dsk 59 | 60 | # Delphi history and backups 61 | __history/ 62 | __recovery/ 63 | *.~* 64 | 65 | # Castalia statistics file (since XE7 Castalia is distributed with Delphi) 66 | *.stat 67 | 68 | # Boss dependency manager vendor folder https://github.com/HashLoad/boss 69 | modules/ 70 | W1nDro1d.delphilsp.json 71 | WinDroid.delphilsp.json 72 | Win32 73 | Win64 -------------------------------------------------------------------------------- /WinDroidProject.groupproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | {81AD9E1E-1688-472A-B4EB-8B2067AB6AB6} 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | Default.Personality.12 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | -------------------------------------------------------------------------------- /frmApkInstaller.fmx: -------------------------------------------------------------------------------- 1 | object frmInstaller: TfrmInstaller 2 | Left = 0 3 | Top = 0 4 | Caption = 'APK Installer' 5 | ClientHeight = 302 6 | ClientWidth = 540 7 | FormFactor.Width = 320 8 | FormFactor.Height = 480 9 | FormFactor.Devices = [Desktop] 10 | DesignerMasterStyle = 0 11 | object Image1: TImage 12 | MultiResBitmap = < 13 | item 14 | end> 15 | Anchors = [akTop, akRight] 16 | Position.X = 400.000000000000000000 17 | Position.Y = 16.000000000000000000 18 | Size.Width = 97.000000000000000000 19 | Size.Height = 97.000000000000000000 20 | Size.PlatformDefault = False 21 | end 22 | object btnReInstall: TButton 23 | Anchors = [akLeft, akBottom] 24 | Position.X = 304.000000000000000000 25 | Position.Y = 248.000000000000000000 26 | TabOrder = 2 27 | Text = 'Install' 28 | end 29 | object btnLaunch: TButton 30 | Anchors = [akLeft, akBottom] 31 | Position.X = 416.000000000000000000 32 | Position.Y = 248.000000000000000000 33 | TabOrder = 1 34 | Text = 'Launch' 35 | end 36 | object lbAPKDisplayName: TLabel 37 | Anchors = [akLeft, akTop, akRight] 38 | StyledSettings = [Family, FontColor] 39 | Position.X = 16.000000000000000000 40 | Position.Y = 16.000000000000000000 41 | Size.Width = 377.000000000000000000 42 | Size.Height = 41.000000000000000000 43 | Size.PlatformDefault = False 44 | TextSettings.Font.Size = 20.000000000000000000 45 | TextSettings.Font.StyleExt = {00060000000000000004000000} 46 | Text = 'APK Display Name' 47 | TabOrder = 6 48 | end 49 | object lbPublisher: TLabel 50 | Anchors = [akLeft, akTop, akRight] 51 | Position.X = 16.000000000000000000 52 | Position.Y = 64.000000000000000000 53 | Size.Width = 377.000000000000000000 54 | Size.Height = 17.000000000000000000 55 | Size.PlatformDefault = False 56 | Text = 'Publisher' 57 | TabOrder = 5 58 | end 59 | object lbVersion: TLabel 60 | Anchors = [akLeft, akTop, akRight] 61 | Position.X = 16.000000000000000000 62 | Position.Y = 88.000000000000000000 63 | Size.Width = 377.000000000000000000 64 | Size.Height = 17.000000000000000000 65 | Size.PlatformDefault = False 66 | Text = 'Version:' 67 | TabOrder = 4 68 | end 69 | object lbCapabilities: TLabel 70 | Position.X = 16.000000000000000000 71 | Position.Y = 128.000000000000000000 72 | Size.Width = 377.000000000000000000 73 | Size.Height = 17.000000000000000000 74 | Size.PlatformDefault = False 75 | Text = 'Capabilities:' 76 | TabOrder = 3 77 | end 78 | object Memo1: TMemo 79 | Touch.InteractiveGestures = [Pan, LongTap, DoubleTap] 80 | DataDetectorTypes = [] 81 | Lines.Strings = ( 82 | '- Permission 1' 83 | '- Permission 2' 84 | '- etc.') 85 | ReadOnly = True 86 | Anchors = [akLeft, akTop, akRight, akBottom] 87 | Position.X = 16.000000000000000000 88 | Position.Y = 152.000000000000000000 89 | Size.Width = 273.000000000000000000 90 | Size.Height = 97.000000000000000000 91 | Size.PlatformDefault = False 92 | TabOrder = 7 93 | Viewport.Width = 269.000000000000000000 94 | Viewport.Height = 93.000000000000000000 95 | end 96 | end 97 | -------------------------------------------------------------------------------- /frmBrowser.dfm: -------------------------------------------------------------------------------- 1 | object frmWeb: TfrmWeb 2 | Left = 0 3 | Top = 0 4 | Caption = 'PlayStore' 5 | ClientHeight = 485 6 | ClientWidth = 704 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | Position = poMainFormCenter 15 | OnCreate = FormCreate 16 | PixelsPerInch = 96 17 | TextHeight = 13 18 | object PageControl1: TPageControl 19 | Left = 0 20 | Top = 0 21 | Width = 704 22 | Height = 485 23 | ActivePage = TabSheet1 24 | Align = alClient 25 | TabOrder = 0 26 | object TabSheet1: TTabSheet 27 | Caption = 'Browser' 28 | object WebBrowser1: TWebBrowser 29 | Left = 0 30 | Top = 0 31 | Width = 696 32 | Height = 457 33 | Align = alClient 34 | TabOrder = 0 35 | OnNewWindow2 = WebBrowser1NewWindow2 36 | OnDocumentComplete = WebBrowser1DocumentComplete 37 | ExplicitWidth = 702 38 | ExplicitHeight = 483 39 | ControlData = { 40 | 4C000000EF4700003B2F00000000000000000000000000000000000000000000 41 | 000000004C000000000000000000000001000000E0D057007335CF11AE690800 42 | 2B2E126208000000000000004C0000000114020000000000C000000000000046 43 | 8000000000000000000000000000000000000000000000000000000000000000 44 | 00000000000000000100000000000000000000000000000000000000} 45 | end 46 | end 47 | object TabSheet2: TTabSheet 48 | Caption = 'Downloads' 49 | ImageIndex = 1 50 | object UWPDownloader1: TUWPDownloader 51 | Left = 0 52 | Top = 0 53 | Width = 696 54 | Align = alTop 55 | Caption = 'Downloading' 56 | TabOrder = 0 57 | AniSet.AniKind = akOut 58 | AniSet.AniFunctionKind = afkQuartic 59 | AniSet.DelayStartTime = 0 60 | AniSet.Duration = 250 61 | AniSet.Step = 25 62 | OnDownloaded = UWPDownloader1Downloaded 63 | URL = '' 64 | Header = '' 65 | UserAgent = '' 66 | SavePath = '' 67 | IconFont.Charset = DEFAULT_CHARSET 68 | IconFont.Color = clWindowText 69 | IconFont.Height = -21 70 | IconFont.Name = 'Segoe MDL2 Assets' 71 | IconFont.Style = [] 72 | CustomBackColor.Enabled = False 73 | CustomBackColor.LightNone = 15132390 74 | CustomBackColor.LightHover = 13619151 75 | CustomBackColor.LightPress = 8947848 76 | CustomBackColor.LightSelectedNone = 127 77 | CustomBackColor.LightSelectedHover = 103 78 | CustomBackColor.LightSelectedPress = 89 79 | CustomBackColor.DarkNone = 2039583 80 | CustomBackColor.DarkHover = 3487029 81 | CustomBackColor.DarkPress = 5000268 82 | CustomBackColor.DarkSelectedNone = 89 83 | CustomBackColor.DarkSelectedHover = 103 84 | CustomBackColor.DarkSelectedPress = 127 85 | FontIcon = #59219 86 | DownloadStartIcon = #57624 87 | DownloadPauseIcon = #57603 88 | DownloadCancelIcon = #57610 89 | DownloadRestartIcon = #57673 90 | Detail = 'Detail' 91 | ExtraDetail = '' 92 | Status = '' 93 | ProgressTop = 'Message 1' 94 | ProgressBottom = '0kb/s' 95 | end 96 | object FileListBox1: TFileListBox 97 | Left = 0 98 | Top = 60 99 | Width = 696 100 | Height = 397 101 | Align = alClient 102 | ItemHeight = 24 103 | Mask = '*.apk;*.xapk' 104 | ParentShowHint = False 105 | ShowGlyphs = True 106 | ShowHint = False 107 | TabOrder = 1 108 | OnDblClick = FileListBox1DblClick 109 | end 110 | end 111 | end 112 | end 113 | -------------------------------------------------------------------------------- /APKIcon_TLB.pas: -------------------------------------------------------------------------------- 1 | unit APKIcon_TLB; 2 | 3 | // ************************************************************************ // 4 | // WARNING 5 | // ------- 6 | // The types declared in this file were generated from data read from a 7 | // Type Library. If this type library is explicitly or indirectly (via 8 | // another type library referring to this type library) re-imported, or the 9 | // 'Refresh' command of the Type Library Editor activated while editing the 10 | // Type Library, the contents of this file will be regenerated and all 11 | // manual modifications will be lost. 12 | // ************************************************************************ // 13 | 14 | // $Rev: 98336 $ 15 | // File generated on 08/11/2021 09:59:16 p. m. from Type Library described below. 16 | 17 | // ************************************************************************ // 18 | // Type Lib: Q:\Proyectos\W1nDro1d\APKIcon (1) 19 | // LIBID: {C33485E7-F1BF-4B06-BABD-29192A42CF0B} 20 | // LCID: 0 21 | // Helpfile: 22 | // HelpString: 23 | // DepndLst: 24 | // (1) v2.0 stdole, (C:\Windows\SysWOW64\stdole2.tlb) 25 | // SYS_KIND: SYS_WIN32 26 | // ************************************************************************ // 27 | {$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers. 28 | {$WARN SYMBOL_PLATFORM OFF} 29 | {$WRITEABLECONST ON} 30 | {$VARPROPSETTER ON} 31 | {$ALIGN 4} 32 | 33 | interface 34 | 35 | uses Winapi.Windows, System.Classes, System.Variants, System.Win.StdVCL, Vcl.Graphics, Vcl.OleServer, Winapi.ActiveX; 36 | 37 | 38 | // *********************************************************************// 39 | // GUIDS declared in the TypeLibrary. Following prefixes are used: 40 | // Type Libraries : LIBID_xxxx 41 | // CoClasses : CLASS_xxxx 42 | // DISPInterfaces : DIID_xxxx 43 | // Non-DISP interfaces: IID_xxxx 44 | // *********************************************************************// 45 | const 46 | // TypeLibrary Major and minor versions 47 | APKIconMajorVersion = 1; 48 | APKIconMinorVersion = 0; 49 | 50 | LIBID_APKIcon: TGUID = '{C33485E7-F1BF-4B06-BABD-29192A42CF0B}'; 51 | 52 | IID_IAPKIcon: TGUID = '{27BAA846-0F3A-4D42-AF31-7B9E60ADE9FF}'; 53 | CLASS_APKIcon_: TGUID = '{3CDC901D-6551-43CE-A82A-1A643D58BED0}'; 54 | type 55 | 56 | // *********************************************************************// 57 | // Forward declaration of types defined in TypeLibrary 58 | // *********************************************************************// 59 | IAPKIcon = interface; 60 | 61 | // *********************************************************************// 62 | // Declaration of CoClasses defined in Type Library 63 | // (NOTE: Here we map each CoClass to its Default Interface) 64 | // *********************************************************************// 65 | APKIcon_ = IAPKIcon; 66 | 67 | 68 | // *********************************************************************// 69 | // Interface: IAPKIcon 70 | // Flags: (256) OleAutomation 71 | // GUID: {27BAA846-0F3A-4D42-AF31-7B9E60ADE9FF} 72 | // *********************************************************************// 73 | IAPKIcon = interface(IUnknown) 74 | ['{27BAA846-0F3A-4D42-AF31-7B9E60ADE9FF}'] 75 | end; 76 | 77 | // *********************************************************************// 78 | // The Class CoAPKIcon_ provides a Create and CreateRemote method to 79 | // create instances of the default interface IAPKIcon exposed by 80 | // the CoClass APKIcon_. The functions are intended to be used by 81 | // clients wishing to automate the CoClass objects exposed by the 82 | // server of this typelibrary. 83 | // *********************************************************************// 84 | CoAPKIcon_ = class 85 | class function Create: IAPKIcon; 86 | class function CreateRemote(const MachineName: string): IAPKIcon; 87 | end; 88 | 89 | implementation 90 | 91 | uses System.Win.ComObj; 92 | 93 | class function CoAPKIcon_.Create: IAPKIcon; 94 | begin 95 | Result := CreateComObject(CLASS_APKIcon_) as IAPKIcon; 96 | end; 97 | 98 | class function CoAPKIcon_.CreateRemote(const MachineName: string): IAPKIcon; 99 | begin 100 | Result := CreateRemoteComObject(MachineName, CLASS_APKIcon_) as IAPKIcon; 101 | end; 102 | 103 | end. 104 | 105 | -------------------------------------------------------------------------------- /frmApkViewer.dfm: -------------------------------------------------------------------------------- 1 | object frmApkViewerWnd: TfrmApkViewerWnd 2 | Left = 0 3 | Top = 0 4 | Caption = 'APK Viewer ' 5 | ClientHeight = 363 6 | ClientWidth = 662 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | Menu = MainMenu1 14 | OldCreateOrder = False 15 | PixelsPerInch = 96 16 | TextHeight = 13 17 | object SplitView1: TSplitView 18 | Left = 0 19 | Top = 0 20 | Width = 200 21 | Height = 344 22 | OpenedWidth = 200 23 | Placement = svpLeft 24 | TabOrder = 0 25 | ExplicitLeft = 320 26 | ExplicitTop = 136 27 | ExplicitHeight = 41 28 | object TreeView1: TTreeView 29 | Left = 0 30 | Top = 0 31 | Width = 200 32 | Height = 344 33 | Align = alClient 34 | Indent = 19 35 | TabOrder = 0 36 | ExplicitLeft = 32 37 | ExplicitTop = 72 38 | ExplicitWidth = 121 39 | ExplicitHeight = 97 40 | end 41 | end 42 | object CardPanel1: TCardPanel 43 | Left = 200 44 | Top = 0 45 | Width = 462 46 | Height = 344 47 | Align = alClient 48 | ActiveCard = Card1 49 | Caption = 'CardPanel1' 50 | TabOrder = 1 51 | ExplicitLeft = 256 52 | ExplicitTop = 48 53 | ExplicitWidth = 300 54 | ExplicitHeight = 200 55 | object Card1: TCard 56 | Left = 1 57 | Top = 1 58 | Width = 460 59 | Height = 342 60 | Caption = 'Card1' 61 | CardIndex = 0 62 | TabOrder = 0 63 | ExplicitLeft = 0 64 | ExplicitTop = 0 65 | ExplicitWidth = 185 66 | ExplicitHeight = 41 67 | object PageControl1: TPageControl 68 | Left = 0 69 | Top = 0 70 | Width = 460 71 | Height = 342 72 | ActivePage = TabSheet1 73 | Align = alClient 74 | TabOrder = 0 75 | ExplicitHeight = 361 76 | object TabSheet1: TTabSheet 77 | Caption = 'TabSheet1' 78 | object SynEdit1: TSynEdit 79 | Left = 0 80 | Top = 0 81 | Width = 452 82 | Height = 314 83 | Align = alClient 84 | Font.Charset = DEFAULT_CHARSET 85 | Font.Color = clWindowText 86 | Font.Height = -13 87 | Font.Name = 'Consolas' 88 | Font.Style = [] 89 | Font.Quality = fqClearTypeNatural 90 | TabOrder = 0 91 | UseCodeFolding = False 92 | Gutter.Font.Charset = DEFAULT_CHARSET 93 | Gutter.Font.Color = clWindowText 94 | Gutter.Font.Height = -11 95 | Gutter.Font.Name = 'Consolas' 96 | Gutter.Font.Style = [] 97 | Highlighter = SynJavaSyn1 98 | Lines.Strings = ( 99 | 'SynEdit1') 100 | ExplicitLeft = 128 101 | ExplicitTop = 88 102 | ExplicitWidth = 200 103 | ExplicitHeight = 150 104 | end 105 | end 106 | end 107 | end 108 | end 109 | object StatusBar1: TStatusBar 110 | Left = 0 111 | Top = 344 112 | Width = 662 113 | Height = 19 114 | Panels = < 115 | item 116 | Width = 50 117 | end> 118 | ExplicitLeft = 336 119 | ExplicitTop = 200 120 | ExplicitWidth = 0 121 | end 122 | object MainMenu1: TMainMenu 123 | Left = 248 124 | Top = 80 125 | object File1: TMenuItem 126 | Caption = 'File' 127 | object Open1: TMenuItem 128 | Caption = 'Open' 129 | end 130 | object Close1: TMenuItem 131 | Caption = 'Close' 132 | end 133 | object Save1: TMenuItem 134 | Caption = 'Save' 135 | end 136 | object N1: TMenuItem 137 | Caption = '-' 138 | end 139 | object Exit1: TMenuItem 140 | Caption = 'Exit' 141 | end 142 | end 143 | object Edit1: TMenuItem 144 | Caption = 'Edit' 145 | object N2: TMenuItem 146 | Caption = '-' 147 | end 148 | object N3: TMenuItem 149 | Caption = '-' 150 | end 151 | end 152 | object Help1: TMenuItem 153 | Caption = 'Help' 154 | end 155 | end 156 | object SynJavaSyn1: TSynJavaSyn 157 | Options.AutoDetectEnabled = False 158 | Options.AutoDetectLineLimit = 0 159 | Options.Visible = False 160 | Left = 309 161 | Top = 121 162 | end 163 | end 164 | -------------------------------------------------------------------------------- /APKIconUnit.pas: -------------------------------------------------------------------------------- 1 | unit APKIconUnit; 2 | 3 | {$WARN SYMBOL_PLATFORM OFF} 4 | 5 | interface 6 | 7 | uses 8 | Winapi.Windows, Winapi.ActiveX, System.Win.ComObj, APKIcon_TLB, 9 | System.Win.StdVCL, Winapi.ShlObj; 10 | 11 | type 12 | TAPKIcon = class(TTypedComObject, IAPKIcon, IExtractIcon, IPersistFile) 13 | private 14 | FCurrFile: WideString; 15 | protected 16 | //IExtractIcon 17 | function GetIconLocation(uFlags: UINT; szIconFile: LPWSTR; cchMax: UINT; 18 | out piIndex: Integer; out pwFlags: UINT): HResult; stdcall; 19 | function Extract(pszFile: LPCWSTR; nIconIndex: UINT; 20 | out phiconLarge, phiconSmall: HICON; nIconSize: UINT): HResult; stdcall; 21 | //IPersist 22 | function GetClassID(out classID: TCLSID): HResult; stdcall; 23 | //IPersistFile 24 | function IsDirty: HResult; stdcall; 25 | function Load(pszFileName: POleStr; dwMode: Longint): HResult; 26 | stdcall; 27 | function Save(pszFileName: POleStr; fRemember: BOOL): HResult; 28 | stdcall; 29 | function SaveCompleted(pszFileName: POleStr): HResult; 30 | stdcall; 31 | function GetCurFile(out pszFileName: POleStr): HResult; 32 | stdcall; 33 | end; 34 | 35 | TIconHandlerFactory = class(TTypedComObjectFactory) 36 | public 37 | procedure UpdateRegistry(Register: Boolean); override; 38 | end; 39 | 40 | implementation 41 | 42 | uses 43 | System.SysUtils, System.Win.ComServ, Vcl.Graphics, System.Win.Registry, 44 | System.Classes; 45 | 46 | { TAPKIcon } 47 | 48 | function TAPKIcon.Extract(pszFile: LPCWSTR; nIconIndex: UINT; out phiconLarge, 49 | phiconSmall: HICON; nIconSize: UINT): HResult; 50 | var 51 | vIconSize, I: Integer; 52 | vMaskAnd, vMaskXor: TBitmap; 53 | vIconInfo: TIconInfo; 54 | vSL: TStringList; 55 | begin 56 | // Draw the large icon 57 | vIconSize := Lo(nIconSize); 58 | 59 | // Create and prepare AND mask 60 | vMaskAnd := TBitmap.Create; 61 | try 62 | vMaskAnd.Monochrome := True; 63 | vMaskAnd.Width := vIconSize; 64 | vMaskAnd.Height := vIconSize; 65 | 66 | vMaskAnd.Canvas.Brush.Color := clBlack; 67 | vMaskAnd.Canvas.FillRect(Rect(0, 0, vIconSize, vIconSize)); 68 | 69 | // Create and prepare XOR mask 70 | 71 | vMaskXor := TBitmap.Create; 72 | try 73 | vMaskXor.Width := vIconSize; 74 | vMaskXor.Height := vIconSize; 75 | 76 | vMaskXor.Canvas.Brush.Color := clWhite; 77 | vMaskXor.Canvas.FillRect(Rect(0, 0, vIconSize, vIconSize)); 78 | vMaskXor.Canvas.Font.Color := clNavy; 79 | 80 | { TODO : Load icon from APK file - needs parsing androidmanifest.xml, get icon path, etc. } 81 | // Load file FCurrFile 82 | vSL := TStringList.Create; 83 | try 84 | // paint to icon vMaskXOR.canvas.... 85 | finally 86 | vSL.Free; 87 | end; 88 | 89 | // Create icon for explorer 90 | vIconInfo.fIcon := True; 91 | vIconInfo.xHotspot := 0; 92 | vIconInfo.yHotspot := 0; 93 | vIconInfo.hbmMask := vMaskAnd.Handle; 94 | vIconInfo.hbmColor := vMaskXor.Handle; 95 | // Return large icon 96 | phiconLarge := CreateIconIndirect(vIconInfo); 97 | // Signal success 98 | Result := S_OK; 99 | finally 100 | vMaskAnd.Free; 101 | end; 102 | finally 103 | vMaskXor.Free; 104 | end; 105 | end; 106 | 107 | function TAPKIcon.GetClassID(out classID: TCLSID): HResult; 108 | begin 109 | classID := CLASS_APKIcon_; 110 | Result := S_OK; 111 | end; 112 | 113 | function TAPKIcon.GetCurFile(out pszFileName: POleStr): HResult; 114 | begin 115 | Result := E_NOTIMPL; 116 | end; 117 | 118 | function TAPKIcon.GetIconLocation(uFlags: UINT; szIconFile: LPWSTR; 119 | cchMax: UINT; out piIndex: Integer; out pwFlags: UINT): HResult; 120 | begin 121 | piIndex := 0; 122 | pwFlags := GIL_DONTCACHE or GIL_NOTFILENAME or GIL_PERINSTANCE; 123 | Result := S_OK; 124 | end; 125 | 126 | function TAPKIcon.IsDirty: HResult; 127 | begin 128 | Result := E_NOTIMPL; 129 | end; 130 | 131 | function TAPKIcon.Load(pszFileName: POleStr; dwMode: Longint): HResult; 132 | begin 133 | FCurrFile := pszFileName; 134 | Result := S_OK; 135 | end; 136 | 137 | function TAPKIcon.Save(pszFileName: POleStr; fRemember: BOOL): HResult; 138 | begin 139 | Result := E_NOTIMPL; 140 | end; 141 | 142 | function TAPKIcon.SaveCompleted(pszFileName: POleStr): HResult; 143 | begin 144 | Result := E_NOTIMPL; 145 | end; 146 | 147 | { TIconHandlerFactory } 148 | 149 | procedure TIconHandlerFactory.UpdateRegistry(Register: Boolean); 150 | var 151 | ClsID: string; 152 | begin 153 | ClsID := GUIDToString(ClassID); 154 | inherited UpdateRegistry(Register); 155 | 156 | if Register then 157 | begin 158 | with TRegistry.Create do 159 | try 160 | RootKey := HKEY_CLASSES_ROOT; 161 | if OpenKey('apkfile\DefaultIcon', True) then 162 | try 163 | WriteString('backup', ReadString('')); 164 | WriteString('', '%1'); 165 | finally 166 | CloseKey; 167 | end; 168 | 169 | if OpenKey('apkfile\shellex\IconHandler', True) then 170 | try 171 | WriteString('', ClsID); 172 | finally 173 | CloseKey; 174 | end; 175 | finally 176 | Free; 177 | end; 178 | end 179 | else 180 | begin 181 | with TRegistry.Create do 182 | try 183 | RootKey := HKEY_CLASSES_ROOT; 184 | if OpenKey('apkfile\DefaultIcon', True) then 185 | try 186 | if ValueExists('backup') then 187 | begin 188 | WriteString('', ReadString('backup')); 189 | DeleteValue('backup'); 190 | end; 191 | finally 192 | CloseKey; 193 | end; 194 | 195 | if OpenKey('apkfile\shellex', True) then 196 | try 197 | if KeyExists('IconHandler') then 198 | DeleteKey('IconHandler'); 199 | finally 200 | CloseKey; 201 | end; 202 | finally 203 | Free; 204 | end; 205 | end; 206 | end; 207 | 208 | initialization 209 | TTypedComObjectFactory.Create(ComServer, TAPKIcon, CLASS_APKIcon_, 210 | ciMultiInstance, tmApartment); 211 | end. 212 | -------------------------------------------------------------------------------- /WinDroid.mes: -------------------------------------------------------------------------------- 1 | [GeneralSettings] 2 | MesVersion=4 3 | HandleExceptions=1 4 | LinkInCode=1 5 | AppendMapFileToBinary=1 6 | NoOwnMadExceptSettings=0 7 | CheckFileCrc=1 8 | CheckForFrozenMainThread=0 9 | FreezeTimeout=60000 10 | ReportLeaks=0 11 | WindowsLogo=0 12 | CrashOnBuffer=0 13 | CrashOnUnderrun=0 14 | AutomaticallySaveBugReport=1 15 | AutoSaveBugReportIfNotSent=1 16 | AutomaticallyMailBugReport=0 17 | AutoMailProgressBox=0 18 | CopyBugReportToClipboard=0 19 | SuspendAllRunningThreads=0 20 | ShowPleaseWaitBox=1 21 | PleaseWaitIcon= 22 | AutomaticallyContinueApplication=0 23 | AutomaticallyRestartApplication=0 24 | AutomaticallyCloseApplication=0 25 | SendInBackground=1 26 | SendHelper=0 27 | Send32Icon= 28 | UploadViaHttp=0 29 | HttpServer= 30 | HttpSsl=0 31 | HttpPort=0 32 | HttpAccount= 33 | HttpPassword= 34 | UploadToFogBugz=0 35 | UploadToBugZilla=0 36 | UploadToMantis=0 37 | BugTrackerAccount= 38 | BugTrackerPassword= 39 | BugTrackerProject= 40 | BugTrackerArea= 41 | BugTrackerAssignTo= 42 | MailAsSmtpServer=0 43 | MailAsSmtpClient=0 44 | SmtpServer= 45 | SmtpSsl=0 46 | SmtpTls=0 47 | SmtpPort=0 48 | SmtpAccount= 49 | SmtpPassword= 50 | MailViaMapi=1 51 | MailViaMailto=1 52 | MailAddress= 53 | BugReportFile=bugreport.txt 54 | AttachBugReport=1 55 | AttachBugReportFile=1 56 | DeleteBugReportFile=1 57 | BugReportSendAs=bugreport.txt 58 | BugReportZip= 59 | ScreenShotDepth=8 60 | ScreenShotAppOnly=0 61 | ScreenShotSendAs=screenshot.png 62 | ScreenShotZip= 63 | AdditionalAttachments= 64 | AppendBugReports=1 65 | BugReportFileSize=100000 66 | DontSaveDuplicateExceptions=1 67 | DontSaveDuplicateFreezings=1 68 | DuplicateExceptionDefinition=1 69 | DuplicateFreezeDefinition=2 70 | ShowExceptionBox=1 71 | OkBtnText=&OK 72 | DetailsBtnText=&Details 73 | PleaseWaitTitle=Information 74 | PleaseWaitText=Please wait a moment... 75 | BugTrackerTitle=%25appname%25, %25exceptMsg%25 76 | BugTrackerDescr=error details: %0d%0a%25errorDetails%25 77 | MailSubject=bug report 78 | MailBody=please find the bug report attached 79 | SendBoxTitle=Sending bug report... 80 | PrepareAttachMsg=Preparing attachments... 81 | MxLookupMsg=Searching for mail server... 82 | ConnectMsg=Connecting to server... 83 | SendMailMsg=Sending mail... 84 | FieldsMsg=Setting fields... 85 | SendAttachMsg=Sending attachments... 86 | SendFinalizeMsg=Finalizing... 87 | MailFailureMsg=Sorry, sending the bug report didn't work. 88 | VersionVariable= 89 | [ExceptionBox] 90 | ShowButtonMailBugReport=1 91 | ShowButtonSaveBugReport=0 92 | ShowButtonPrintBugReport=0 93 | ShowButtonShowBugReport=1 94 | ShowButtonContinueApplication=1 95 | ShowButtonRestartApplication=1 96 | ShowButtonCloseApplication=1 97 | IconButtonSendBugReport= 98 | IconButtonSaveBugReport= 99 | IconButtonPrintBugReport= 100 | IconButtonShowBugReport= 101 | IconButtonContinueApplication= 102 | IconButtonCantContinueApplication= 103 | IconButtonRestartApplication= 104 | IconButtonCloseApplication= 105 | FocusedButton=0 106 | SendAssistant=SendAssistant 107 | SaveAssistant=SaveAssistant 108 | PrintAssistant=PrintAssistant 109 | AutomaticallyShowBugReport=0 110 | NoOwnerDrawButtons=0 111 | BigExceptionIcon= 112 | TitleBar=%25appname%25 113 | ExceptionMessage=An error occurred in the application. 114 | FrozenMessage=The application seems to be frozen. 115 | BitFaultMsg=The file "%25modname%25" seems to be corrupt! 116 | MailBugReportText=send bug report 117 | SaveBugReportText=save bug report 118 | PrintBugReportText=print bug report 119 | ShowBugReportText=show bug report 120 | ContinueApplicationText=continue application 121 | RestartApplicationText=restart application 122 | CloseApplicationText=close application 123 | [BugReport] 124 | ListThreads=1 125 | ListModules=1 126 | ListHardware=1 127 | ShowCpuRegisters=1 128 | ShowStackDump=1 129 | Disassembly=1 130 | HideUglyItems=0 131 | ShowRelativeAddrs=1 132 | ShowRelativeLines=1 133 | FormatDisassembly=0 134 | LimitDisassembly=5 135 | EnabledPlugins=modules|processes|hardware 136 | [Filters] 137 | Filter1ExceptionClasses=EDBEditError 138 | Filter1DontCreateBugReport=1 139 | Filter1DontCreateScreenshot=1 140 | Filter1DontSuspendThreads=1 141 | Filter1DontCallHandlers=1 142 | Filter1ShowBox=3 143 | Filter1Assis= 144 | Filter2ExceptionClasses= 145 | Filter2DontCreateBugReport=0 146 | Filter2DontCreateScreenshot=0 147 | Filter2DontSuspendThreads=0 148 | Filter2DontCallHandlers=0 149 | Filter2ShowBox=0 150 | Filter2Assis= 151 | GeneralDontCreateBugReport=0 152 | GeneralDontCreateScreenshot=0 153 | GeneralDontSuspendThreads=0 154 | GeneralDontCallHandlers=0 155 | GeneralShowBox=0 156 | GeneralAssis= 157 | [Assistants] 158 | Assistant1=SendAssistant|Send Assistant|ContactForm|DetailsForm|ScrShotForm 159 | Assistant2=SaveAssistant|Save Assistant|ContactForm|DetailsForm 160 | Assistant3=PrintAssistant|Print Assistant|ContactForm|DetailsForm 161 | Forms1=TPF0%0eTMEContactForm%0bContactForm%07Message%0c%13%00%00%00Contact Information%08OnAction%0c%1b%00%00%00madExcept.HandleContactForm%00%09INVButton%0bContinueBtn%00%00%09INVButton%07SkipBtn%07Enabled%08%00%00%09INVButton%09CancelBtn%00%00%08INVLabel%06Label1%07Caption%0c%0a%00%00%00your name:%00%00%07INVEdit%08NameEdit%08Optional%09%0aOutputName%0c%0c%00%00%00contact name%00%00%08INVLabel%06Label2%07Caption%0c%0b%00%00%00your email:%00%00%07INVEdit%09EmailEdit%0aOutputName%0c%0d%00%00%00contact email%00%00%0bINVCheckBox%08MemCheck%07Caption%0c%0b%00%00%00remember me%00%00%00 162 | Forms2=TPF0%0eTMEDetailsForm%0bDetailsForm%07Message%0c%0d%00%00%00Error Details%00%09INVButton%0bContinueBtn%00%00%09INVButton%07SkipBtn%00%00%09INVButton%09CancelBtn%00%00%08INVLabel%06Label1%07Caption%0c,%00%00%00what were you doing when the error occurred?%00%00%07INVEdit%0bDetailsMemo%05Lines%04%09%00%00%00%0aOutputName%0c%0d%00%00%00error details%0aOutputType%07%0dnvoOwnSection%00%00%00 163 | Forms3=TPF0%0eTMEScrShotForm%0bScrShotForm%0dActiveControl%07%0bContinueBtn%05Timer%04%fa%00%00%00%07Message%0c%18%00%00%00Screenshot Configuration%08OnAction%0c%1e%00%00%00madExcept.HandleScreenshotForm%00%09INVButton%0bContinueBtn%00%00%09INVButton%07SkipBtn%07Enabled%08%00%00%09INVButton%09CancelBtn%00%00%0bINVCheckBox%0bAttachCheck%07Checked%09%07Caption%0c%25%00%00%00attach a screenshot to the bug report%00%00%08INVImage%0aScrShotImg%06Border%09%09Clickable%09%00%00%08INVLabel%06Label1%07Caption%0c%15%00%00%00(click to edit image)%00%00%00 164 | -------------------------------------------------------------------------------- /adb.pas: -------------------------------------------------------------------------------- 1 | unit adb; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, System.Win.ScktComp, DosCommand, System.Classes; 7 | 8 | const 9 | AP_VERY_HIGH = 0; 10 | AP_HIGH = 1; 11 | AP_MODERATE_HIGH = 2; 12 | AP_MEDIUM_HIGH = 3; 13 | AP_MEDIUM = 4; 14 | AP_LOW_MODERATE = 5; 15 | AP_LOW = 6; 16 | AP_MODERATE = 7; 17 | AP_LOW_MEDIUM = 8; 18 | AP_CRITICAL = 9; 19 | type 20 | 21 | TPermissions = ( 22 | androidpermissionCALL_PHONE = AP_HIGH, 23 | androidpermissionSEND_SMS = AP_HIGH, 24 | androidPermissionWRITE_EXTERNAL_STORAGE = AP_MEDIUM, 25 | androidPermissionREAD_CONTACTS = 3, 26 | androidPermissionWRITE_CONTACTS = 2, 27 | androidPermissionREAD_CALENDAR = 4, 28 | androidPermissionWRITE_CALENDAR = 4, 29 | comAndroidBrowserPermissionREAD_HISTORY_BOOKMARKS = 3, 30 | comAndroidBrowserPermissionWRITE_HISTORY_BOOKMARKS = 2, 31 | androidPermissionREAD_LOGS = 0, 32 | androidPermissionWRITE_SETTINGS = 4, 33 | androidPermissionREAD_SYNC_SETGINS = 5, 34 | androidPermissionRECEIVE_BOOT_COMPLETED = 2, 35 | androidPermissionRESTART_PACKAGES = 1, 36 | androidPermissionGET_TASKS = 3, 37 | androidPermissionSYSTEM_ALERT_WINDOW = 1, 38 | androidPermissionVIBRATE = 6, 39 | androidPermissionCAMERA = 2, 40 | androidPermissionACCESS_LOCATION_EXTRA_COMMANDS = 3, 41 | androidPermissionACCESS_MOCK_LOCATION = 7, 42 | androidPermissionBATTERY_STATUS = 6, 43 | androidPermissionBLUETOOTH_ADMIN = 4, 44 | androidPermissionBROADCAST_STICKY = 8, 45 | androidPermissionCHANGE_CONFIGURATION = 3, 46 | androidPermissionCLEAR_APP_CACHE = 6, 47 | androidPermissionDISABLE_KEYGUARD = 3, 48 | androidPermissionEXPAND_STATUS_BAR = 3, 49 | androidPermissionFLASHLIGHT = 6, 50 | androidPermissionGET_PACKAGE_SIZE = 5, 51 | androidPermissionKILL_BACKGROUND_PROCESSES = AP_HIGH, 52 | androidPermissionMODIFY_AUDIO_SETTINGS = AP_LOW, 53 | androidPermissionMOUNT_FORMAT_FILESYSTEMS = AP_MEDIUM, 54 | androidPermissionMOUNT_UNMOUNT_FILESYSTEMS = AP_MODERATE, 55 | androidPermissionNFC = AP_MEDIUM, 56 | androidPermissionPROCESS_OUTGOING_CALLS = AP_VERY_HIGH, 57 | androidPermissionREAD_SYNC_STATS = AP_MODERATE, 58 | androidPermissionRECORD_AUDIO = AP_MODERATE_HIGH, 59 | androidPermissionSET_ALARM = AP_LOW, 60 | androidPermissionSET_TIME_ZONE = AP_LOW, 61 | androidPermissionSET_WALLPAPER = AP_LOW, 62 | androidPermissionSUBSCRIBED_FEEDS_READ = AP_MEDIUM, 63 | androidPermissionSUBSCRIBED_FEEDS_WRITE = AP_LOW_MEDIUM, 64 | androidPermissionUSE_SIP = AP_MEDIUM_HIGH, 65 | androidPermissionWRITE_SECURE_SETTINGS = AP_VERY_HIGH, 66 | androidPermissionREAD_PROFILE = AP_MEDIUM_HIGH, 67 | comAndroidLauncherPermissionINSTALL_SHORTCUT = AP_MODERATE_HIGH, 68 | androidPermissionREAD_EXTERNAL_STORAGE = AP_LOW, 69 | comAndroidVoicemailPermissionADD_VOICEMAIL = AP_MEDIUM_HIGH, 70 | androidPermissionAUTHENTICATE_ACCOUNTS = AP_VERY_HIGH, 71 | comAndroidEmailPermissionREAD_ATTACHMENT = AP_HIGH, 72 | androidPermissionREAD_USER_DICTIONARY = AP_LOW, 73 | androidPermissionWRITE_USER_DICTIONARY = AP_LOW, 74 | androidPermissionINSTALL_DRM = AP_MODERATE_HIGH, 75 | androidPermissionADD_SYSTEM_SERVICE = AP_CRITICAL, 76 | androidPermissionACCESS_WIMAX_STATE = AP_LOW_MODERATE, 77 | androidPermissionCHANGE_WIMAX_STATE = AP_MODERATE, 78 | comAndroidProvidersImPermissionREAD_ONLY = AP_HIGH 79 | ); 80 | 81 | TADB = class 82 | private 83 | PID: Cardinal; 84 | FPath: string; 85 | FClient: TClientSocket; 86 | FPort: Integer; 87 | FHost: string; 88 | 89 | FCmd: TDosCommand; 90 | 91 | procedure SetPath(const Value: string); 92 | procedure SetHost(const Value: string); 93 | procedure SetPort(const Value: Integer); 94 | protected 95 | procedure OnSocketError(Sender: TObject; Socket: TCustomWinSocket; 96 | ErrorEvent: TErrorEvent; var ErrorCode: Integer); 97 | procedure OnSocketRead(Sender: TObject; Socket: TCustomWinSocket); 98 | procedure OnSocketDisconnect(Sender: TObject; Socket: TCustomWinSocket); 99 | public 100 | function StartServer(forceRestart: Boolean = False): Boolean; 101 | function StopServer: Boolean; 102 | function IsADBServerOn: Boolean; 103 | function ConnectSocket(port: Integer = 5037): Boolean; 104 | function RunScript(const command: string): string; 105 | 106 | procedure GetADBProcessList(var PidList: TStringList); 107 | 108 | constructor Create; 109 | destructor Destroy; override; 110 | 111 | property Path: string read FPath write SetPath; 112 | property Port: Integer read FPort write SetPort; 113 | property Host: string read FHost write SetHost; 114 | end; 115 | 116 | implementation 117 | 118 | uses 119 | Winapi.PsAPI, Winapi.TlHelp32; 120 | 121 | { TADB } 122 | 123 | function TADB.ConnectSocket(port: Integer = 5037): Boolean; 124 | begin 125 | FClient.Address := FHost; 126 | if port <> 5037 then 127 | FClient.Port := port 128 | else 129 | FClient.Port := FPort; 130 | FClient.Active := True; // Activates the client 131 | 132 | Result := FClient.Socket.Connected; 133 | end; 134 | 135 | constructor TADB.Create; 136 | begin 137 | FClient := TClientSocket.Create(nil); 138 | 139 | FPort := 5037; // default ADB socket port 140 | FHost := '127.0.0.1'; // localhost 141 | 142 | // FClient.OnError := OnSocketError; 143 | FClient.OnDisconnect := OnSocketDisconnect; 144 | FClient.OnRead := OnSocketRead; 145 | 146 | FCmd := TDosCommand.Create(nil); 147 | end; 148 | 149 | destructor TADB.Destroy; 150 | begin 151 | FCmd.Free; 152 | FClient.Free; 153 | inherited; 154 | end; 155 | 156 | // Get a list of adb.exe processes' fullpath 157 | procedure TADB.GetADBProcessList(var PidList: TStringList); 158 | var 159 | hSnap: THandle; 160 | pe: TProcessEntry32; 161 | begin 162 | 163 | end; 164 | 165 | function TADB.IsADBServerOn: Boolean; 166 | begin 167 | Result := False; 168 | end; 169 | 170 | procedure TADB.OnSocketDisconnect(Sender: TObject; Socket: TCustomWinSocket); 171 | begin 172 | 173 | end; 174 | 175 | procedure TADB.OnSocketError(Sender: TObject; Socket: TCustomWinSocket; 176 | ErrorEvent: TErrorEvent; var ErrorCode: Integer); 177 | begin 178 | ErrorCode := 0; 179 | // FClient.Active := False; 180 | // This can happen when no active server is started 181 | // do something 182 | end; 183 | 184 | procedure TADB.OnSocketRead(Sender: TObject; Socket: TCustomWinSocket); 185 | begin 186 | // Reads and displays the message received from the server 187 | // Socket.ReceiveText; 188 | { TODO : Handle receiving binary files } 189 | end; 190 | 191 | function TADB.RunScript(const command: string): string; 192 | begin 193 | if FClient.Socket.Connected then 194 | begin 195 | FClient.Socket.SendText(command); 196 | end 197 | else 198 | Result := 'NOT CONNECTED!'; 199 | end; 200 | 201 | procedure TADB.SetHost(const Value: string); 202 | begin 203 | FHost := Value; 204 | end; 205 | 206 | procedure TADB.SetPath(const Value: string); 207 | begin 208 | FPath := Value; 209 | end; 210 | 211 | procedure TADB.SetPort(const Value: Integer); 212 | begin 213 | FPort := Value; 214 | end; 215 | 216 | function TADB.StartServer(forceRestart: Boolean): Boolean; 217 | begin 218 | FCmd.CommandLine := 'adb.exe start-server'; 219 | FCmd.Execute; 220 | end; 221 | 222 | function TADB.StopServer: Boolean; 223 | begin 224 | FCmd.CommandLine := 'adb.exe kill-server'; 225 | FCmd.Execute; 226 | end; 227 | 228 | end. 229 | -------------------------------------------------------------------------------- /FMX.Windows.TrayIcon.pas: -------------------------------------------------------------------------------- 1 | unit FMX.Windows.TrayIcon; 2 | 3 | { 4 | Author: AkyrosXD 5 | GitHub: https://github.com/AkyrosXD 6 | Platform: Windows 7 | Framework: Firemonkey / FMX 8 | } 9 | 10 | interface 11 | 12 | uses 13 | Winapi.Windows, Winapi.ShellAPI, Winapi.Messages, FMX.Types, FMX.Platform.Win, 14 | FMX.Forms, FMX.Menus, System.Classes, System.SysUtils, FMX.Dialogs; 15 | 16 | type 17 | TBalloonType = (None = 0, Info = 1, Warning = 2, Error = 3); 18 | 19 | type 20 | TTrayIcon = class(TComponent) 21 | private 22 | procedure OnMenuToggleClick(Sender: TObject); 23 | public 24 | constructor Create(AOwner: TComponent); override; 25 | destructor Destroy; override; 26 | procedure SetOnClick(AOnClick: TNotifyEvent); 27 | procedure SetOnDoubleClick(AOnDoubleClick: TNotifyEvent); 28 | function GetPopupMenu: TPopupMenu; 29 | function AddMenuAction(AText: string; AOnClick: TNotifyEvent): TMenuItem; 30 | function AddMenuToggle(AText: string; AOnActivate, AOnDeactivate: TNotifyEvent; ADefaultValue: Boolean): TMenuItem; 31 | procedure ShowBalloon(ATitle, AText: string; AType: TBalloonType); 32 | procedure Show(ATip: string); 33 | procedure Hide; 34 | end; 35 | 36 | implementation 37 | 38 | var 39 | s_callbackMessage: UINT; 40 | s_pOnClick: TNotifyEvent; 41 | s_pOnDoubleClick: TNotifyEvent; 42 | s_ptrOldWindowProc: Pointer; 43 | s_menu: TPopupMenu; 44 | s_contextMenuHandle: HWND; 45 | s_contextMenuWindow: TForm; 46 | s_uTaskbarRestart: UINT; 47 | s_bVisible: Boolean; 48 | s_notifyIconData: _NOTIFYICONDATAW; 49 | 50 | function WndProcCallback(hWindow: HWND; uMsg: UINT; wpParam: WPARAM; lpParam: LPARAM): LRESULT; stdcall; 51 | var 52 | mousePosition: TPoint; 53 | begin 54 | if uMsg = s_callbackMessage then 55 | begin 56 | case lpParam of 57 | WM_LBUTTONDOWN: 58 | if Assigned(s_pOnClick) then 59 | begin 60 | s_pOnClick(nil); 61 | end; 62 | 63 | WM_LBUTTONDBLCLK: 64 | if Assigned(s_pOnDoubleClick) then 65 | begin 66 | s_pOnDoubleClick(nil); 67 | end; 68 | 69 | WM_RBUTTONDOWN: 70 | if Assigned(s_menu) and (s_contextMenuHandle <> 0) then 71 | begin 72 | SetForegroundWindow(s_contextMenuHandle); 73 | GetCursorPos(mousePosition); 74 | s_menu.Popup(mousePosition.X, mousePosition.Y); 75 | end; 76 | end; 77 | end; 78 | if uMsg = s_uTaskbarRestart then 79 | begin 80 | if s_bVisible then 81 | begin 82 | // if explorer crashes and restarts, add again the icon 83 | Shell_NotifyIcon(NIM_ADD, @s_notifyIconData); 84 | end; 85 | end; 86 | Result := CallWindowProc(s_ptrOldWindowProc, hWindow, uMsg, wpParam, lpParam); 87 | end; 88 | 89 | constructor TTrayIcon.Create(AOwner: TComponent); 90 | begin 91 | if AOwner = nil then 92 | begin 93 | raise Exception.Create('AOwner cannot be null'); 94 | end; 95 | s_bVisible := False; 96 | s_uTaskbarRestart := RegisterWindowMessageA('TaskbarCreated'); 97 | s_contextMenuWindow := TForm.CreateNew(nil); 98 | s_contextMenuHandle := WindowHandleToPlatform(s_contextMenuWindow.Handle).Wnd; 99 | inherited Create(s_contextMenuWindow); 100 | s_callbackMessage := WM_USER + Self.InstanceSize; // it has to be something unique 101 | s_menu := TPopupMenu.Create(s_contextMenuWindow); 102 | s_menu.Parent := s_contextMenuWindow; 103 | with s_notifyIconData do 104 | begin 105 | cbSize := SizeOf; 106 | Wnd := s_contextMenuHandle; 107 | uID := Cardinal(s_contextMenuHandle); 108 | uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP or NIF_STATE; 109 | dwInfoFlags := NIIF_NONE; 110 | uCallbackMessage := s_callbackMessage; 111 | hIcon := GetClassLong(s_contextMenuHandle, GCL_HICONSM) 112 | end; 113 | end; 114 | 115 | destructor TTrayIcon.Destroy; 116 | begin 117 | Shell_NotifyIcon(NIM_DELETE, @s_notifyIconData); 118 | inherited; 119 | end; 120 | 121 | procedure TTrayIcon.SetOnClick(AOnClick: TNotifyEvent); 122 | begin 123 | s_pOnClick := AOnClick; 124 | end; 125 | 126 | procedure TTrayIcon.SetOnDoubleClick(AOnDoubleClick: TNotifyEvent); 127 | begin 128 | s_pOnDoubleClick := AOnDoubleClick; 129 | end; 130 | 131 | function TTrayIcon.GetPopupMenu: TPopupMenu; 132 | begin 133 | Result := s_menu; 134 | end; 135 | 136 | function TTrayIcon.AddMenuAction(AText: string; AOnClick: TNotifyEvent): TMenuItem; 137 | var 138 | item: TMenuItem; 139 | begin 140 | item := nil; 141 | if Assigned(s_menu) then 142 | begin 143 | item := TMenuItem.Create(s_menu); 144 | item.Parent := s_menu; 145 | item.Text := AText; 146 | item.OnClick := AOnClick; 147 | s_menu.AddObject(item); 148 | end; 149 | Result := item; 150 | end; 151 | 152 | procedure TTrayIcon.OnMenuToggleClick(Sender: TObject); 153 | var 154 | item: TMenuItem; 155 | begin 156 | item := Sender as TMenuItem; 157 | item.IsChecked := (not item.IsChecked); 158 | if item.IsChecked then 159 | begin 160 | item.OnActivate(Sender); 161 | end 162 | else 163 | begin 164 | item.OnDeactivate(Sender); 165 | end; 166 | end; 167 | 168 | function TTrayIcon.AddMenuToggle(AText: string; AOnActivate, AOnDeactivate: TNotifyEvent; ADefaultValue: Boolean): TMenuItem; 169 | var 170 | item: TMenuItem; 171 | begin 172 | item := nil; 173 | if Assigned(s_menu) then 174 | begin 175 | item := TMenuItem.Create(s_menu); 176 | item.Parent := s_menu; 177 | item.Text := AText; 178 | item.IsChecked := ADefaultValue; 179 | item.OnActivate := AOnActivate; 180 | item.OnDeactivate := AOnDeactivate; 181 | item.OnClick := OnMenuToggleClick; 182 | s_menu.AddObject(item); 183 | end; 184 | Result := item; 185 | end; 186 | 187 | procedure TTrayIcon.ShowBalloon(ATitle, AText: string; AType: TBalloonType); 188 | begin 189 | if s_bVisible then 190 | begin 191 | StrLCopy(s_notifyIconData.szInfoTitle, PChar(ATitle), High(s_notifyIconData.szInfoTitle)); 192 | StrLCopy(s_notifyIconData.szInfo, PChar(AText), High(s_notifyIconData.szInfo)); 193 | s_notifyIconData.dwInfoFlags := Cardinal(AType); 194 | s_notifyIconData.uFlags := NIF_INFO; 195 | Shell_NotifyIcon(NIM_MODIFY, @s_notifyIconData); 196 | 197 | // reset everything after the message 198 | FillChar(s_notifyIconData.szInfoTitle, High(s_notifyIconData.szInfoTitle), 0); 199 | FillChar(s_notifyIconData.szInfo, High(s_notifyIconData.szInfo), 0); 200 | s_notifyIconData.dwInfoFlags := NIIF_NONE; 201 | s_notifyIconData.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP or NIF_STATE; 202 | Shell_NotifyIcon(NIM_MODIFY, @s_notifyIconData); 203 | end; 204 | end; 205 | 206 | procedure TTrayIcon.Show(ATip: string); 207 | begin 208 | if not s_bVisible then 209 | begin 210 | if not Assigned(s_ptrOldWindowProc) then 211 | begin 212 | s_ptrOldWindowProc := Pointer(GetWindowLongPtr(s_contextMenuHandle, GWL_WNDPROC)); 213 | SetWindowLongPtr(s_contextMenuHandle, GWL_WNDPROC, Integer(@WndProcCallback)); 214 | end; 215 | if not string.IsNullOrEmpty(ATip) and not string.IsNullOrWhiteSpace(ATip) then 216 | begin 217 | StrLCopy(s_notifyIconData.szTip, PChar(ATip), High(s_notifyIconData.szTip)); 218 | end; 219 | Shell_NotifyIcon(NIM_ADD, @s_notifyIconData); 220 | s_bVisible := True; 221 | end; 222 | end; 223 | 224 | procedure TTrayIcon.Hide; 225 | begin 226 | if s_bVisible then 227 | begin 228 | Shell_NotifyIcon(NIM_DELETE, @s_notifyIconData); 229 | s_bVisible := False; 230 | end; 231 | end; 232 | 233 | end. 234 | -------------------------------------------------------------------------------- /RegChangeThread.pas: -------------------------------------------------------------------------------- 1 | unit RegChangeThread; 2 | 3 | interface 4 | 5 | uses 6 | Classes, Windows, Messages, Registry; 7 | 8 | const 9 | WM_REGKEYCHANGE = WM_USER + 42; 10 | REG_NOTIFY_THREAD_AGNOSTIC = $10000000; // Windows 8+ enables the use of 11 | // RegNotifyChangeKeyValue for ThreadPool threads 12 | 13 | type 14 | //author Author: Luthfi B Hakim 15 | TRegMon = class(TComponent) 16 | private 17 | FMonitordKey: string; 18 | FOnChange: TNotifyEvent; 19 | FRootKey: HKey; 20 | FMonitor: TThread; 21 | FWatchSubKeys: Boolean; 22 | FOnActivate: TNotifyEvent; 23 | FOnDeactivate: TNotifyEvent; 24 | procedure SetActive(const Value: Boolean); 25 | procedure SetMonitoredKey(const Value: string); 26 | procedure SetRootKey(const Value: HKey); 27 | function GetActive: Boolean; 28 | procedure SetWatchSubKeys(const Value: Boolean); 29 | protected 30 | procedure DoRegChanged; 31 | public 32 | constructor Create(AOwner: TComponent); override; 33 | destructor Destroy; override; 34 | 35 | procedure Activate; 36 | procedure Deactivate; 37 | published 38 | property RootKey: HKEY read FRootKey write SetRootKey default HKEY_CURRENT_USER; 39 | property MonitoredKey: string read FMonitordKey write SetMonitoredKey; 40 | property WatchSubKeys: Boolean read FWatchSubKeys write SetWatchSubKeys; 41 | property Active: Boolean read GetActive write SetActive default False; 42 | 43 | // event that will be fired when monitored registry key is changed 44 | property OnChange: TNotifyEvent read FOnChange write FOnChange; 45 | // event that will be fired when monitoring is activated 46 | property OnActivate: TNotifyEvent read FOnActivate write FOnActivate; 47 | // evetn that will be fired when monitoring is deactivated 48 | property OnDeactivate: TNotifyEvent read FOnDeactivate write FOnDeactivate; 49 | end; 50 | 51 | TRegChangeThread = class(TThread) 52 | private 53 | FReg: TRegistry; 54 | FEvent: Integer; 55 | FKey: string; 56 | FRootKey: HKEY; 57 | FWatchSub: Boolean; 58 | FFilter: Integer; 59 | FWnd: THandle; 60 | procedure Initialize; 61 | public 62 | constructor Create; 63 | destructor Destroy; override; 64 | procedure Execute; override; 65 | property Key: string read FKey write FKey; 66 | property RootKey: HKey read FRootKey write FRootKey; 67 | property WatchSub: Boolean read FWatchSub write FWatchSub; 68 | property Filter: Integer read FFilter write FFilter; 69 | property Wnd: THandle read FWnd write FWnd; 70 | end; 71 | 72 | implementation 73 | 74 | uses 75 | SysUtils; 76 | 77 | type 78 | TMonitorThread = class(TThread) 79 | private 80 | FReg: TRegistry; 81 | FOwner: TRegMon; 82 | FFilter: DWORD; 83 | FTerminateEvent: THandle; 84 | FMonitorEvent: THandle; 85 | procedure Setup; // Here we initiated our object and vars prior to start 86 | // executing the thread 87 | procedure TearDown; // Here we finalize our object and when the thread is terminated 88 | protected 89 | // main code of the thread 90 | procedure Execute; override; 91 | public 92 | constructor Create(AOwner: TRegMon); reintroduce; 93 | // we reintroduce new Terminate method, since we want to do something after 94 | // calling the original Terminate 95 | procedure Terminate; reintroduce; 96 | end; 97 | 98 | 99 | { TRegChangeThread } 100 | 101 | constructor TRegChangeThread.Create; 102 | begin 103 | inherited Create(True); // So properties can be set before calling Resume 104 | FReg := TRegistry.Create; 105 | end; 106 | 107 | destructor TRegChangeThread.Destroy; 108 | begin 109 | FReg.Free; 110 | inherited; 111 | end; 112 | 113 | procedure TRegChangeThread.Execute; 114 | begin 115 | // inherited; 116 | Initialize; 117 | while not Terminated do 118 | begin 119 | if WaitForSingleObject(FEvent, INFINITE) = WAIT_OBJECT_0 then 120 | begin 121 | SendMessage(FWnd, WM_REGKEYCHANGE, FRootKey, LongInt(PChar(FKey))); 122 | end; 123 | end; 124 | end; 125 | 126 | procedure TRegChangeThread.Initialize; 127 | begin 128 | FReg.RootKey := RootKey; 129 | if not FReg.OpenKey(Key, False) then 130 | begin 131 | raise Exception.Create('Failed to open registry key ' + Key); 132 | end; 133 | FEvent := CreateEvent(nil, LongBool(False), LongBool(False), 'RegChange'); 134 | RegNotifyChangeKeyValue( 135 | FReg.CurrentKey, 136 | LongBool(FWatchSub), 137 | FFilter, 138 | FEvent, 139 | LongBool(True) 140 | ); 141 | end; 142 | 143 | { TRegMon } 144 | 145 | procedure TRegMon.Activate; 146 | begin 147 | if Active then 148 | Exit; 149 | 150 | FMonitor := TMonitorThread.Create(Self); 151 | if Assigned(FOnActivate) then 152 | FOnActivate(Self); 153 | end; 154 | 155 | constructor TRegMon.Create(AOwner: TComponent); 156 | begin 157 | inherited; 158 | FRootKey := HKEY_CURRENT_USER; 159 | end; 160 | 161 | procedure TRegMon.Deactivate; 162 | var 163 | vThread: TMonitorThread; 164 | begin 165 | if not Active then Exit; 166 | 167 | // we have to specifically typecast to TMonitorThread since wa want to call 168 | // the reintroduced Terminate instead of the original Terminate of TThread 169 | vThread := TMonitorThread(FMonitor); 170 | FMonitor := nil; 171 | vThread.Terminate; // call the reintroduced Terminate 172 | Sleep(0); // to immediately yield cpu to other thread/process. 173 | // We aim for our monitoring thread to "sense" termination 174 | // and clean accordingly. 175 | if Assigned(FOnDeactivate) then 176 | FOnDeactivate(Self); 177 | end; 178 | 179 | destructor TRegMon.Destroy; 180 | begin 181 | // Make sure that we stop the monitoring thread prior destruction 182 | Deactivate; 183 | inherited; 184 | end; 185 | 186 | procedure TRegMon.DoRegChanged; 187 | begin 188 | if Assigned(FOnChange) then 189 | FOnChange(Self); 190 | end; 191 | 192 | function TRegMon.GetActive: Boolean; 193 | begin 194 | Result := FMonitor <> nil; 195 | end; 196 | 197 | procedure TRegMon.SetActive(const Value: Boolean); 198 | begin 199 | if Active <> Value then 200 | begin 201 | if Value then 202 | Activate 203 | else 204 | Deactivate; 205 | end; 206 | end; 207 | 208 | procedure TRegMon.SetMonitoredKey(const Value: string); 209 | begin 210 | if FMonitordKey <> Value then 211 | begin 212 | Deactivate; 213 | FMonitordKey := Value; 214 | end; 215 | end; 216 | 217 | procedure TRegMon.SetRootKey(const Value: HKey); 218 | begin 219 | if FRootKey <> Value then 220 | begin 221 | Deactivate; 222 | FRootKey := Value; 223 | end; 224 | end; 225 | 226 | procedure TRegMon.SetWatchSubKeys(const Value: Boolean); 227 | begin 228 | if FWatchSubKeys <> Value then 229 | begin 230 | Deactivate; 231 | FWatchSubKeys := Value; 232 | end; 233 | end; 234 | 235 | { TMonitorThread } 236 | 237 | constructor TMonitorThread.Create(AOwner: TRegMon); 238 | begin 239 | FOwner := AOwner; 240 | inherited Create(False); 241 | FreeOnTerminate := True; 242 | FReg := TRegistry.Create; 243 | FReg.RootKey := FOwner.FRootKey; 244 | if not FReg.OpenKeyReadOnly(FOwner.FMonitordKey) then 245 | raise Exception.Create('Can''t open regitry key!'); 246 | end; 247 | 248 | procedure TMonitorThread.Execute; 249 | var 250 | vEvents: array[1..2] of THandle; 251 | begin 252 | // inherited; 253 | Setup; 254 | try 255 | vEvents[1] := FMonitorEvent; 256 | vEvents[2] := FTerminateEvent; 257 | while not Terminated do 258 | begin 259 | if WaitForMultipleObjects(2, @vEvents, False, INFINITE) = WAIT_OBJECT_0 then 260 | begin 261 | Synchronize(FOwner.DoRegChanged); 262 | ResetEvent(FMonitorEvent); 263 | if RegNotifyChangeKeyValue(FReg.CurrentKey, 264 | FOwner.FWatchSubKeys, FFilter, FMonitorEvent, True) <> ERROR_SUCCESS then 265 | Exit; 266 | end; 267 | end; 268 | finally 269 | TearDown; 270 | end; 271 | end; 272 | 273 | procedure TMonitorThread.Setup; 274 | begin 275 | FFilter := {REG_NOTIFY_CHANGE_NAME or }REG_NOTIFY_CHANGE_LAST_SET; 276 | FMonitorEvent := CreateEvent(nil, True, False, nil); 277 | FTerminateEvent := CreateEvent(nil, True, False, nil); 278 | if RegNotifyChangeKeyValue(FReg.CurrentKey, 279 | FOwner.FWatchSubKeys, FFilter, FMonitorEvent, True) <> ERROR_SUCCESS then 280 | raise Exception.Create('Can''t start monitoring!'); 281 | 282 | end; 283 | 284 | procedure TMonitorThread.TearDown; 285 | begin 286 | CloseHandle(FTerminateEvent); 287 | CloseHandle(FMonitorEvent); 288 | FReg.CloseKey; 289 | FReg.Free; 290 | end; 291 | 292 | procedure TMonitorThread.Terminate; 293 | begin 294 | inherited Terminate; 295 | SetEvent(FTerminateEvent); 296 | end; 297 | 298 | end. 299 | -------------------------------------------------------------------------------- /F11Hook.dpr: -------------------------------------------------------------------------------- 1 | library F11Hook; 2 | 3 | { Important note about DLL memory management: ShareMem must be the 4 | first unit in your library's USES clause AND your project's (select 5 | Project-View Source) USES clause if your DLL exports any procedures or 6 | functions that pass strings as parameters or function results. This 7 | applies to all strings passed to and from your DLL--even those that 8 | are nested in records and classes. ShareMem is the interface unit to 9 | the BORLNDMM.DLL shared memory manager, which must be deployed along 10 | with your DLL. To avoid using BORLNDMM.DLL, pass string information 11 | using PChar or ShortString parameters. } 12 | 13 | uses 14 | Winapi.Windows, 15 | Winapi.Messages, 16 | Winapi.ActiveX, 17 | System.Classes, 18 | System.SysUtils; 19 | 20 | const 21 | MemMapFile = 'WinDroidWnd'; 22 | WM_USER = $0400; 23 | WM_COPYDATA = $004A; 24 | WM_TOGGLEFULLSCREEN = WM_USER + 9; 25 | 26 | const 27 | LLKHF_ALTDOWN = $20; 28 | LLKHF_UP = $80; 29 | 30 | { Define a record for recording and passing information process wide } 31 | type 32 | PKBDLLHOOKSTRUCT = ^TKBDLLHOOKSTRUCT; 33 | TKBDLLHOOKSTRUCT = record 34 | vkCode: Cardinal; 35 | scanCode: Cardinal; 36 | flags: Cardinal; 37 | time: Cardinal; 38 | dwExtrainfo: Cardinal; 39 | end; 40 | 41 | PHookRec = ^THookRec; 42 | THookRec = packed record 43 | HookHandle: HHOOK; 44 | AppHandle: HWND; 45 | CtrlWinHandle: HWND; 46 | KeyCount: DWORD; 47 | CtrlDown: BOOL; 48 | ShiftDown: BOOL; 49 | end; 50 | 51 | TSystemKeyCombination = (skLWin, 52 | skRWin, 53 | skCtrlEsc, 54 | skAltTab, 55 | skAltEsc, 56 | skCtrlShiftEsc, 57 | skAltF4); 58 | TSystemKeyCombinations = set of TSystemKeyCombination; 59 | 60 | {$R *.res} 61 | 62 | var 63 | hObjHandle: THandle; { Variable for the file mappgin object } 64 | lpHookRec: PHookRec; 65 | InvalidCombinations: TSystemKeyCombinations; 66 | AltPressed: BOOL; 67 | CtrlPressed: BOOL; 68 | ShiftPressed: BOOL; 69 | 70 | procedure SwitchToThisWindow(h1: hWnd; x: bool); stdcall; 71 | external user32 Name 'SwitchToThisWindow'; 72 | { Pointer to our hook record } 73 | procedure MapFileMemory (dwAllocSize: DWORD); 74 | begin 75 | { Create a process wide memory mapped variable } 76 | hObjHandle := CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0, dwAllocSize, MemMapFile); 77 | if hObjHandle = 0 then 78 | begin 79 | raise Exception.Create('Hook couldn''t create file map object.'); 80 | Exit; 81 | end; 82 | 83 | { Get a pointer to our process wide memory mapped file } 84 | lpHookRec := MapViewOfFile(hObjHandle, FILE_MAP_WRITE, 0, 0, dwAllocSize); 85 | if lpHookRec = nil then 86 | begin 87 | CloseHandle(hObjHandle); 88 | raise Exception.Create('Hook couldn''t map file.'); 89 | Exit; 90 | end; 91 | end; 92 | 93 | procedure UnmapFileMemory; 94 | begin 95 | { Delete our process wide memory mapped variable } 96 | if lpHookRec <> nil then 97 | begin 98 | UnmapViewOfFile(lpHookRec); 99 | lpHookRec := nil; 100 | end; 101 | 102 | if hObjHandle > 0 then 103 | begin 104 | CloseHandle(hObjHandle); 105 | hObjHandle := 0; 106 | end; 107 | end; 108 | 109 | function GetHookRecPointer:Pointer; stdcall; 110 | begin 111 | { Return a pointer to our process wide memory mapped variable } 112 | Result := lpHookRec; 113 | end; 114 | 115 | function KeyboardProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; 116 | var 117 | ParentHandle: HWND; 118 | hs: PKBDLLHOOKSTRUCT; 119 | command: string; 120 | AppClassName: array[0..255] of char; 121 | currWnd: HWND; 122 | begin 123 | Result := 0; 124 | 125 | case nCode of 126 | HC_ACTION: // HC_ACTION is the only allowed for WH_KEYBOARD_LL 127 | begin 128 | 129 | hs := PKBDLLHOOKSTRUCT(lParam); 130 | 131 | if (wParam = WM_KEYDOWN) or (wParam = WM_SYSKEYDOWN) then 132 | begin 133 | if (hs^.vkCode = VK_SHIFT) or (hs^.vkCode = VK_LSHIFT) or (hs^.vkCode = VK_RSHIFT) then 134 | begin 135 | ShiftPressed := True; 136 | end; 137 | 138 | if (hs^.vkCode = VK_CONTROL) or (hs^.vkCode = VK_LCONTROL) or (hs^.vkCode = VK_RCONTROL) then 139 | begin 140 | CtrlPressed := True; 141 | end; 142 | end; 143 | 144 | if (wParam = WM_KEYUP) or (wParam = WM_SYSKEYUP) then 145 | begin 146 | 147 | /// NOTE: When this callback function is called in response to a change 148 | /// in the state of a key, the callback function is called before the 149 | /// asynchronous state of the key is updated. Consequently, the 150 | /// asynchronous state of the key cannot be determined by calling 151 | /// GetAsyncKeyState from within this callback 152 | 153 | if (hs^.vkCode = VK_SHIFT) or (hs^.vkCode = VK_LSHIFT) or (hs^.vkCode = VK_RSHIFT) then 154 | begin 155 | ShiftPressed := False; 156 | end; 157 | 158 | if (hs^.vkCode = VK_CONTROL) or (hs^.vkCode = VK_LCONTROL) or (hs^.vkCode = VK_RCONTROL) then 159 | begin 160 | CtrlPressed := False; 161 | end; 162 | 163 | // Use hard coded F11 as fullscreen toggler 164 | if (hs^.vkCode = VK_F11) then 165 | begin 166 | 167 | currWnd := GetForegroundWindow; 168 | if currWnd > 0 then 169 | begin 170 | if not IsWindow(currWnd) then 171 | begin 172 | Result := CallNextHookEx(lpHookRec^.HookHandle, nCode, wParam, lParam); 173 | Exit; 174 | end; 175 | end; 176 | 177 | ParentHandle := FindWindow('FMTWinDroidHwnd', nil); 178 | if ParentHandle > 0 then 179 | begin 180 | // FireMonkey windows to have a parent window with win class name TFMAppClass 181 | // However, any other FireMonkey application has it too, so we need to get our one only 182 | //ParentHandle := GetParent(ParentHandle); 183 | // ParentHandle := GetWindowLong(ParentHandle, GWL_HWNDPARENT); 184 | // GetClassName(ParentHandle, AppClassName, 255); 185 | // OutputDebugString(PChar('FONCE '+ AppClassName)); 186 | 187 | 188 | /// The hook procedure should process a message in less time than the data entry specified in the LowLevelHooksTimeout value in the following registry key: 189 | /// HKEY_CURRENT_USER\Control Panel\Desktop 190 | /// The value is in milliseconds. If the hook procedure times out, the system passes the message to the 191 | /// next hook. However, on Windows 7 and later, the hook is silently removed without being called. 192 | /// There is no way for the application to know whether the hook is removed. 193 | // PostMessage(ParentHandle, WM_TOGGLEFULLSCREEN, wParam, Winapi.Windows.LPARAM(PChar(command))); 194 | // PostMessage(ParentHandle, WM_TOGGLEFULLSCREEN, wParam, lParam); 195 | SendMessageTimeout(ParentHandle, WM_TOGGLEFULLSCREEN, wParam, lParam, SMTO_ABORTIFHUNG or SMTO_NORMAL, 5, nil); 196 | end; 197 | end; 198 | end; 199 | end; 200 | end; 201 | 202 | Result := CallNextHookEx(lpHookRec^.HookHandle, nCode, wParam, lParam); 203 | end; 204 | 205 | function StartHook:BOOL stdcall; 206 | begin 207 | Result := False; 208 | { If we have a process wide memory variable and the hook has not already been set } 209 | if ((lpHookRec <> nil) and (lpHookRec^.HookHandle = 0)) then 210 | begin 211 | { Set the hook and remember our hook handle } 212 | lpHookRec^.HookHandle := SetWindowsHookEx(WH_KEYBOARD_LL, @KeyboardProc, HInstance, 0); 213 | Result := True; 214 | end; 215 | end; 216 | 217 | procedure StopHook; stdcall; 218 | begin 219 | { If we have a process wide memory variable and the hook has already been ser } 220 | if ((lpHookRec <> nil) and (lpHookRec^.HookHandle <> 0)) then 221 | begin 222 | { Remove our hook and clear our hook handle } 223 | if (UnhookWindowsHookEx(lpHookRec^.HookHandle) <> False) then 224 | begin 225 | lpHookRec^.HookHandle := 0; 226 | end; 227 | end; 228 | end; 229 | 230 | procedure DllEntryPoint(dwReason: DWORD); 231 | begin 232 | case dwReason of 233 | DLL_PROCESS_ATTACH: 234 | begin 235 | { If we are getting mapped into a process, then get a pointer 236 | to our process wide memory mapped variable } 237 | hObjHandle := 0; 238 | lpHookRec := nil; 239 | MapFileMemory(SizeOf(lpHookRec^)); 240 | end; 241 | DLL_PROCESS_DETACH: 242 | begin 243 | { If we are getting unmapped from a proces then, remove the 244 | pointer to our process wide memory mapped variable } 245 | UnmapFileMemory; 246 | end; 247 | end; 248 | end; 249 | 250 | Exports 251 | KeyboardProc Name 'KEYBOARDPROC', 252 | GetHookRecPointer name 'GETHOOKRECPOINTER', 253 | StartHook name 'STARTHOOK', 254 | StopHook name 'STOPHOOK'; 255 | 256 | begin 257 | DllProc := @DllEntryPoint; 258 | DllEntryPoint(DLL_PROCESS_ATTACH); 259 | end. 260 | 261 | 262 | -------------------------------------------------------------------------------- /frmBrowser.pas: -------------------------------------------------------------------------------- 1 | unit frmBrowser; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, WebView2, Winapi.ActiveX, Vcl.Edge, 8 | Vcl.OleCtrls, SHDocVw, SHDocVw_EWB, EwbCore, EmbeddedWB, IEDownload, 9 | IEMultiDownload, UrlMon, Vcl.ExtCtrls, UWP.Downloader, Vcl.WinXPanels, 10 | Vcl.ComCtrls, Winapi.Mshtmhst, Vcl.StdCtrls, Vcl.FileCtrl; 11 | 12 | const 13 | DOCHOSTUIFLAG_DPI_AWARE = $40000000; 14 | IID_IDownloadManager: TGUID = '{988934A4-064B-11D3-BB80-00104B35E7F9}'; 15 | SID_IDownloadManager: TGUID = '{988934A4-064B-11D3-BB80-00104B35E7F9}'; 16 | 17 | type 18 | //https://stackoverflow.com/a/13389595/537347 19 | IDownloadManager = interface(IUnknown) 20 | ['{988934A4-064B-11D3-BB80-00104B35E7F9}'] 21 | function Download(pmk: IMoniker; pbc: IBindCtx; dwBindVerb: DWORD; 22 | grfBINDF: DWORD; pBindInfo: PBindInfo; pszHeaders: PWideChar; 23 | pszRedir: PWideChar; uiCP: UINT): HRESULT; stdcall; 24 | end; 25 | 26 | TBeforeFileDownloadEvent = procedure(Sender: TObject; const FileSource: WideString; 27 | var Allowed: Boolean) of Object; 28 | 29 | TWebBrowser = class(SHDocVw.TWebBrowser, IServiceProvider, IDownloadManager, IDocHostUIHandler) 30 | private 31 | FFileSource: WideString; 32 | FOnBeforeFileDownload: TBeforeFileDownloadEvent; 33 | function QueryService(const rsid, iid: TGUID; out Obj): HRESULT; stdcall; 34 | function Download(pmk: IMoniker; pbc: IBindCtx; dwBindVerb: DWORD; 35 | grfBINDF: DWORD; pBindInfo: PBindInfo; pszHeaders: PWideChar; 36 | pszRedir: PWideChar; uiCP: UINT): HRESULT; stdcall; 37 | 38 | // handling special chars 39 | procedure CNChar(var Msg: TWMChar); message CN_CHAR; 40 | // making webbrowser DPI aware https://stackoverflow.com/a/63810030 41 | function GetHostInfo(var pInfo: TDocHostUIInfo): HRESULT; stdcall; 42 | protected 43 | procedure InvokeEvent(ADispID: TDispID; var AParams: TDispParams); override; 44 | published 45 | property OnBeforeFileDownload: TBeforeFileDownloadEvent read FOnBeforeFileDownload write FOnBeforeFileDownload; 46 | end; 47 | 48 | TfrmWeb = class(TForm) 49 | WebBrowser1: TWebBrowser; 50 | UWPDownloader1: TUWPDownloader; 51 | PageControl1: TPageControl; 52 | TabSheet1: TTabSheet; 53 | TabSheet2: TTabSheet; 54 | FileListBox1: TFileListBox; 55 | procedure FormCreate(Sender: TObject); 56 | procedure UWPDownloader1Downloaded(Sender: TObject; DownloadCode: Integer); 57 | procedure WebBrowser1NewWindow2(ASender: TObject; var ppDisp: IDispatch; 58 | var Cancel: WordBool); 59 | procedure ListView1DblClick(Sender: TObject); 60 | procedure VirtualExplorerListview1DblClick(Sender: TObject); 61 | procedure FileListBox1DblClick(Sender: TObject); 62 | procedure WebBrowser1DocumentComplete(ASender: TObject; 63 | const pDisp: IDispatch; const URL: OleVariant); 64 | private 65 | { Private declarations } 66 | procedure BeforeFileDownload(Sender: TObject; const FileSource: WideString; 67 | var Allowed: Boolean); 68 | function getAPKversion: string; 69 | public 70 | { Public declarations } 71 | end; 72 | 73 | var 74 | frmWeb: TfrmWeb; 75 | 76 | implementation 77 | 78 | uses 79 | System.Net.HttpClient, {IdHTTP,} helperFuncs, 80 | frmApkInstaller, MSHTML; 81 | 82 | {$R *.dfm} 83 | 84 | procedure TfrmWeb.BeforeFileDownload(Sender: TObject; 85 | const FileSource: WideString; var Allowed: Boolean); 86 | function GetAttachmentFilename(CD: string): string; 87 | var 88 | fq, sq: Integer; 89 | begin 90 | Result := 'fileattachment'; 91 | if CD.Contains('filename') then // e.g. Content-Disposition returns: attachment; filename="filename.ext" 92 | begin 93 | fq := Pos('"', CD); 94 | sq := Pos('"', CD, fq + 1); 95 | if (fq > 0) and (sq > 0) and (sq > fq) then 96 | begin 97 | Result := Copy(CD, fq + 1, sq - fq - 1); 98 | end; 99 | 100 | end; 101 | 102 | end; 103 | var 104 | FileTarget: string; 105 | LUrl: string; 106 | // Http: TIdHTTP; 107 | Client: THTTPClient; 108 | Response: IHTTPResponse; 109 | begin 110 | Allowed := False; 111 | // ShowMessage(FileSource); 112 | LUrl := Trim(FileSource); 113 | if LUrl = '' then Exit; 114 | 115 | Var domain := ExtractDomain(LUrl); 116 | Client := THTTPClient.Create; 117 | // Http := TIdHTTP.Create(nil); 118 | try 119 | try 120 | Response := Client.Head(LUrl, nil); 121 | except 122 | end; 123 | // Http.Head(LUrl); 124 | if Assigned(Response) and (Response.StatusCode = 200) and (Response.ContentLength > 0) then 125 | begin 126 | var fName := GetAttachmentFilename(Response.HeaderValue['Content-Disposition']); //Http.Response.RawHeaders.Params['Content-Disposition', 'filename']; 127 | var Prompt := Format('You chose to download: '#13#10'%s '#13#10'Size: %s '#13#10'From %s. '#13#10''#13#10'Continue?', 128 | [ 129 | fName, 130 | FormatFileSize(Response.ContentLength),//Http.Response.ContentLength), 131 | domain 132 | ]); 133 | if MessageDlg(Prompt,TMsgDlgType.mtConfirmation, mbYesNo, 0) = mrYes then 134 | begin 135 | UWPDownloader1.SavePath := ExtractFilePath(ParamStr(0)) + 'Downloads\' + fName; 136 | UWPDownloader1.Detail := fName; 137 | UWPDownloader1.URL := LUrl; 138 | UWPDownloader1.DoStartDownload; 139 | // PageControl1.SelectNextPage(True); 140 | end; 141 | end; 142 | finally 143 | Client.Free; 144 | // Http.Free; 145 | end; 146 | 147 | 148 | end; 149 | 150 | procedure TfrmWeb.FileListBox1DblClick(Sender: TObject); 151 | begin 152 | frmInstaller.FApkFile := FileListBox1.Items[FileListBox1.ItemIndex]; 153 | frmInstaller.Show; 154 | frmInstaller.FApkInfo.DisplayName := ''; 155 | frmInstaller.FApkInfo.DisplayVersion := ''; 156 | frmInstaller.FApkInfo.PackageName := ''; 157 | frmInstaller.FApkInfo.Icon := ''; 158 | 159 | frmInstaller.FApkPermissions.Clear; 160 | if LowerCase(FileListBox1.Items[FileListBox1.ItemIndex]).Contains('.xapk') then 161 | frmInstaller.GetXAPKInfo 162 | else 163 | frmInstaller.GetAPKInfoWithAndroidAssetPackagingTool; 164 | end; 165 | 166 | procedure TfrmWeb.FormCreate(Sender: TObject); 167 | begin 168 | WebBrowser1.Silent := True; 169 | WebBrowser1.OnBeforeFileDownload := BeforeFileDownload; 170 | 171 | if DirectoryExists(ExtractFilePath(ParamStr(0))+'Downloads') then 172 | begin 173 | FileListBox1.Directory := ExtractFilePath(ParamStr(0))+'Downloads'; 174 | end; 175 | end; 176 | 177 | function TfrmWeb.getAPKversion: string; 178 | begin 179 | result := OleVariant((WebBrowser1.Document as IHTMLDocument2).parentWindow.document).page_config.info.version_name; 180 | end; 181 | 182 | procedure TfrmWeb.ListView1DblClick(Sender: TObject); 183 | begin 184 | // frmInstaller.FApkFile := ListView1.Items[ListView1.ItemIndex].; 185 | frmInstaller.Show; 186 | frmInstaller.FApkInfo.DisplayName := ''; 187 | frmInstaller.FApkInfo.DisplayVersion := ''; 188 | frmInstaller.FApkInfo.PackageName := ''; 189 | frmInstaller.FApkInfo.Icon := ''; 190 | 191 | frmInstaller.FApkPermissions.Clear; 192 | frmInstaller.GetAPKInfoWithAndroidAssetPackagingTool; 193 | end; 194 | 195 | procedure TfrmWeb.UWPDownloader1Downloaded(Sender: TObject; 196 | DownloadCode: Integer); 197 | begin 198 | ShowMessage('File Downloaded!'); 199 | end; 200 | 201 | procedure TfrmWeb.VirtualExplorerListview1DblClick(Sender: TObject); 202 | begin 203 | 204 | end; 205 | 206 | // prevent opening links in MSEdge 207 | procedure TfrmWeb.WebBrowser1DocumentComplete(ASender: TObject; 208 | const pDisp: IDispatch; const URL: OleVariant); 209 | begin 210 | if string(URL).Contains('apkpure.com/en/') then 211 | Caption := 'Latest version: ' + getAPKversion; 212 | end; 213 | 214 | procedure TfrmWeb.WebBrowser1NewWindow2(ASender: TObject; var ppDisp: IDispatch; 215 | var Cancel: WordBool); 216 | begin 217 | Cancel := True; 218 | end; 219 | 220 | { TWebBrowser } 221 | 222 | procedure TWebBrowser.CNChar(var Msg: TWMChar); 223 | begin 224 | Msg.Result := 0; 225 | end; 226 | 227 | function TWebBrowser.Download(pmk: IMoniker; pbc: IBindCtx; dwBindVerb, 228 | grfBINDF: DWORD; pBindInfo: PBindInfo; pszHeaders, pszRedir: PWideChar; 229 | uiCP: UINT): HRESULT; 230 | var 231 | Allowed: Boolean; 232 | begin 233 | Result := E_NOTIMPL; 234 | if Assigned(FOnBeforeFileDownload) then 235 | begin 236 | Allowed := True; 237 | if pszRedir <> '' then 238 | FFileSource := pszRedir; 239 | FOnBeforeFileDownload(Self, FFileSource, Allowed); 240 | if not Allowed then 241 | Result := S_OK; 242 | end; 243 | end; 244 | 245 | function TWebBrowser.GetHostInfo(var pInfo: TDocHostUIInfo): HRESULT; 246 | begin 247 | // original code 248 | pInfo.cbSize := SizeOf(pInfo); 249 | pInfo.dwFlags := 0; 250 | pInfo.dwFlags := pInfo.dwFlags or DOCHOSTUIFLAG_NO3DBORDER; 251 | pInfo.dwFlags := pInfo.dwFlags or DOCHOSTUIFLAG_THEME; 252 | pInfo.dwFlags := pInfo.dwFlags or DOCHOSTUIFLAG_DPI_AWARE; // NEW added flag 253 | Result := S_OK; 254 | // ResizeScrollBars; // will be called by subsequent routines anyway 255 | end; 256 | 257 | procedure TWebBrowser.InvokeEvent(ADispID: TDispID; var AParams: TDispParams); 258 | begin 259 | inherited; 260 | /// DispID 250 is the BeforeNavigatte2 dispinterface and to the FFileSource here 261 | /// is stored the URL parameter (for cases, when the IDownloaderManager::Download 262 | /// won't redirect the URL and pass empty string to the pszRedir) 263 | if ADispID = 250 then 264 | FFileSource := OleVariant(AParams.rgvarg^[5]); 265 | end; 266 | 267 | function TWebBrowser.QueryService(const rsid, iid: TGUID; out Obj): HRESULT; 268 | begin 269 | Result := E_NOINTERFACE; 270 | Pointer(Obj) := nil; 271 | if Assigned(FOnBeforeFileDownload) and IsEqualCLSID(rsid, SID_IDownloadManager) and 272 | IsEqualIID(iid, IID_IDownloadManager) then 273 | begin 274 | if Succeeded(QueryInterface(IID_IDownloadManager, Obj)) and 275 | Assigned(Pointer(Obj)) 276 | then 277 | Result := S_OK; 278 | end; 279 | end; 280 | 281 | end. 282 | -------------------------------------------------------------------------------- /TaskbarPinner.pas: -------------------------------------------------------------------------------- 1 | unit TaskbarPinner; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls, 8 | ShlObj, ActiveX, ShellApi, ComObj, RegChangeThread, DWMApi; 9 | 10 | const 11 | SID_IShellDispatch6 = '{286e6f1b-7113-4355-9562-96b7e9d64c54}'; 12 | IID_IShellDispatch5: TGUID = SID_IShellDispatch6; 13 | 14 | 15 | const 16 | CLSID_TaskbandPin: TGUID = '{90AA3A4E-1CBA-4233-B8BB-535773D48449}'; 17 | CLSID_TrayNotify: TGUID = '{25DEAD04-1EAC-4911-9E3A-AD0A4AB560FD}'; 18 | 19 | IID_IFlexibleTaskbarPinnedList: TGUID = '{60274FA2-611F-4B8A-A293-F27BF103D148}'; 20 | IID_IUnknown: TGUID = '{00000000-0000-0000-C000-000000000046}'; 21 | IID_IFlexibleTaskbarPinnedList0: TGUID = '{53d51c3c-d7e0-4fec-b4c6-33b4f8a41c64}'; 22 | IID_IFlexibleTaskbarPinnedList1: TGUID = '{60274FA2-611F-4B8A-A293-F27BF103D148}'; 23 | IID_IFlexibleTaskbarPinnedList2: TGUID = '{BBD20037-BC0E-42F1-913F-E2936BB0EA0C}'; 24 | IID_IFlexibleTaskbarPinnedList3: TGUID = '{C3C6EB6D-C837-4EAE-B172-5FEC52A2A4FD}'; 25 | IID_IPinnedList3: TGUID = '{0DD79AE2-D156-45D4-9EEB-3B549769E940}'; 26 | SID_ITrayNotify = '{FB852B2C-6BAD-4605-9551-F15F87830935}'; 27 | IID_ITrayNotify: TGUID = '{FB852B2C-6BAD-4605-9551-F15F87830935}'; 28 | SID_INotificationCB = '{D782CCBA-AFB0-43F1-94DB-FDA3779EACCB}'; 29 | IID_INotificationCB: TGUID = '{D782CCBA-AFB0-43F1-94DB-FDA3779EACCB}'; 30 | 31 | type 32 | PLMC =(PLMC_EXPLORER = 4); 33 | 34 | IFlexibleTaskbarPinnedList = interface(IUnknown) 35 | ['{60274FA2-611F-4B8A-A293-F27BF103D148}'] 36 | // function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall; 37 | // function _AddRef: Integer; stdcall; 38 | // function _Release: Integer; stdcall; 39 | function EnumObjects(var p2: IEnumFullIDList): HRESULT; stdcall; 40 | function GetPinnableinfo: HRESULT; stdcall; 41 | function IsPinnable: HRESULT; stdcall; 42 | function Resolve: HRESULT; stdcall; 43 | function LeaveFolder: HRESULT; stdcall; 44 | function GetChangeCount: HRESULT; stdcall; 45 | function IsPinned: HRESULT; stdcall; 46 | function GetPinnedItem: HRESULT; stdcall; 47 | function GetAppIDForPinnedItem: HRESULT; stdcall; 48 | function ItemChangeNotify: HRESULT; stdcall; 49 | function UpdateForRemovedItemsAsNecessary: HRESULT; stdcall; 50 | function PinShellLink: HRESULT; stdcall; 51 | function GetPinnedItemForAppID: HRESULT; stdcall; 52 | function ApplyPrependDefaultTaskbarLayour: HRESULT; stdcall; 53 | function ApplyInPlaceTaskbarLayout: HRESULT; stdcall; 54 | function ApplyReorderTaskbarLayout: HRESULT; stdcall; 55 | function IsEmpty: HRESULT; stdcall; 56 | end; 57 | 58 | // Windows Vista 59 | IPinnedList = interface(IUnknown) 60 | ['{C3C6EB6D-C837-4EAE-B172-5FEC52A2A4FD}'] 61 | function EnumObjects: HRESULT; stdcall; // $18 62 | function Modify: HRESULT; stdcall; // $20 63 | function GetChangeCount: HRESULT; stdcall;// $28 64 | function IsPinnable: HRESULT; stdcall; // $30 65 | function Resolve: HRESULT; stdcall; // $38 66 | function IsPinned: HRESULT; stdcall; // $40 67 | end; 68 | 69 | // Windows 7, 8, 8.1 70 | IPinnedList2 = interface(IUnknown) 71 | ['{BBD20037-BC0E-42F1-913F-E2936BB0EA0C}'] 72 | function EnumObjects: HRESULT; stdcall; // $18 73 | function Modify: HRESULT; stdcall; // $20 74 | function GetChangeCount: HRESULT; stdcall;// $28 75 | function GetPinnableInfo: HRESULT; stdcall;// $30 76 | function IsPinnable: HRESULT; stdcall; // $38 77 | function Resolve: HRESULT; stdcall; // $40 78 | function IsPinned: HRESULT; stdcall; // $48 79 | function GetPinnedItem: HRESULT; stdcall; // $50 80 | function GetAppIDForPinnedItem: HRESULT; stdcall; // $58 81 | function ItemChangeNotify: HRESULT; stdcall; // $60 82 | function UpdateForRemovedItemsAsNecessary: HRESULT; stdcall; // $68 83 | end; 84 | 85 | // Windows 10 build 1809+ 86 | IPinnedList3 = interface(IUnknown) 87 | ['{0DD79AE2-D156-45D4-9EEB-3B549769E940}'] 88 | function EnumObjects(var ppv: IEnumFullIDList): HRESULT; stdcall; // $18 89 | function GetPinnableInfo(ido: IDataObject; pinnableFlag: Integer; var isi, isi2: IShellItem; var us: USHORT; i: integer): HRESULT; stdcall;// $20 90 | function IsPinnable(pn: IDataObject; pinableFlag: Integer): HRESULT; stdcall; // $28 91 | function Resolve(hWnd: HWND; l: ULONG; pidl: PCIDLIST_ABSOLUTE; var pidlo: PCIDLIST_ABSOLUTE): HRESULT; stdcall; // $30 92 | function LegacyModify(unpin: PCIDLIST_ABSOLUTE; pin: PCIDLIST_ABSOLUTE): HRESULT; stdcall; // $38 93 | //Software\\Microsoft\\Windows\\CurrentVersion\\Explorer\\Taskband", L"FavoritesChanges 94 | function GetChangeCount(var FavoritesChanges: ULONG): HRESULT; stdcall;// $40 95 | function IsPinned(pin: PCIDLIST_ABSOLUTE): HRESULT; stdcall; // $48 S_OK = pinned S_FALSE = not pinned 96 | function GetPinnedItem(pidl: PCIDLIST_ABSOLUTE; var pidlI: PCIDLIST_ABSOLUTE): HRESULT; stdcall; // $50 97 | function GetAppIDForPinnedItem(pidl: PCIDLIST_ABSOLUTE; var apID: USHORT): HRESULT; stdcall; // $58 98 | function ItemChangeNotify(pidl1: PCIDLIST_ABSOLUTE; pidl2: PCIDLIST_ABSOLUTE): HRESULT; stdcall; // $60 99 | function UpdateForRemovedItemsAsNecessary: HRESULT; stdcall; // $68 100 | function PinShellLink(us: USHORT; var ish: IShellLinkW): HRESULT; stdcall; // $70 101 | function GetPinnedItemForAppID(apID: USHORT; var pidl: PCIDLIST_ABSOLUTE): HRESULT; stdcall; // $78 102 | function Modify(unpin: PCIDLIST_ABSOLUTE; pin: PCIDLIST_ABSOLUTE; caller: PLMC): HRESULT; stdcall; // $80 103 | end; 104 | 105 | LPNOTIFYITEM = ^tagNOTIFYITEM; 106 | tagNOTIFYITEM = record 107 | pszExeName: LPWSTR; 108 | pszIconText: LPWSTR; 109 | hIcon: HICON; 110 | hWnd: HWND; 111 | dwUserPref: DWORD; 112 | uID: UINT; 113 | guitItem: TGUID; 114 | end; 115 | NOTIFYITEM = tagNOTIFYITEM; 116 | 117 | 118 | INotificationCB = interface(IUnknown) 119 | [SID_INotificationCB] 120 | function Notify(dwMessage: DWORD; var pNotifyItem: NotifyItem): HRESULT; stdcall; 121 | end; 122 | 123 | ITrayNotify = interface(IUnknown) 124 | [SID_ITrayNotify] 125 | function RegisterCallback(var pNotifyCB: INotificationCB): HRESULT; stdcall; 126 | function SetPreference(pNotifyItem: LPNOTIFYITEM): HRESULT; stdcall; 127 | function EnableAutoTray(bTraySetting: BOOL): HRESULT; stdcall; 128 | end; 129 | 130 | { interface IShellDispatch6 Windows 8+ } 131 | IShellDispatch6 = interface(IShellDispatch5) 132 | [SID_IShellDispatch6] 133 | function SearchCommand: HRESULT; stdcall; { [helpstring] } 134 | end; 135 | 136 | type 137 | TOnTaskbarPinChange = procedure(Sender: TObject) of Object; 138 | 139 | TTaskbarPinner = class (TObject) 140 | private 141 | FPinList: TStringList; 142 | FOnTaskbarPinChange: TOnTaskbarPinChange; 143 | procedure SetOnTaskbarPinChange(const Value: TOnTaskbarPinChange); 144 | function GetPinnedList: TStringList; 145 | public 146 | function PinLnk(lnkPath: string; UnPinIfPinned: Boolean = False): Boolean; 147 | 148 | constructor Create; 149 | destructor Destroy; override; 150 | published 151 | property OnTaskbarPinChange: TOnTaskbarPinChange read FOnTaskbarPinChange write SetOnTaskbarPinChange; 152 | property Items: TStringList read GetPinnedList; 153 | end; 154 | 155 | implementation 156 | 157 | uses 158 | helperFuncs; 159 | 160 | { TTaskbarPinner } 161 | 162 | constructor TTaskbarPinner.Create; 163 | begin 164 | FPinList := TStringList.Create; 165 | end; 166 | 167 | destructor TTaskbarPinner.Destroy; 168 | begin 169 | FPinList.Free; 170 | 171 | inherited; 172 | end; 173 | 174 | function TTaskbarPinner.GetPinnedList: TStringList; 175 | var 176 | hr: HRESULT; 177 | vPinList: IPinnedList3; 178 | vEnumList: IEnumFullIDList; 179 | vPIDL: PItemIDList; 180 | vFileInfo: TSHFileInfoW; 181 | ul: ULONG; 182 | pn: array[0..1024] of char; 183 | begin 184 | Result := nil; 185 | if not Assigned(FPinList) then Exit; 186 | 187 | FPinList.BeginUpdate; 188 | FPinList.Clear; 189 | hr := ActiveX.CoCreateInstance(CLSID_TaskbandPin, nil, CLSCTX_INPROC_SERVER, IID_IPinnedList3, vPinList); 190 | if hr = S_OK then 191 | begin 192 | hr := vPinList.EnumObjects(vEnumList); 193 | if hr = S_OK then 194 | begin 195 | hr := vEnumList.Reset; 196 | ul := 0; 197 | repeat 198 | hr := vEnumList.Next(1, vPIDL, ul); 199 | if hr = S_OK then 200 | begin 201 | FillChar(vFileInfo, SizeOf(vFileInfo), 0); 202 | ul := SHGetFileInfo(PChar(vPIDL), 0, vFileInfo, SizeOf(vFileInfo), SHGFI_PIDL or SHGFI_DISPLAYNAME); 203 | if ul > 0 then 204 | begin 205 | SHGetPathFromIDList(vPIDL, pn); 206 | var strName := string(pn); // fullpath to .lnk location 207 | if IsImmersivePidl(vPIDL) then 208 | FPinList.AddPair(vFileInfo.szDisplayName, 'UWP') 209 | else 210 | FPinList.AddPair(vFileInfo.szDisplayName, strName); 211 | CoTaskMemFree(vPIDL); 212 | end; 213 | end; 214 | 215 | until hr <> S_OK; 216 | end; 217 | 218 | end; 219 | FPinList.EndUpdate; 220 | Result := FPinList; 221 | end; 222 | 223 | function TTaskbarPinner.PinLnk(lnkPath: string; 224 | UnPinIfPinned: Boolean): Boolean; 225 | var 226 | hr: HRESULT; 227 | vPinList: IPinnedList3; 228 | vPIDL: PItemIDList; 229 | vBuff: array[0..1024] of WideChar; 230 | cc: Cardinal; 231 | begin 232 | CoInitialize(nil); 233 | 234 | Result := False; 235 | 236 | hr := ActiveX.CoCreateInstance(CLSID_TaskbandPin, nil, CLSCTX_INPROC_SERVER, IID_IPinnedList3, vPinList); 237 | if Succeeded(hr) then 238 | begin 239 | StringToWideChar(lnkPath, vBuff, (High(vBuff) - Low(vBuff) + 1)); 240 | vPIDL := ILCreateFromPath(@vBuff); 241 | try 242 | hr := vPinList.IsPinned(PCIDLIST_ABSOLUTE(vPIDL)); 243 | if hr = S_OK then 244 | begin 245 | if UnPinIfPinned then 246 | hr := vPinList.Modify(PCIDLIST_ABSOLUTE(vPIDL), nil, PLMC_EXPLORER); 247 | end 248 | else 249 | hr := vPinList.Modify(nil, PCIDLIST_ABSOLUTE(vPIDL), PLMC_EXPLORER); 250 | 251 | if Succeeded(hr) then 252 | begin 253 | vPinList.GetChangeCount(cc); // should we notify registry changed? #TODO 254 | Result := True; 255 | end; 256 | finally 257 | ILFree(vPIDL); 258 | end; 259 | end; 260 | 261 | CoUninitialize; 262 | end; 263 | 264 | procedure TTaskbarPinner.SetOnTaskbarPinChange( 265 | const Value: TOnTaskbarPinChange); 266 | begin 267 | FOnTaskbarPinChange := Value; 268 | end; 269 | 270 | end. 271 | 272 | -------------------------------------------------------------------------------- /wsa.pas: -------------------------------------------------------------------------------- 1 | unit wsa; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Generics.Collections, System.Classes, Vcl.ImageCollection; 7 | 8 | type 9 | PAPK = ^TAPK; 10 | TAPK = record 11 | AndroidPackageName: string; 12 | AndroidVersionCode: string; 13 | DisplayIcon: string; 14 | DisplayName: string; 15 | DisplayVersion: string; 16 | EstimatedSize: Integer; 17 | InstallDate: string; 18 | ModifyPath: string; 19 | NoRepair: Integer; 20 | Publisher: string; 21 | QuietUninstallString: string; 22 | UninstalString: string; 23 | end; 24 | 25 | TAPKList = class(TList) 26 | private 27 | function Get(Index: Integer): PAPK; 28 | public 29 | destructor Destroy; override; 30 | function Add(Value: PAPK): Integer; 31 | property Items[Index: Integer]: PAPK read Get; default; 32 | end; 33 | 34 | TWSA = class 35 | private 36 | FInstalledApps: TAPKList; 37 | FImageCollection: TImageCollection; 38 | FInstallationPath: string; 39 | FAppUserModelId: string; 40 | FVersion: string; 41 | FDisplayName: string; 42 | FMinimumWindowsVersion: string; 43 | FIconPath: string; 44 | FLogoPath: string; 45 | FPublisherDisplayName: string; 46 | FWsaClientRelativePath: string; 47 | FWsaSettingsRelativePath: string; 48 | procedure SetInstallationPath(const Value: string); 49 | procedure SetAppUserModelId(const Value: string); 50 | procedure SetVersion(const Value: string); 51 | procedure SetDisplayName(const Value: string); 52 | procedure SetMinimumWindowsVersion(const Value: string); 53 | procedure SetIconPath(const Value: string); 54 | procedure SetLogoPath(const Value: string); 55 | procedure SetPublisherDisplayName(const Value: string); 56 | procedure SetWsaClientRelativePath(const Value: string); 57 | procedure SetWsaSettingsRelativePath(const Value: string); 58 | {WSA related things} 59 | public 60 | constructor Create; 61 | destructor Destroy; override; 62 | 63 | procedure UpdateInstalledAPKList; 64 | 65 | property InstallationPath: string read FInstallationPath write SetInstallationPath; 66 | property AppUserModelId: string read FAppUserModelId write SetAppUserModelId; 67 | property Version: string read FVersion write SetVersion; 68 | property DisplayName: string read FDisplayName write SetDisplayName; 69 | property IconPath: string read FIconPath write SetIconPath; 70 | property LogoPath: string read FLogoPath write SetLogoPath; 71 | property PublisherDisplayName: string read FPublisherDisplayName write SetPublisherDisplayName; 72 | property MinimumWindowsVersion: string read FMinimumWindowsVersion write SetMinimumWindowsVersion; 73 | property WsaClientRelativePath: string read FWsaClientRelativePath write SetWsaClientRelativePath; 74 | property WsaSettingsRelativePath: string read FWsaSettingsRelativePath write SetWsaSettingsRelativePath; 75 | end; 76 | 77 | implementation 78 | 79 | uses 80 | Winapi.ShlObj, Winapi.ActiveX, Winapi.KnownFolders, Winapi.ShellAPI, 81 | Winapi.PropKey, Vcl.Graphics, System.SysUtils, helperFuncs; 82 | 83 | { TWSA } 84 | 85 | constructor TWSA.Create; 86 | begin 87 | FInstalledApps := TAPKList.Create; 88 | FImageCollection := TImageCollection.Create(nil); 89 | end; 90 | 91 | destructor TWSA.Destroy; 92 | begin 93 | FImageCollection.Free; 94 | FInstalledApps.Free; 95 | inherited; 96 | end; 97 | 98 | procedure TWSA.SetAppUserModelId(const Value: string); 99 | begin 100 | FAppUserModelId := Value; 101 | end; 102 | 103 | procedure TWSA.SetDisplayName(const Value: string); 104 | begin 105 | FDisplayName := Value; 106 | end; 107 | 108 | procedure TWSA.SetIconPath(const Value: string); 109 | begin 110 | FIconPath := Value; 111 | end; 112 | 113 | procedure TWSA.SetInstallationPath(const Value: string); 114 | begin 115 | FInstallationPath := Value; 116 | end; 117 | 118 | procedure TWSA.SetLogoPath(const Value: string); 119 | begin 120 | FLogoPath := Value; 121 | end; 122 | 123 | procedure TWSA.SetMinimumWindowsVersion(const Value: string); 124 | begin 125 | FMinimumWindowsVersion := Value; 126 | end; 127 | 128 | procedure TWSA.SetPublisherDisplayName(const Value: string); 129 | begin 130 | FPublisherDisplayName := Value; 131 | end; 132 | 133 | procedure TWSA.SetVersion(const Value: string); 134 | begin 135 | FVersion := Value; 136 | end; 137 | 138 | procedure TWSA.SetWsaClientRelativePath(const Value: string); 139 | begin 140 | FWsaClientRelativePath := Value; 141 | end; 142 | 143 | procedure TWSA.SetWsaSettingsRelativePath(const Value: string); 144 | begin 145 | FWsaSettingsRelativePath := Value; 146 | end; 147 | 148 | procedure TWSA.UpdateInstalledAPKList; 149 | var 150 | io: IKnownFolderManager; 151 | count: Cardinal; 152 | a: PGUIDList; 153 | knownfoldernative: IKnownFolder; 154 | hr: HRESULT; 155 | oguid: TGUID; 156 | si: IShellItem2; 157 | sfgao: Cardinal; 158 | isFileSystem: Boolean; 159 | fd: TKnownFolderDefinition; 160 | Item: TStrings; 161 | fPath: array[0..1024] of Char; 162 | 163 | pidControl: PItemIDList; 164 | psfDesktop, dt: IShellFolder; 165 | psfControl: IShellFolder; 166 | pc: IShellFolder2; 167 | pEnumList: IEnumIDList; 168 | pidChild: PItemIDList; 169 | pidAbsolute: PItemIDList; 170 | celtFetched: ULONG; 171 | fileInfo: SHFILEINFOW; 172 | 173 | vAPK: PAPK; 174 | begin 175 | CoInitialize(nil); 176 | 177 | // Clear content 178 | FImageCollection.Images.Clear; 179 | FInstalledApps.Clear; 180 | 181 | CoCreateInstance(CLSID_KnownFolderManager, nil, CLSCTX_ALL, IID_IKnownFolderManager, io); 182 | if Assigned(io) then 183 | begin 184 | //FOLDERID_AppsFolder 1e87508d-89c2-42f0-8a7e-645a0f50ca58 185 | hr := io.GetFolder(FOLDERID_AppsFolder, knownfoldernative); 186 | if hr = S_OK then 187 | begin 188 | hr := knownfoldernative.GetShellItem(0, IID_IShellItem2, si); 189 | if Succeeded(hr) then 190 | begin 191 | if si <> nil then 192 | begin 193 | si.GetAttributes(SFGAO_FILESYSTEM, sfgao); 194 | isFileSystem := (sfgao and SFGAO_FILESYSTEM) <> 0; 195 | 196 | if not isFileSystem then 197 | begin 198 | knownfoldernative.GetFolderDefinition(fd); 199 | if SHGetDesktopFolder(psfDesktop) = S_OK then 200 | if SHGetDesktopFolder(dt) = S_OK then 201 | if knownfoldernative.GetIDList(KF_FLAG_DEFAULT, pidControl) = S_OK then 202 | if psfDesktop.BindToObject(pidControl, nil, IID_IShellFolder, psfControl) = S_OK then 203 | if psfControl.EnumObjects(0, SHCONTF_NONFOLDERS or SHCONTF_INCLUDEHIDDEN, pEnumList) = S_OK then 204 | begin 205 | GetMem(vAPK, SizeOf(TAPK)); 206 | while pEnumList.Next(1, pidChild, celtFetched) = 0 do 207 | begin 208 | pidAbsolute := ILCombine(pidControl, pidChild); 209 | if dt.BindToObject(pidControl, nil, IID_IShellFolder2, Pointer(pc)) = S_OK then 210 | begin 211 | var sa, lnk, flnk: OleVariant; 212 | // var cs: SHCOLUMNID; 213 | // cs.fmtid := StringToGUID('{9F4C2855-9F79-4B39-A8D0-E1D42DE1D5F3}'); 214 | // cs.pid := 5; 215 | if pc.GetDetailsEx(pidChild, SHCOLUMNID(PKEY_AppUserModel_ID), @sa) = S_OK then 216 | begin 217 | var re: HRESULT; 218 | try 219 | re := (pc.GetDetailsEx(pidChild, SHCOLUMNID(PKEY_Link_Arguments), @flnk)); 220 | re := (pc.GetDetailsEx(pidChild, SHCOLUMNID(PKEY_Link_TargetParsingPath), @lnk)); 221 | // SHGetPathFromIDList(pidAbsolute, fPath); 222 | except 223 | lnk := ''; 224 | end; 225 | 226 | if IsValidAppPackageName(sa) 227 | or (Pos('!Setti', sa) > 0) 228 | then 229 | begin 230 | SHGetFileInfo(LPCTSTR(pidAbsolute), 0, fileInfo, SizeOf(fileInfo), 231 | SHGFI_PIDL or SHGFI_DISPLAYNAME or SHGFI_ICON or SHGFI_SYSICONINDEX {or SHGFI_SHELLICONSIZE} or SHGFI_LARGEICON); 232 | 233 | // pc.GetUIObjectOf(0, ) 234 | // var c:uint32; 235 | // pc.GetAttributesOf(1,pidChild,c); 236 | CoTaskMemFree(pidAbsolute); 237 | 238 | // Get WSA (wsaclient.exe) info 239 | if Pos('!Sett', sa) > 0 then 240 | begin 241 | FDisplayName := fileInfo.szDisplayName; 242 | FAppUserModelId := sa; 243 | end 244 | // and APK installed ones info 245 | else if LowerCase(lnk).Contains('wsaclient.exe') then//if IsWsaClientLnkTarget(sa) then 246 | begin 247 | Item := TStrings.Create; 248 | try 249 | vAPK.DisplayName := fileInfo.szDisplayName; 250 | vAPK.AndroidPackageName := sa; 251 | FInstalledApps.Add(vAPK); 252 | finally 253 | Item.Free; 254 | end; 255 | end; 256 | 257 | var icon := TIcon.Create; 258 | try 259 | icon.Handle := fileInfo.hIcon; 260 | 261 | finally 262 | icon.Free; 263 | end; 264 | end; 265 | 266 | 267 | end; 268 | 269 | end; 270 | end; 271 | end; 272 | end; 273 | end; 274 | end; 275 | end; 276 | end; 277 | 278 | CoUninitialize; 279 | end; 280 | 281 | { TAPKList } 282 | 283 | function TAPKList.Add(Value: PAPK): Integer; 284 | begin 285 | Result := inherited Add(Value); 286 | end; 287 | 288 | destructor TAPKList.Destroy; 289 | var 290 | I: Integer; 291 | begin 292 | for I := 0 to Count - 1 do 293 | begin 294 | // let's first release strings 295 | SetLength(Items[I].AndroidPackageName, 0); 296 | SetLength(Items[I].AndroidVersionCode, 0); 297 | SetLength(Items[I].DisplayIcon, 0); 298 | SetLength(Items[I].DisplayName, 0); 299 | SetLength(Items[I].DisplayVersion, 0); 300 | SetLength(Items[I].InstallDate, 0); 301 | SetLength(Items[I].ModifyPath, 0); 302 | SetLength(Items[I].Publisher, 0); 303 | SetLength(Items[I].QuietUninstallString, 0); 304 | SetLength(Items[I].UninstalString, 0); 305 | // since we use GetMem(PAPK, SizeOf(TAPK)); we release it here 306 | FreeMem(Items[I]); 307 | end; 308 | inherited; 309 | end; 310 | 311 | function TAPKList.Get(Index: Integer): PAPK; 312 | begin 313 | Result := PAPK(inherited Get(Index)); 314 | end; 315 | 316 | end. 317 | -------------------------------------------------------------------------------- /frmApkInstaller.dfm: -------------------------------------------------------------------------------- 1 | object frmInstaller: TfrmInstaller 2 | Left = 0 3 | Top = 0 4 | Caption = 'APK Installer' 5 | ClientHeight = 445 6 | ClientWidth = 636 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clHighlight 10 | Font.Height = -11 11 | Font.Name = 'Segoe UI Variable Display' 12 | Font.Style = [] 13 | Font.Quality = fqClearTypeNatural 14 | FormStyle = fsStayOnTop 15 | OldCreateOrder = False 16 | Position = poOwnerFormCenter 17 | StyleElements = [seFont, seClient] 18 | StyleName = 'Windows' 19 | OnClick = FormClick 20 | OnClose = FormClose 21 | OnCreate = FormCreate 22 | OnDestroy = FormDestroy 23 | DesignSize = ( 24 | 636 25 | 445) 26 | PixelsPerInch = 96 27 | TextHeight = 15 28 | object lbAPKDisplayName: TLabel 29 | Left = 24 30 | Top = 44 31 | Width = 481 32 | Height = 72 33 | Anchors = [akLeft, akTop, akRight] 34 | AutoSize = False 35 | Caption = 'APK Display Name' 36 | Font.Charset = ANSI_CHARSET 37 | Font.Color = clWindowText 38 | Font.Height = -27 39 | Font.Name = 'Segoe UI Variable Display Semib' 40 | Font.Style = [fsBold] 41 | Font.Quality = fqClearTypeNatural 42 | ParentFont = False 43 | end 44 | object lbPublisher: TLabel 45 | Left = 24 46 | Top = 144 47 | Width = 56 48 | Height = 17 49 | Caption = 'Publisher:' 50 | Font.Charset = DEFAULT_CHARSET 51 | Font.Color = clWindowText 52 | Font.Height = -13 53 | Font.Name = 'Segoe UI Variable Display' 54 | Font.Style = [] 55 | Font.Quality = fqClearTypeNatural 56 | ParentFont = False 57 | end 58 | object lbVersion: TLabel 59 | Left = 24 60 | Top = 166 61 | Width = 46 62 | Height = 17 63 | Caption = 'Version:' 64 | Font.Charset = DEFAULT_CHARSET 65 | Font.Color = clWindowText 66 | Font.Height = -13 67 | Font.Name = 'Segoe UI Variable Display' 68 | Font.Style = [] 69 | Font.Quality = fqClearTypeNatural 70 | ParentFont = False 71 | end 72 | object lbCertificate: TLabel 73 | Left = 24 74 | Top = 122 75 | Width = 40 76 | Height = 17 77 | Caption = 'Signer:' 78 | Font.Charset = DEFAULT_CHARSET 79 | Font.Color = clHighlight 80 | Font.Height = -13 81 | Font.Name = 'Segoe UI Variable Display' 82 | Font.Style = [] 83 | Font.Quality = fqClearTypeNatural 84 | ParentFont = False 85 | OnClick = lbCertificateClick 86 | end 87 | object lbCapabilities: TLabel 88 | Left = 24 89 | Top = 204 90 | Width = 67 91 | Height = 17 92 | Caption = 'Capabilities' 93 | Font.Charset = DEFAULT_CHARSET 94 | Font.Color = clWindowText 95 | Font.Height = -13 96 | Font.Name = 'Segoe UI Variable Display' 97 | Font.Style = [] 98 | Font.Quality = fqClearTypeNatural 99 | ParentFont = False 100 | end 101 | object eApkImage: TEsImage 102 | Left = 520 103 | Top = 49 104 | Width = 90 105 | Height = 90 106 | Anchors = [akTop, akRight] 107 | Stretch = Fill 108 | end 109 | object btnLaunch: TButton 110 | Left = 497 111 | Top = 360 112 | Width = 113 113 | Height = 30 114 | Anchors = [akRight, akBottom] 115 | Caption = 'Launch' 116 | Font.Charset = DEFAULT_CHARSET 117 | Font.Color = clWindowText 118 | Font.Height = -13 119 | Font.Name = 'Segoe UI Variable Display' 120 | Font.Style = [] 121 | Font.Quality = fqClearTypeNatural 122 | ParentFont = False 123 | TabOrder = 1 124 | end 125 | object apkInstallerMemo: TMemo 126 | Left = 24 127 | Top = 226 128 | Width = 409 129 | Height = 143 130 | BevelInner = bvNone 131 | BevelOuter = bvNone 132 | BorderStyle = bsNone 133 | Ctl3D = True 134 | Font.Charset = DEFAULT_CHARSET 135 | Font.Color = clGray 136 | Font.Height = -13 137 | Font.Name = 'Segoe UI Variable Display' 138 | Font.Style = [] 139 | Font.Quality = fqClearTypeNatural 140 | Lines.Strings = ( 141 | 'Memo1') 142 | ParentColor = True 143 | ParentCtl3D = False 144 | ParentFont = False 145 | ReadOnly = True 146 | TabOrder = 2 147 | WordWrap = False 148 | end 149 | object pnlAbout: TPanel 150 | Left = 8 151 | Top = 248 152 | Width = 273 153 | Height = 153 154 | Anchors = [akLeft, akBottom] 155 | BevelOuter = bvNone 156 | TabOrder = 3 157 | Visible = False 158 | object lbAbout: TLabel 159 | Left = 16 160 | Top = 16 161 | Width = 43 162 | Height = 21 163 | Caption = 'About' 164 | Font.Charset = DEFAULT_CHARSET 165 | Font.Color = clWindowText 166 | Font.Height = -16 167 | Font.Name = 'Segoe UI Variable Display' 168 | Font.Style = [] 169 | Font.Quality = fqClearTypeNatural 170 | ParentFont = False 171 | end 172 | object lbInsVersion: TLabel 173 | Left = 16 174 | Top = 39 175 | Width = 130 176 | Height = 17 177 | Caption = 'APK Installer 1.0.211028' 178 | Font.Charset = DEFAULT_CHARSET 179 | Font.Color = clWindowText 180 | Font.Height = -13 181 | Font.Name = 'Segoe UI Variable Display' 182 | Font.Style = [] 183 | Font.Quality = fqClearTypeNatural 184 | ParentFont = False 185 | end 186 | object Label1: TLabel 187 | Left = 16 188 | Top = 62 189 | Width = 217 190 | Height = 17 191 | Caption = #169' 2021 Codigobit. All rights reserved.' 192 | Font.Charset = DEFAULT_CHARSET 193 | Font.Color = clWindowText 194 | Font.Height = -13 195 | Font.Name = 'Segoe UI Variable Display' 196 | Font.Style = [] 197 | Font.Quality = fqClearTypeNatural 198 | ParentFont = False 199 | end 200 | object Shape1: TShape 201 | Left = 0 202 | Top = 0 203 | Width = 273 204 | Height = 153 205 | Align = alClient 206 | Pen.Color = clMedGray 207 | Pen.Mode = pmMask 208 | Shape = stRoundRect 209 | ExplicitLeft = 208 210 | ExplicitTop = 88 211 | ExplicitWidth = 65 212 | ExplicitHeight = 65 213 | end 214 | object lnkWebSite: TLinkLabel 215 | Left = 20 216 | Top = 85 217 | Width = 64 218 | Height = 21 219 | Cursor = crHandPoint 220 | Caption = 'Codigobit' 221 | Font.Charset = DEFAULT_CHARSET 222 | Font.Color = clHighlight 223 | Font.Height = -13 224 | Font.Name = 'Segoe UI Variable Display' 225 | Font.Style = [] 226 | Font.Quality = fqClearTypeNatural 227 | ParentFont = False 228 | TabOrder = 0 229 | OnLinkClick = lnkWebSiteLinkClick 230 | end 231 | object lnkRepository: TLinkLabel 232 | Left = 20 233 | Top = 112 234 | Width = 113 235 | Height = 21 236 | Cursor = crHandPoint 237 | Caption = 238 | 'GitHub Repository' 240 | Font.Charset = DEFAULT_CHARSET 241 | Font.Color = clHighlight 242 | Font.Height = -13 243 | Font.Name = 'Segoe UI Variable Display' 244 | Font.Style = [] 245 | Font.Quality = fqClearTypeNatural 246 | ParentFont = False 247 | TabOrder = 1 248 | OnLinkClick = lnkRepositoryLinkClick 249 | end 250 | end 251 | object pnlCaption: TPanel 252 | Left = 0 253 | Top = 0 254 | Width = 636 255 | Height = 30 256 | Align = alTop 257 | BevelOuter = bvNone 258 | ShowCaption = False 259 | TabOrder = 4 260 | OnMouseDown = pnlCaptionMouseDown 261 | object UWPQuickButton3: TUWPQuickButton 262 | Left = 546 263 | Top = 0 264 | Height = 30 265 | CustomBackColor.Enabled = False 266 | CustomBackColor.Color = clBlack 267 | CustomBackColor.LightColor = 13619151 268 | CustomBackColor.DarkColor = 3947580 269 | ButtonStyle = qbsMax 270 | Caption = #57347 271 | Align = alRight 272 | Font.Charset = DEFAULT_CHARSET 273 | Font.Color = clWindowText 274 | Font.Height = -13 275 | Font.Name = 'Segoe MDL2 Assets' 276 | Font.Style = [] 277 | ParentFont = False 278 | ExplicitLeft = 296 279 | ExplicitHeight = 32 280 | end 281 | object UWPQuickButton2: TUWPQuickButton 282 | Left = 501 283 | Top = 0 284 | Height = 30 285 | CustomBackColor.Enabled = False 286 | CustomBackColor.Color = clBlack 287 | CustomBackColor.LightColor = 13619151 288 | CustomBackColor.DarkColor = 3947580 289 | ButtonStyle = qbsMin 290 | Caption = #57608 291 | Align = alRight 292 | Color = clBtnFace 293 | Font.Charset = DEFAULT_CHARSET 294 | Font.Color = clWindowText 295 | Font.Height = -13 296 | Font.Name = 'Segoe MDL2 Assets' 297 | Font.Style = [] 298 | ParentColor = False 299 | ParentFont = False 300 | ExplicitLeft = 296 301 | ExplicitHeight = 32 302 | end 303 | object UWPQuickButton1: TUWPQuickButton 304 | Left = 591 305 | Top = 0 306 | Height = 30 307 | CustomBackColor.Enabled = False 308 | CustomBackColor.Color = clBlack 309 | CustomBackColor.LightColor = 13619151 310 | CustomBackColor.DarkColor = 3947580 311 | ButtonStyle = qbsQuit 312 | Caption = #57610 313 | Align = alRight 314 | Font.Charset = DEFAULT_CHARSET 315 | Font.Color = clWindowText 316 | Font.Height = -13 317 | Font.Name = 'Segoe MDL2 Assets' 318 | Font.Style = [] 319 | ParentFont = False 320 | ExplicitLeft = 296 321 | ExplicitHeight = 32 322 | end 323 | end 324 | object ActivityIndicator1: TActivityIndicator 325 | Left = 304 326 | Top = 168 327 | Anchors = [akLeft, akTop, akRight, akBottom] 328 | end 329 | object Button1: TButton 330 | Left = 8 331 | Top = 407 332 | Width = 33 333 | Height = 30 334 | Anchors = [akLeft, akBottom] 335 | Caption = '?' 336 | Font.Charset = DEFAULT_CHARSET 337 | Font.Color = clWindowText 338 | Font.Height = -13 339 | Font.Name = 'Segoe UI Variable Display' 340 | Font.Style = [] 341 | Font.Quality = fqClearTypeNatural 342 | ParentFont = False 343 | TabOrder = 6 344 | OnClick = Button1Click 345 | end 346 | object btnReUnInstall: TButton 347 | Left = 378 348 | Top = 360 349 | Width = 113 350 | Height = 29 351 | Anchors = [akRight, akBottom] 352 | Caption = 'Install' 353 | ElevationRequired = True 354 | Font.Charset = DEFAULT_CHARSET 355 | Font.Color = clWindowText 356 | Font.Height = -13 357 | Font.Name = 'Segoe UI Variable Display' 358 | Font.Style = [] 359 | Font.Quality = fqClearTypeNatural 360 | ParentFont = False 361 | TabOrder = 0 362 | end 363 | object btnLog: TButton 364 | Left = 47 365 | Top = 407 366 | Width = 33 367 | Height = 30 368 | Anchors = [akLeft, akBottom] 369 | Caption = 'Log' 370 | TabOrder = 8 371 | OnClick = btnLogClick 372 | end 373 | object SynEdit1: TSynEdit 374 | Left = 8 375 | Top = 248 376 | Width = 620 377 | Height = 153 378 | Anchors = [akLeft, akTop, akRight, akBottom] 379 | Font.Charset = DEFAULT_CHARSET 380 | Font.Color = clWindowText 381 | Font.Height = -13 382 | Font.Name = 'Consolas' 383 | Font.Style = [] 384 | Font.Quality = fqClearTypeNatural 385 | TabOrder = 7 386 | Visible = False 387 | UseCodeFolding = False 388 | Gutter.Font.Charset = DEFAULT_CHARSET 389 | Gutter.Font.Color = clWindowText 390 | Gutter.Font.Height = -11 391 | Gutter.Font.Name = 'Consolas' 392 | Gutter.Font.Style = [] 393 | Gutter.RightMargin = 8 394 | Gutter.ShowLineNumbers = True 395 | Highlighter = SynUNIXShellScriptSyn1 396 | end 397 | object DCAapt: TDosCommand 398 | InputToOutput = False 399 | MaxTimeAfterBeginning = 0 400 | MaxTimeAfterLastOutput = 0 401 | OnExecuteError = DCAaptExecuteError 402 | OnNewLine = DCAaptNewLine 403 | OnTerminated = DCAaptTerminated 404 | OnTerminateProcess = DCAaptTerminateProcess 405 | Left = 440 406 | Top = 56 407 | end 408 | object SynUNIXShellScriptSyn1: TSynUNIXShellScriptSyn 409 | Options.AutoDetectEnabled = False 410 | Options.AutoDetectLineLimit = 0 411 | Options.Visible = False 412 | Left = 272 413 | Top = 152 414 | end 415 | object DCPKCS7: TDosCommand 416 | InputToOutput = False 417 | MaxTimeAfterBeginning = 0 418 | MaxTimeAfterLastOutput = 0 419 | Left = 368 420 | Top = 48 421 | end 422 | end 423 | -------------------------------------------------------------------------------- /frmApkInstaller.pas: -------------------------------------------------------------------------------- 1 | unit frmApkInstaller; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, 8 | Vcl.TitleBarCtrls, UWP.Form, UWP.QuickButton, UWP.Caption, UWP.Button, 9 | Vcl.WinXCtrls, DosCommand, SynEditHighlighter, SynHighlighterUNIXShellScript, 10 | SynEdit, ES.BaseControls, ES.Images, 11 | JclCompression, JclStrings; 12 | 13 | type 14 | 15 | TApkDetails = record 16 | DisplayName: string; 17 | PackageName: string; 18 | DisplayVersion: string; 19 | Icon: string; 20 | end; 21 | 22 | TPanel = class(Vcl.ExtCtrls.TPanel) 23 | private 24 | const 25 | DEFAULT_BORDER_COLOR = clActiveBorder;//$0033CCFF; 26 | DEFAULT_CLIENT_COLOR = clWindow; 27 | DEFAULT_BORDER_RADIUS = 16; 28 | private 29 | { Private Declarations } 30 | FBorderColor: TColor; 31 | FClientColor: TColor; 32 | FBorderRadius: Integer; 33 | FRounded: Boolean; 34 | procedure SetStyle(const Value: Boolean); 35 | protected 36 | procedure Paint; override; 37 | public 38 | constructor Create(AOwner: TComponent); override; 39 | property Rounded: Boolean read FRounded write SetStyle default False; 40 | end; 41 | 42 | 43 | TfrmInstaller = class(TUWPForm) 44 | btnReUnInstall: TButton; 45 | btnLaunch: TButton; 46 | lbAPKDisplayName: TLabel; 47 | lbPublisher: TLabel; 48 | lbVersion: TLabel; 49 | lbCertificate: TLabel; 50 | lbCapabilities: TLabel; 51 | apkInstallerMemo: TMemo; 52 | UWPQuickButton1: TUWPQuickButton; 53 | UWPQuickButton2: TUWPQuickButton; 54 | UWPQuickButton3: TUWPQuickButton; 55 | pnlAbout: TPanel; 56 | pnlCaption: TPanel; 57 | ActivityIndicator1: TActivityIndicator; 58 | lbAbout: TLabel; 59 | lbInsVersion: TLabel; 60 | Label1: TLabel; 61 | lnkWebSite: TLinkLabel; 62 | lnkRepository: TLinkLabel; 63 | Button1: TButton; 64 | Shape1: TShape; 65 | DCAapt: TDosCommand; 66 | SynEdit1: TSynEdit; 67 | SynUNIXShellScriptSyn1: TSynUNIXShellScriptSyn; 68 | eApkImage: TEsImage; 69 | btnLog: TButton; 70 | DCPKCS7: TDosCommand; 71 | procedure pnlCaptionMouseDown(Sender: TObject; Button: TMouseButton; 72 | Shift: TShiftState; X, Y: Integer); 73 | procedure FormCreate(Sender: TObject); 74 | procedure UWPButton2Click(Sender: TObject); 75 | procedure FormClick(Sender: TObject); 76 | procedure Button1Click(Sender: TObject); 77 | procedure lnkWebSiteLinkClick(Sender: TObject; const Link: string; 78 | LinkType: TSysLinkType); 79 | procedure lnkRepositoryLinkClick(Sender: TObject; const Link: string; 80 | LinkType: TSysLinkType); 81 | procedure DCAaptExecuteError(ASender: TObject; AE: Exception; 82 | var AHandled: Boolean); 83 | procedure DCAaptNewLine(ASender: TObject; const ANewLine: string; 84 | AOutputType: TOutputType); 85 | procedure DCAaptTerminateProcess(ASender: TObject; 86 | var ACanTerminate: Boolean); 87 | procedure btnLogClick(Sender: TObject); 88 | procedure FormDestroy(Sender: TObject); 89 | procedure DCAaptTerminated(Sender: TObject); 90 | procedure lbCertificateClick(Sender: TObject); 91 | procedure FormClose(Sender: TObject; var Action: TCloseAction); 92 | private 93 | { Private declarations } 94 | FArchive: TJclDecompressArchive; 95 | FZipContents: TStringList; 96 | public 97 | { Public declarations } 98 | FApkFile: string; 99 | FApkInfo: TApkDetails; 100 | FApkPermissions: TStringList; 101 | procedure GetAPKInfoWithAndroidAssetPackagingTool; 102 | procedure GetXAPKInfo; 103 | end; 104 | 105 | var 106 | frmInstaller: TfrmInstaller; 107 | 108 | implementation 109 | 110 | uses 111 | Winapi.ShellAPI, WSAManager, UWP.ColorManager, RegularExpressions, 112 | System.JSON, Rest.Json, System.Zip; 113 | 114 | {$R *.dfm} 115 | 116 | procedure TfrmInstaller.btnLogClick(Sender: TObject); 117 | begin 118 | SynEdit1.Visible := not SynEdit1.Visible; 119 | end; 120 | 121 | procedure TfrmInstaller.Button1Click(Sender: TObject); 122 | begin 123 | pnlAbout.Visible := not pnlAbout.Visible; 124 | end; 125 | 126 | procedure TfrmInstaller.DCAaptExecuteError(ASender: TObject; AE: Exception; 127 | var AHandled: Boolean); 128 | begin 129 | if AHandled then 130 | ShowMessage(AE.ToString); 131 | 132 | end; 133 | 134 | procedure TfrmInstaller.DCAaptNewLine(ASender: TObject; 135 | const ANewLine: string; AOutputType: TOutputType); 136 | begin 137 | AOutputType := otEntireLine; 138 | 139 | if SynEdit1.Lines.Count > 1000 then 140 | SynEdit1.Lines.Clear; 141 | 142 | SynEdit1.Lines.Add(ANewLine); 143 | SynEdit1.GotoLineAndCenter(SynEdit1.Lines.Count); 144 | 145 | if FApkInfo.PackageName = '' then 146 | if Pos('package: ', ANewLine) = 1 then 147 | begin 148 | FApkInfo.PackageName := TRegEx.Match(ANewLine, '(?<=name='')[^'']*').Value; 149 | FApkInfo.DisplayVersion := TRegEx.Match(ANewLine, '(?<=versionName='')[^'']*').Value; 150 | end; 151 | 152 | if FApkInfo.DisplayName = '' then 153 | if Pos('launchable-activity: ', ANewLine) = 1 then 154 | begin 155 | FApkInfo.DisplayName := TRegEx.Match(ANewLine, '(?<=label='')[^'']*').Value; 156 | // FApkInfo.Icon := TRegEx.Match(ANewLine, '(?<=icon='')[^'']*').Value; 157 | end 158 | else if Pos('application-label', ANewLine) = 1 then 159 | FApkInfo.DisplayName := TRegEx.Match(ANewLine, '(?<=:'')[^'']*').Value; 160 | 161 | if Pos('uses-permission: ', ANewLine) = 1 then 162 | FApkPermissions.Add(TRegEx.Match(ANewLine, '(?<=name='')[^'']*').Value); 163 | 164 | if FApkInfo.Icon = '' then 165 | if Pos('application-icon-', ANewLine) = 1 then 166 | FApkInfo.Icon := TRegEx.Match(ANewLine, '(?<=:'')[^'']*').Value; 167 | end; 168 | 169 | procedure TfrmInstaller.DCAaptTerminated(Sender: TObject); 170 | var 171 | zip: TZipFile; 172 | I: Integer; 173 | zipHeader: TZipHeader; 174 | picBuff: TStream; 175 | vArchive: TJclDecompressArchive; 176 | ArchiveClass: TJclDecompressArchiveClass; 177 | begin 178 | lbAPKDisplayName.Caption := FApkInfo.DisplayName; 179 | lbCapabilities.Caption := 'Capabilities'; 180 | lbVersion.Caption := 'Version: ' + FApkInfo.DisplayVersion; 181 | // lbPublisher.Caption := 'Icon: ' + FApkInfo.Icon; 182 | apkInstallerMemo.Lines := FApkPermissions; 183 | 184 | // just a dummy ficticious path to use extractfilename, extractfileext, etc. 185 | // since zip files path starts with no c:\ neither backslashes 186 | var dummypath := LowerCase(StringReplace('c:/'+fapkinfo.icon, '/', '\', [rfReplaceAll])); 187 | 188 | if ExtractFileExt(dummypath) = '.png' then 189 | // open it and show 190 | begin 191 | zip := TZipFile.Create; 192 | try 193 | if TZipFile.IsValid(FApkFile) then 194 | begin 195 | zip.Open(FApkFile, zmRead); 196 | 197 | //load icon 198 | picBuff := TStream.Create; 199 | try 200 | zip.Read(FApkInfo.Icon, picBuff, zipHeader); 201 | eApkImage.Picture.LoadFromStream(picBuff); 202 | finally 203 | picBuff.Free; 204 | end; 205 | end; 206 | finally 207 | zip.Free; 208 | end; 209 | end 210 | else // Open .APK file as ZipFile, list contents and try to find an icon that match some brute force search 211 | if (FApkInfo.Icon <> '') and (FZipContents.Count = 0) then 212 | begin 213 | zip := TZipFile.Create; 214 | try 215 | if TZipFile.IsValid(FApkFile) then 216 | begin 217 | zip.Open(FApkFile, zmRead); 218 | var pngName := ExtractFileName(ChangeFileExt(dummypath, '.png')); 219 | for var filename in zip.FileNames do 220 | begin 221 | if filename.Contains(pngName) then 222 | begin 223 | //load icon 224 | picBuff := TStream.Create; 225 | try 226 | zip.Read(filename, picBuff, zipHeader); 227 | eApkImage.Picture.LoadFromStream(picBuff); 228 | finally 229 | picBuff.Free; 230 | end; 231 | end; 232 | end; 233 | 234 | end; 235 | finally 236 | zip.Free; 237 | end;// replaced with 7zip, since TZipFile is too slow 238 | { vArchive := TJclZipDecompressArchive.Create(FApkFile, 0, False); 239 | try 240 | // if e.g. icon_launcher.xml most likely we would like to find icon_launcher.png instead 241 | var pngName := ExtractFileName(ChangeFileExt(dummypath, '.png')); 242 | vArchive.ListFiles; 243 | for I := 0 to vArchive.ItemCount - 1 do 244 | begin 245 | if not vArchive.Items[I].Directory then 246 | begin 247 | picBuff := TMemoryStream.Create; 248 | try 249 | if string(vArchive.Items[I].PackedName).Contains(pngName) then 250 | begin 251 | vArchive.Items[I].Stream := picBuff; 252 | vArchive.Items[I].OwnsStream := False; 253 | vArchive.Items[I].Selected := True; 254 | vArchive.ExtractSelected(); 255 | vArchive.Items[I].Selected := False; 256 | picBuff.Position := 0; 257 | eApkImage.Picture.LoadFromStream(picBuff); 258 | //Break; // that's it. TODO : search other ones, extract them and pick the highest quality one 259 | end; 260 | finally 261 | picBuff.Free; 262 | end; 263 | end; 264 | end; 265 | finally 266 | FreeAndNil(vArchive); 267 | end;} 268 | end; 269 | end; 270 | 271 | procedure TfrmInstaller.DCAaptTerminateProcess(ASender: TObject; 272 | var ACanTerminate: Boolean); 273 | begin 274 | ACanTerminate := True; 275 | end; 276 | 277 | procedure TfrmInstaller.FormClick(Sender: TObject); 278 | begin 279 | pnlAbout.Visible := False; 280 | end; 281 | 282 | procedure TfrmInstaller.FormClose(Sender: TObject; var Action: TCloseAction); 283 | begin 284 | // clear labels and picture on close 285 | lbAPKDisplayName.Caption := ''; 286 | lbPublisher.Caption := 'Publisher: '; 287 | lbVersion.Caption := 'Version: '; 288 | lbCertificate.Caption := ''; 289 | apkInstallerMemo.Lines.Clear; 290 | eApkImage.Picture := nil; 291 | end; 292 | 293 | procedure TfrmInstaller.FormCreate(Sender: TObject); 294 | begin 295 | FApkPermissions := TStringList.Create; 296 | FZipContents := TStringList.Create; 297 | // pnlCaption.Height := GetSystemMetrics(SM_CYCAPTION) + GetSystemMetrics(SM_CXBORDER); 298 | // pnlAbout.Rounded := True; 299 | ColorizationManager.ColorizationType := TUWPColorizationType.ctLight; 300 | end; 301 | 302 | procedure TfrmInstaller.FormDestroy(Sender: TObject); 303 | begin 304 | DCAapt.Stop; 305 | FZipContents.Free; 306 | FApkPermissions.Free; 307 | end; 308 | 309 | procedure TfrmInstaller.GetAPKInfoWithAndroidAssetPackagingTool; 310 | var 311 | cmdline: string; 312 | begin 313 | eApkImage.Picture := nil; 314 | if FileExists(ExtractFilePath(ParamStr(0))+ 'aapt.exe') then 315 | begin 316 | cmdline := 'aapt.exe d badging "' + FApkFile + '"'; 317 | if DCAapt.IsRunning then 318 | DCAapt.Stop; 319 | 320 | FZipContents.Clear; 321 | DCAapt.InputToOutput := False; 322 | DCAapt.CommandLine := cmdline; 323 | DCAapt.Execute; 324 | end; 325 | end; 326 | 327 | procedure TfrmInstaller.GetXAPKInfo; 328 | var 329 | json: TJSONObject; 330 | zip: TZipFile; 331 | I: Integer; 332 | zipHeader: TZipHeader; 333 | buff: TBytes; 334 | picBuff: TStream; 335 | begin 336 | eApkImage.Picture := nil; 337 | //extract manifest.json from *.xapk to read its info 338 | 339 | zip := TZipFile.Create; 340 | json := TJsonObject.Create; 341 | try 342 | if TZipFile.IsValid(FApkFile) then 343 | begin 344 | try 345 | zip.Open(FApkFile, zmRead); 346 | 347 | zip.Read('manifest.json', buff); 348 | if json.Parse(buff, 0) > 0 then 349 | begin 350 | //let's find its details from json 351 | SynEdit1.Text := json.ToString;//TEncoding.UTF8.GetString(buff); 352 | 353 | lbAPKDisplayName.Caption := json.Values['name'].Value; 354 | lbVersion.Caption := json.Values['version_name'].Value; 355 | // 356 | var icon := json.Values['icon'].Value; 357 | apkInstallerMemo.Text := json.Values['permissions'].ToString; 358 | //load icon 359 | picBuff := TStream.Create; 360 | try 361 | zip.Read(icon, picBuff, zipHeader); 362 | eApkImage.Picture.LoadFromStream(picBuff); 363 | finally 364 | picBuff.Free; 365 | end; 366 | end; 367 | finally 368 | zip.Close; 369 | end; 370 | end; 371 | 372 | 373 | finally 374 | json.Free; 375 | zip.Free; 376 | end; 377 | end; 378 | 379 | procedure TfrmInstaller.lbCertificateClick(Sender: TObject); 380 | begin 381 | // DCPKCS7.CommandLine := 'openssl pkcs7 -in '+GetRSAFile()+' -inform DER -print_certs | openssl x509 -text -noout' 382 | end; 383 | 384 | procedure TfrmInstaller.lnkRepositoryLinkClick(Sender: TObject; 385 | const Link: string; LinkType: TSysLinkType); 386 | begin 387 | ShellExecute(0, 'OPEN', PChar(Link), nil, nil, SW_SHOWNORMAL); 388 | end; 389 | 390 | procedure TfrmInstaller.lnkWebSiteLinkClick(Sender: TObject; const Link: string; 391 | LinkType: TSysLinkType); 392 | begin 393 | ShellExecute(0, 'OPEN', PChar(Link), nil, nil, SW_SHOWNORMAL); 394 | end; 395 | 396 | procedure TfrmInstaller.pnlCaptionMouseDown(Sender: TObject; Button: TMouseButton; 397 | Shift: TShiftState; X, Y: Integer); 398 | begin 399 | ReleaseCapture; 400 | Perform(WM_SYSCOMMAND, $F012, 0); 401 | end; 402 | 403 | procedure TfrmInstaller.UWPButton2Click(Sender: TObject); 404 | begin 405 | 406 | end; 407 | 408 | { TPanel } 409 | 410 | constructor TPanel.Create(AOwner: TComponent); 411 | begin 412 | inherited; 413 | FBorderColor := DEFAULT_BORDER_COLOR; 414 | FClientColor := DEFAULT_CLIENT_COLOR; 415 | FBorderRadius := DEFAULT_BORDER_RADIUS; 416 | end; 417 | 418 | procedure TPanel.Paint; 419 | var 420 | r: TRect; 421 | begin 422 | inherited; 423 | if Rounded then 424 | begin 425 | //BevelOuter := bvNone; 426 | Canvas.Pen.Color := FBorderColor; 427 | Canvas.Brush.Color := FBorderColor; 428 | Canvas.Brush.Style := bsSolid; 429 | Canvas.FillRect(Rect(FBorderRadius, 430 | 0, ClientWidth - FBorderRadius, FBorderRadius)); 431 | Canvas.Ellipse(Rect(0, 0, 2 * FBorderRadius, 2 * FBorderRadius)); 432 | Canvas.Ellipse(Rect(ClientWidth - 2 * FBorderRadius, 0, 433 | ClientWidth, 2 * FBorderRadius)); 434 | // Canvas.Brush.Color := FClientColor; 435 | //// Canvas.Rectangle(Rect(0, FBorderRadius, ClientWidth, ClientHeight)); 436 | // Canvas.Font.Assign(Self.Font); 437 | // r := Rect(FBorderRadius, 0, ClientWidth - FBorderRadius, FBorderRadius); 438 | // Canvas.Brush.Style := bsClear; 439 | end; 440 | end; 441 | 442 | procedure TPanel.SetStyle(const Value: Boolean); 443 | begin 444 | FRounded := Value; 445 | end; 446 | 447 | end. 448 | -------------------------------------------------------------------------------- /helperFuncs.pas: -------------------------------------------------------------------------------- 1 | unit helperFuncs; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, Winapi.ShlObj; 7 | 8 | function ExtractDomain(AUrl : string) : string; 9 | function FormatFileSize(AValue: Int64): string; 10 | procedure EnableBlurBehindWindow(const AHandle: THandle); 11 | 12 | // Exe Signature details as well its version, sadly official ADB doesn't contain either of them 13 | function IsExeCodeSigned(const FileName: string): Boolean; 14 | function IsExeCompanySigningCertificate(const FileName, CompanyName: string): Boolean; 15 | function GetExeCertCompanyName(const FileName: string): string; 16 | function FileVersionGet( const sgFileName : string ) : string; 17 | 18 | function IsImmersivePidl(pidl: PItemIdList): Boolean; 19 | 20 | function IsValidAppPackageName(value: string): Boolean; 21 | 22 | implementation 23 | 24 | uses 25 | Winapi.DwmApi, Winapi.Windows, Winapi.KnownFolders; 26 | 27 | const 28 | ACCENT_DISABLED = 0; 29 | ACCENT_ENABLE_GRADIENT = 1; 30 | ACCENT_ENABLE_TRANSPARENTGRADIENT = 2; 31 | ACCENT_ENABLE_BLURBEHIND = 3; 32 | // ACCENT_INVALID_STATE = 4 33 | 34 | WCA_CLIENTRENDERING_POLICY = 16; 35 | WCA_ACCENT_POLICY = 19; 36 | 37 | type 38 | TAccentPolicy = packed record 39 | AccentState: Integer; 40 | AccentFlags: Integer; 41 | GradientColor: Integer; 42 | AnimationId: Integer; 43 | end; 44 | 45 | TWindowCompositionAttributeData = packed record 46 | Attribute: THandle; 47 | Data: Pointer; 48 | Size: DWORD; 49 | end; 50 | 51 | // IsCodeSigned, which verifies that the exe hasn't been modified, uses 52 | // WinVerifyTrust, so it's NT only. IsCompanySigningCertificate works on Win9x, 53 | // but it only checks that the signing certificate hasn't been replaced, which 54 | // keeps someone from re-signing a modified executable. 55 | 56 | // Imagehlp.dll 57 | const 58 | CERT_SECTION_TYPE_ANY = $FF; // Any Certificate type 59 | 60 | function ImageEnumerateCertificates(FileHandle: THandle; TypeFilter: WORD; 61 | out CertificateCount: DWORD; Indicies: PDWORD; IndexCount: Integer): BOOL; stdcall; external 'Imagehlp.dll'; 62 | function ImageGetCertificateHeader(FileHandle: THandle; CertificateIndex: Integer; 63 | var CertificateHeader: TWinCertificate): BOOL; stdcall; external 'Imagehlp.dll'; 64 | function ImageGetCertificateData(FileHandle: THandle; CertificateIndex: Integer; 65 | Certificate: PWinCertificate; var RequiredLength: DWORD): BOOL; stdcall; external 'Imagehlp.dll'; 66 | 67 | // Crypt32.dll 68 | const 69 | CERT_NAME_SIMPLE_DISPLAY_TYPE = 4; 70 | PKCS_7_ASN_ENCODING = $00010000; 71 | X509_ASN_ENCODING = $00000001; 72 | 73 | type 74 | PCCERT_CONTEXT = type Pointer; 75 | HCRYPTPROV_LEGACY = type Pointer; 76 | PFN_CRYPT_GET_SIGNER_CERTIFICATE = type Pointer; 77 | 78 | CRYPT_VERIFY_MESSAGE_PARA = record 79 | cbSize: DWORD; 80 | dwMsgAndCertEncodingType: DWORD; 81 | hCryptProv: HCRYPTPROV_LEGACY; 82 | pfnGetSignerCertificate: PFN_CRYPT_GET_SIGNER_CERTIFICATE; 83 | pvGetArg: Pointer; 84 | end; 85 | 86 | function CryptVerifyMessageSignature(const pVerifyPara: CRYPT_VERIFY_MESSAGE_PARA; 87 | dwSignerIndex: DWORD; pbSignedBlob: PByte; cbSignedBlob: DWORD; pbDecoded: PBYTE; 88 | pcbDecoded: PDWORD; ppSignerCert: PCCERT_CONTEXT): BOOL; stdcall; external 'Crypt32.dll'; 89 | function CertGetNameStringA(pCertContext: PCCERT_CONTEXT; dwType: DWORD; dwFlags: DWORD; pvTypePara: Pointer; 90 | pszNameString: PAnsiChar; cchNameString: DWORD): DWORD; stdcall; external 'Crypt32.dll'; 91 | function CertFreeCertificateContext(pCertContext: PCCERT_CONTEXT): BOOL; stdcall; external 'Crypt32.dll'; 92 | function CertCreateCertificateContext(dwCertEncodingType: DWORD; 93 | pbCertEncoded: PBYTE; cbCertEncoded: DWORD): PCCERT_CONTEXT; stdcall; external 'Crypt32.dll'; 94 | 95 | // WinTrust.dll 96 | const 97 | WINTRUST_ACTION_GENERIC_VERIFY_V2: TGUID = '{00AAC56B-CD44-11d0-8CC2-00C04FC295EE}'; 98 | WTD_CHOICE_FILE = 1; 99 | WTD_REVOKE_NONE = 0; 100 | WTD_UI_NONE = 2; 101 | 102 | type 103 | PWinTrustFileInfo = ^TWinTrustFileInfo; 104 | TWinTrustFileInfo = record 105 | cbStruct: DWORD; // = sizeof(WINTRUST_FILE_INFO) 106 | pcwszFilePath: PWideChar; // required, file name to be verified 107 | hFile: THandle; // optional, open handle to pcwszFilePath 108 | pgKnownSubject: PGUID; // optional: fill if the subject type is known 109 | end; 110 | 111 | PWinTrustData = ^TWinTrustData; 112 | TWinTrustData = record 113 | cbStruct: DWORD; 114 | pPolicyCallbackData: Pointer; 115 | pSIPClientData: Pointer; 116 | dwUIChoice: DWORD; 117 | fdwRevocationChecks: DWORD; 118 | dwUnionChoice: DWORD; 119 | pFile: PWinTrustFileInfo; 120 | dwStateAction: DWORD; 121 | hWVTStateData: THandle; 122 | pwszURLReference: PWideChar; 123 | dwProvFlags: DWORD; 124 | dwUIContext: DWORD; 125 | end; 126 | 127 | function WinVerifyTrust(hwnd: HWND; const ActionID: TGUID; ActionData: Pointer): Longint; stdcall; external wintrust; 128 | 129 | function SetWindowCompositionAttribute(hWnd: HWND; var data: TWindowCompositionAttributeData):integer; stdcall; 130 | external user32 name 'SetWindowCompositionAttribute'; 131 | 132 | function ExtractDomain(AUrl : string) : string; 133 | var 134 | p: Cardinal; 135 | begin 136 | Result := ''; 137 | 138 | if Trim(AUrl) = '' then exit; 139 | 140 | AUrl := Trim(AUrl)+'/'; 141 | p := Pos('://', AUrl); 142 | if p > 0 then 143 | Delete(AUrl, 1, p + Pred(length('://'))); 144 | p := Pos('/', AUrl); 145 | Result := Copy(AUrl, 1, Pred(p)); 146 | end; 147 | 148 | function FormatFileSize(AValue: Int64): string; 149 | const 150 | K = Int64(1024); 151 | M = K * K; 152 | G = K * M; 153 | T = K * G; 154 | begin 155 | if AValue < K then Result := Format ( '%d bytes', [AValue] ) 156 | else if AValue < M then Result := Format ( '%f KB', [AValue / K] ) 157 | else if AValue < G then Result := Format ( '%f MB', [AValue / M] ) 158 | else if AValue < T then Result := Format ( '%f GB', [AValue / G] ) 159 | else Result := Format ( '%f TB', [AValue / T] ); 160 | end; 161 | 162 | procedure EnableBlurBehindWindow(const AHandle: THandle); 163 | var 164 | accent: TAccentPolicy; 165 | data: TWindowCompositionAttributeData; 166 | flag: BOOL; 167 | begin 168 | ZeroMemory(@accent, SizeOf(TAccentPolicy)); 169 | ZeroMemory(@data, SizeOf(TWindowCompositionAttributeData)); 170 | accent.AccentState := ACCENT_ENABLE_BLURBEHIND; 171 | data.Attribute := WCA_ACCENT_POLICY; 172 | data.Size := SizeOf(TAccentPolicy); 173 | data.Data := @accent; 174 | SetWindowCompositionAttribute(AHandle, data); 175 | 176 | flag := True; 177 | data.Attribute := WCA_CLIENTRENDERING_POLICY; 178 | data.Size := SizeOf(flag); 179 | data.Data := @flag; 180 | SetWindowCompositionAttribute(AHandle, data); 181 | end; 182 | 183 | function IsExeCodeSigned(const FileName: string): Boolean; 184 | var 185 | file_info: TWinTrustFileInfo; 186 | trust_data: TWinTrustData; 187 | begin 188 | // Verify that the exe is signed and the checksum matches 189 | FillChar(file_info, SizeOf(file_info), 0); 190 | file_info.cbStruct := sizeof(file_info); 191 | file_info.pcwszFilePath := PWideChar(WideString(Filename)); 192 | FillChar(trust_data, SizeOf(trust_data), 0); 193 | trust_data.cbStruct := sizeof(trust_data); 194 | trust_data.dwUIChoice := WTD_UI_NONE; 195 | trust_data.fdwRevocationChecks := WTD_REVOKE_NONE; 196 | trust_data.dwUnionChoice := WTD_CHOICE_FILE; 197 | trust_data.pFile := @file_info; 198 | Result := WinVerifyTrust(INVALID_HANDLE_VALUE, WINTRUST_ACTION_GENERIC_VERIFY_V2, 199 | @trust_data) = ERROR_SUCCESS 200 | end; 201 | 202 | function IsExeCompanySigningCertificate(const FileName, CompanyName: string): Boolean; 203 | var 204 | hExe: HMODULE; 205 | Cert: PWinCertificate; 206 | CertContext: PCCERT_CONTEXT; 207 | CertCount: DWORD; 208 | CertName: AnsiString; 209 | CertNameLen: DWORD; 210 | VerifyParams: CRYPT_VERIFY_MESSAGE_PARA; 211 | begin 212 | // Returns TRUE if the SubjectName on the certificate used to sign the exe is 213 | // "Company Name". Should prevent a cracker from modifying the file and 214 | // re-signing it with their own certificate. 215 | // 216 | // Microsoft has an example that does this using CryptQueryObject and 217 | // CertFindCertificateInStore instead of CryptVerifyMessageSignature, but 218 | // CryptQueryObject is NT-only. Using CertCreateCertificateContext doesn't work 219 | // either, though I don't know why. 220 | Result := False; 221 | // Verify that the exe was signed by our private key 222 | hExe := CreateFile(PChar(Filename), GENERIC_READ, FILE_SHARE_READ, 223 | nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL or FILE_FLAG_RANDOM_ACCESS, 0); 224 | if hExe = INVALID_HANDLE_VALUE then 225 | Exit; 226 | try 227 | // There should only be one certificate associated with the exe 228 | if (not ImageEnumerateCertificates(hExe, CERT_SECTION_TYPE_ANY, CertCount, nil, 0)) or 229 | (CertCount <> 1) then 230 | Exit; 231 | // Read the certificate header so we can get the size needed for the full cert 232 | GetMem(Cert, SizeOf(TWinCertificate) + 3); // ImageGetCertificateHeader writes an DWORD at bCertificate for some reason 233 | try 234 | Cert.dwLength := 0; 235 | Cert.wRevision := WIN_CERT_REVISION_1_0; 236 | if not ImageGetCertificateHeader(hExe, 0, Cert^) then 237 | Exit; 238 | // Read the full certificate 239 | ReallocMem(Cert, SizeOf(TWinCertificate) + Cert.dwLength); 240 | if not ImageGetCertificateData(hExe, 0, Cert, Cert.dwLength) then 241 | Exit; 242 | // Get the certificate context. CryptVerifyMessageSignature has the 243 | // side effect of creating a context for the signing certificate. 244 | FillChar(VerifyParams, SizeOf(VerifyParams), 0); 245 | VerifyParams.cbSize := SizeOf(VerifyParams); 246 | VerifyParams.dwMsgAndCertEncodingType := X509_ASN_ENCODING or PKCS_7_ASN_ENCODING; 247 | if not CryptVerifyMessageSignature(VerifyParams, 0, @Cert.bCertificate, 248 | Cert.dwLength, nil, nil, @CertContext) then 249 | Exit; 250 | try 251 | // Extract and compare the certificate's subject names. Don't 252 | // compare the entire certificate or the public key as those will 253 | // change when the certificate is renewed. 254 | CertNameLen := CertGetNameStringA(CertContext, 255 | CERT_NAME_SIMPLE_DISPLAY_TYPE, 0, nil, nil, 0); 256 | SetLength(CertName, CertNameLen - 1); 257 | CertGetNameStringA(CertContext, CERT_NAME_SIMPLE_DISPLAY_TYPE, 0, 258 | nil, PAnsiChar(CertName), CertNameLen); 259 | if CertName <> CompanyName then 260 | Exit; 261 | finally 262 | CertFreeCertificateContext(CertContext) 263 | end; 264 | finally 265 | FreeMem(Cert); 266 | end; 267 | finally 268 | CloseHandle(hExe); 269 | end; 270 | Result := True; 271 | end; 272 | 273 | function GetExeCertCompanyName(const FileName: string): string; 274 | var 275 | hExe: HMODULE; 276 | Cert: PWinCertificate; 277 | CertContext: PCCERT_CONTEXT; 278 | CertCount: DWORD; 279 | CertName: AnsiString; 280 | CertNameLen: DWORD; 281 | VerifyParams: CRYPT_VERIFY_MESSAGE_PARA; 282 | begin 283 | Result := ''; 284 | // Verify that the exe was signed by our private key 285 | hExe := CreateFile(PChar(Filename), GENERIC_READ, FILE_SHARE_READ, 286 | nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL or FILE_FLAG_RANDOM_ACCESS, 0); 287 | if hExe = INVALID_HANDLE_VALUE then 288 | Exit; 289 | try 290 | // There should only be one certificate associated with the exe 291 | if (not ImageEnumerateCertificates(hExe, CERT_SECTION_TYPE_ANY, CertCount, nil, 0)) or 292 | (CertCount <> 1) then 293 | Exit; 294 | // Read the certificate header so we can get the size needed for the full cert 295 | GetMem(Cert, SizeOf(TWinCertificate) + 3); // ImageGetCertificateHeader writes an DWORD at bCertificate for some reason 296 | try 297 | Cert.dwLength := 0; 298 | Cert.wRevision := WIN_CERT_REVISION_1_0; 299 | if not ImageGetCertificateHeader(hExe, 0, Cert^) then 300 | Exit; 301 | // Read the full certificate 302 | ReallocMem(Cert, SizeOf(TWinCertificate) + Cert.dwLength); 303 | if not ImageGetCertificateData(hExe, 0, Cert, Cert.dwLength) then 304 | Exit; 305 | // Get the certificate context. CryptVerifyMessageSignature has the 306 | // side effect of creating a context for the signing certificate. 307 | FillChar(VerifyParams, SizeOf(VerifyParams), 0); 308 | VerifyParams.cbSize := SizeOf(VerifyParams); 309 | VerifyParams.dwMsgAndCertEncodingType := X509_ASN_ENCODING or PKCS_7_ASN_ENCODING; 310 | if not CryptVerifyMessageSignature(VerifyParams, 0, @Cert.bCertificate, 311 | Cert.dwLength, nil, nil, @CertContext) then 312 | Exit; 313 | try 314 | // Extract and compare the certificate's subject names. Don't 315 | // compare the entire certificate or the public key as those will 316 | // change when the certificate is renewed. 317 | CertNameLen := CertGetNameStringA(CertContext, 318 | CERT_NAME_SIMPLE_DISPLAY_TYPE, 0, nil, nil, 0); 319 | SetLength(CertName, CertNameLen - 1); 320 | CertGetNameStringA(CertContext, CERT_NAME_SIMPLE_DISPLAY_TYPE, 0, 321 | nil, PAnsiChar(CertName), CertNameLen); 322 | Result := CertName; 323 | if CertName <> '' then 324 | Exit; 325 | finally 326 | CertFreeCertificateContext(CertContext) 327 | end; 328 | finally 329 | FreeMem(Cert); 330 | end; 331 | finally 332 | CloseHandle(hExe); 333 | end; 334 | //Result := True; 335 | end; 336 | 337 | function FileVersionGet( const sgFileName : string ) : string; 338 | var infoSize: DWORD; 339 | var verBuf: pointer; 340 | var verSize: UINT; 341 | var wnd: UINT; 342 | var FixedFileInfo : PVSFixedFileInfo; 343 | begin 344 | infoSize := GetFileVersioninfoSize(PChar(sgFileName), wnd); 345 | 346 | result := ''; 347 | 348 | if infoSize <> 0 then 349 | begin 350 | GetMem(verBuf, infoSize); 351 | try 352 | if GetFileVersionInfo(PChar(sgFileName), wnd, infoSize, verBuf) then 353 | begin 354 | VerQueryValue(verBuf, '\', Pointer(FixedFileInfo), verSize); 355 | 356 | result := IntToStr(FixedFileInfo.dwFileVersionMS div $10000) + '.' + 357 | IntToStr(FixedFileInfo.dwFileVersionMS and $0FFFF) + '.' + 358 | IntToStr(FixedFileInfo.dwFileVersionLS div $10000) + '.' + 359 | IntToStr(FixedFileInfo.dwFileVersionLS and $0FFFF); 360 | end; 361 | finally 362 | FreeMem(verBuf); 363 | end; 364 | end; 365 | end; 366 | 367 | function IsImmersivePidl(pidl: PItemIdList): Boolean; 368 | var 369 | pPIDL: PItemIDList; 370 | v2: BOOL; 371 | begin 372 | Result := False; 373 | if SHGetKnownFolderIDList(FOLDERID_AppsFolder, $4000, 0, pPIDL) >= 0 then 374 | begin 375 | Result := ILIsParent(pPIDL, pidl, True); 376 | ILFree(pPIDL); 377 | end; 378 | end; 379 | 380 | //https://developer.android.com/guide/topics/manifest/manifest-element#package 381 | function IsValidAppPackageName(value: string): Boolean; 382 | const 383 | VALIDCHARS='abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789._'; 384 | var 385 | ch: PChar; 386 | I: Integer; 387 | dotsCounter: Integer; 388 | dotsoffset: Integer; 389 | begin 390 | dotsCounter := 0; 391 | dotsoffset := 0; 392 | Result := True; 393 | I := 1; // first char must be A_Z only 394 | if value[I] in ['A'..'Z', 'a'..'z'] then 395 | begin 396 | for I := 2 to value.Length do 397 | begin 398 | if value[I] = '.' then 399 | begin 400 | Inc(dotsCounter); 401 | if dotsoffset = 0 then 402 | dotsoffset := I; 403 | end; 404 | 405 | if not(value[I] in ['A'..'Z','a'..'z','0'..'9','_','.']) then 406 | Result := False; 407 | 408 | if (value[I-1] = '.') and (value[I] = '.') // two consecutive dots are not allowed 409 | then 410 | Result := False; 411 | 412 | if not Result then Break; 413 | end; 414 | if Result and (dotsCounter < 2) then 415 | Result := False; 416 | // hacky (bad) way to ignore other windows apps like Microsoft.Windows.Explorer 417 | // since they also use its AppUserModelID similarly to an Android Package Name 418 | // but most Android apps tend to use com. tv. org. net. etc which are shorter Microsoft. 419 | { TODO : compare to ADB's list result better, but we need to install/configure its path first } 420 | if (dotsoffset > 4) or (dotsoffset < 2) then 421 | Result := False; 422 | end 423 | else 424 | Result := False; 425 | end; 426 | 427 | end. 428 | -------------------------------------------------------------------------------- /main.pas: -------------------------------------------------------------------------------- 1 | unit main; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, 7 | FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, 8 | // TrayIcon 9 | FMX.Windows.TrayIcon, FMX.Effects, FMX.Objects, FMX.TabControl, 10 | FMX.ListView.Types, FMX.ListView.Appearances, FMX.ListView.Adapters.Base, 11 | FMX.ListView, FMX.Controls.Presentation, FMX.StdCtrls, FMX.Ani, FMX.Layouts, 12 | DosCommand, ksVirtualListView, System.ImageList, FMX.ImgList, FMX.Edit, 13 | FMX.Menus, 14 | Winapi.Messages, Net.HTTPClient, 15 | Winapi.IpHlpApi, ksAppEvents, ksTypes, ksCircleProgress, ksSegmentButtons, 16 | ksTileMenu, FMX.ExtCtrls, FMX.Memo.Types, FMX.ScrollBox, FMX.Memo, 17 | ksTabControl, FMX.Filter.Effects 18 | ; 19 | 20 | const // hard coded paths, for now located in the same directory where this application runs 21 | { TODO : Add proper directories handling specially when this applications install in ProgramFiles or other restricted directories } 22 | ADB_PATH = 'adb'; 23 | DOWNLOADS_PATH = 'downloads'; 24 | // Up to date download link for Windows is located here 25 | ADB_URL = 'https://dl.google.com/android/repository/platform-tools-latest-windows.zip'; 26 | type 27 | 28 | TSettings = record 29 | ADBPath: string; 30 | DownloadsPath: string; 31 | 32 | end; 33 | 34 | TWSA = record 35 | InstallPath: string; 36 | AppUserModelID: string; 37 | Version: string; 38 | DisplayName: string; 39 | WsaSettings: string; 40 | WsaClient: string; 41 | PublisherDisplayName: string; 42 | LogoPath: string; // replace .png with .scale-100.png .scale-125.png .scale-150.png .scale-200.png or .scale-400.png 43 | MinWinVersion: string; 44 | end; 45 | 46 | TDownloadEvent = procedure(Sender: TObject; DownloadCode: Integer) of Object; 47 | 48 | TDownloader = class 49 | private 50 | FValue: Byte; 51 | 52 | FClient: THTTPClient; 53 | FGlobalStart: Cardinal; 54 | FGlobalStep: Cardinal; 55 | FAsyncResult: IAsyncResult; 56 | FDownloaderStream: TStream; 57 | FSize: Int64; 58 | FURL: string; 59 | FUA: string; 60 | FHeader: string; 61 | FSavePath: string; 62 | 63 | FOnDownloaded: TDownloadEvent; 64 | 65 | FDownloading: Boolean; 66 | FAbortNow: Boolean; 67 | FAborted: Boolean; 68 | procedure SetValue(const Value: byte); 69 | protected 70 | procedure DoReceiveDataEvent(const Sender: TObject; AContentLength: Int64; 71 | AReadCount: Int64; var Abort: Boolean); 72 | procedure DoEndDownload(const AsyncResult: IAsyncResult); 73 | public 74 | constructor Create; 75 | destructor Destroy; override; 76 | procedure DoStartDownload; 77 | procedure AbortDownload; 78 | 79 | property Value: byte read FValue write SetValue; 80 | 81 | property OnDownloaded: TDownloadEvent read FOnDownloaded write FOnDownloaded; 82 | property IsDownloading: Boolean read FDownloading; 83 | 84 | property URL: string read FURL write FURL; 85 | property Header: string read FHeader write FHeader; 86 | property UserAgent: string read FUA write FUA; 87 | property SavePath: string read FSavePath write FSavePath; 88 | end; 89 | 90 | TWinDroidHwnd = class(TForm) 91 | Rectangle1: TRectangle; 92 | GlowEffect1: TGlowEffect; 93 | TabControl1: TTabControl; 94 | TabItem1: TTabItem; 95 | TabItem2: TTabItem; 96 | TabItem3: TTabItem; 97 | TabItem4: TTabItem; 98 | Label1: TLabel; 99 | Label2: TLabel; 100 | Label3: TLabel; 101 | Label4: TLabel; 102 | Label5: TLabel; 103 | StyleBook1: TStyleBook; 104 | FloatAnimation1: TFloatAnimation; 105 | FloatAnimation2: TFloatAnimation; 106 | Layout1: TLayout; 107 | Button1: TButton; 108 | DosCommand1: TDosCommand; 109 | Timer1: TTimer; 110 | ListView1: TListView; 111 | btnTempOfflineInstaller: TButton; 112 | btnInstallOffline: TButton; 113 | btnRefreshAppsList: TButton; 114 | btnDownloadADB: TButton; 115 | Edit1: TEdit; 116 | PopupMenu1: TPopupMenu; 117 | MenuItem1: TMenuItem; 118 | Lang1: TLang; 119 | loWSAInfo: TLayout; 120 | imgWSA: TImage; 121 | lbWSAInfo: TLabel; 122 | lbWSAMUI: TLabel; 123 | MenuItem2: TMenuItem; 124 | MenuItem3: TMenuItem; 125 | MenuItem4: TMenuItem; 126 | Rectangle2: TRectangle; 127 | GlowEffect2: TGlowEffect; 128 | lbWSAVersion: TLabel; 129 | ksCircleProgress1: TksCircleProgress; 130 | DropTarget1: TDropTarget; 131 | OpenDialog1: TOpenDialog; 132 | Edit2: TEdit; 133 | Memo1: TMemo; 134 | ksTabControl1: TksTabControl; 135 | ksTabItem0: TksTabItem; 136 | ksTabItem2: TksTabItem; 137 | ksTabItem3: TksTabItem; 138 | ksTabItem4: TksTabItem; 139 | btnReplaceAmazon: TButton; 140 | ksCircleProgress2: TksCircleProgress; 141 | Label6: TLabel; 142 | Label7: TLabel; 143 | Label8: TLabel; 144 | Button2: TButton; 145 | Edit3: TEdit; 146 | FillRGBEffect1: TFillRGBEffect; 147 | ksCircleProgress3: TksCircleProgress; 148 | lbWSAStatus: TLabel; 149 | lbWSAForeground: TLabel; 150 | MonochromeEffect1: TMonochromeEffect; 151 | lbWSAMinWinVer: TLabel; 152 | lbWSAPublisher: TLabel; 153 | procedure FormCreate(Sender: TObject); 154 | procedure FormDestroy(Sender: TObject); 155 | procedure FloatAnimation1Finish(Sender: TObject); 156 | procedure FloatAnimation1Process(Sender: TObject); 157 | procedure FloatAnimation2Finish(Sender: TObject); 158 | procedure Button1Click(Sender: TObject); 159 | procedure btnRefreshAppsListClick(Sender: TObject); 160 | procedure ListView1ButtonClick(const Sender: TObject; 161 | const AItem: TListItem; const AObject: TListItemSimpleControl); 162 | procedure btnDownloadADBClick(Sender: TObject); 163 | procedure MenuItem1Click(Sender: TObject); 164 | procedure imgWSAClick(Sender: TObject); 165 | procedure MenuItem3Click(Sender: TObject); 166 | procedure MenuItem4Click(Sender: TObject); 167 | procedure PopupMenu1Popup(Sender: TObject); 168 | procedure DropTarget1DragOver(Sender: TObject; const Data: TDragObject; 169 | const Point: TPointF; var Operation: TDragOperation); 170 | procedure DropTarget1Dropped(Sender: TObject; const Data: TDragObject; 171 | const Point: TPointF); 172 | procedure DropTarget1Click(Sender: TObject); 173 | procedure Edit4ChangeTracking(Sender: TObject); 174 | procedure ListView1ItemClickEx(const Sender: TObject; ItemIndex: Integer; 175 | const LocalClickPos: TPointF; const ItemObject: TListItemDrawable); 176 | protected 177 | procedure TrayIconExit(Sender: TObject); 178 | procedure TrayIconClick(Sender: TObject); 179 | // TaskbarLocation 180 | function GetMainTaskbarPosition: Integer; 181 | 182 | function GetWSAInstallationPath(amui: string): string; 183 | 184 | function ReplaceAmazonAppstore: Boolean; 185 | function IsValidAppPackageName(value: string): Boolean; 186 | { TODO : In Progress, Shell:AppsFolder items can resolve to lnk files at Shell:Programs directory, we need to do that } 187 | function IsWsaClientLnkTarget(value: string): Boolean; 188 | function IsWsaClientRunning:Boolean; 189 | procedure CheckWsaClientStatus; 190 | private 191 | { Private declarations } 192 | WSA: TWSA; 193 | // FHookWndHandle: THandle; 194 | // procedure WndMethod(var Msg: Winapi.Messages.TMessage); 195 | public 196 | { Public declarations } 197 | end; 198 | 199 | var 200 | WinDroidHwnd: TWinDroidHwnd; 201 | TrayIcon: TTrayIcon; 202 | Hook: NativeUInt; 203 | prevRect: TRect; 204 | AppsClasses: TStringList; 205 | WsaClientPath: string; 206 | WndProcHook: THandle; 207 | IsForegroundWSA: Boolean = False; 208 | ForegroundWSA: THandle; 209 | 210 | implementation 211 | 212 | uses 213 | Winapi.Windows, Winapi.PsAPI, Winapi.DwmApi, Winapi.MultiMon, 214 | Winapi.ShellAPI, FMX.Platform.Win, Vcl.Graphics, Registry, MSXML, System.IOUtils, 215 | Winapi.KnownFolders, ShlObj, ActiveX, ComObj, Winapi.PropKey, OleAcc, 216 | frmApkInstaller; 217 | 218 | type 219 | TVclBmp = Vcl.Graphics.TBitmap; 220 | 221 | const 222 | WM_TOGGLEFULLSCREEN = WM_USER + 9; 223 | 224 | 225 | function StartHook:BOOL; stdcall; external 'F11Hook.dll' name 'STARTHOOK'; 226 | procedure StopHook; stdcall; external 'F11Hook.dll' name 'STOPHOOK'; 227 | 228 | 229 | {$R *.fmx} 230 | 231 | function Icon2Bitmap(hIcon: HICON; ABmp: FMX.Graphics.TBitmap): Boolean; 232 | var 233 | LIcon: TIcon; 234 | LBmp: TVclBmp; 235 | LStream: TMemoryStream; 236 | begin 237 | Result := False; 238 | LIcon := TIcon.Create; 239 | LBmp := TVclBmp.Create; 240 | LStream := TMemoryStream.Create; 241 | try 242 | LIcon.Handle := hIcon; 243 | LBmp.SetSize(LIcon.Width, LIcon.Height); 244 | LBmp.PixelFormat := pf32bit; 245 | if DrawIcon(LBmp.Canvas.Handle, 0, 0, LIcon.Handle) then 246 | begin 247 | ABmp.SetSize(LBmp.Width, LBmp.Height); 248 | LBmp.SaveToStream(LStream); 249 | LStream.Position := 0; 250 | ABmp.LoadFromStream(LStream); 251 | end; 252 | finally 253 | LStream.Free; 254 | LBmp.Free; 255 | LIcon.Free; 256 | end; 257 | end; 258 | 259 | procedure WinEventProc(hWinEventHook: NativeUInt; dwEvent: DWORD; handle: HWND; 260 | idObject, idChild: LONG; dwEventThread, dwmsEventTime: DWORD); 261 | var 262 | LHWindow: HWND; 263 | LHFullScreen: BOOL; 264 | vRect: TRect; 265 | ParentHandle: HWND; 266 | clsName: array[0..255] of Char; 267 | pid: DWORD; 268 | path: array [0..4095] of Char; 269 | begin 270 | if (dwEvent = EVENT_OBJECT_LOCATIONCHANGE) 271 | or (dwEvent = EVENT_SYSTEM_FOREGROUND) then 272 | begin 273 | LHWindow := GetForegroundWindow; 274 | if LHWindow <> 0 then 275 | begin 276 | GetWindowRect(LHWindow, vRect); 277 | if prevRect <> vRect then 278 | begin 279 | prevRect := vRect; 280 | // process current 64bit foreground window to find out if it is a WsaClient.exe instance 281 | // and what WindowState is currently applied, in order to toggle its size with the keyhook dll 282 | GetClassName(LHWindow, clsName, 255); 283 | if Trim(clsName) <> '' then 284 | begin 285 | WinDroidHwnd.lbWSAForeground.Text := ''; 286 | // check if this class name is one of our listed applications 287 | if AppsClasses.IndexOf(clsName) <> -1 then 288 | begin 289 | GetWindowThreadProcessId(LHWindow, pid); 290 | var proc := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, pid); 291 | if proc <> 0 then 292 | begin 293 | try 294 | GetModuleFileNameEx(proc, 0, @path[0], Length(path)); 295 | // check if is our wsaclient, and not other executable named the same 296 | if Trim(path) = Trim(WsaClientPath) then 297 | begin 298 | WinDroidHwnd.lbWSAForeground.Text := 'WSA App: ' + clsName; 299 | // WinDroidHwnd.lbWSAVersion.Text := path; 300 | IsForegroundWSA := True; 301 | ForegroundWSA := LHWindow; 302 | end 303 | else 304 | begin 305 | IsForegroundWSA := False; 306 | ForegroundWSA := 0; 307 | end; 308 | finally 309 | CloseHandle(proc); 310 | end; 311 | end; 312 | end; 313 | end; 314 | end; 315 | end; 316 | end; 317 | // check wsaclient.exe status using shell events 318 | if (dwEvent = EVENT_OBJECT_CREATE) or 319 | (dwEvent = EVENT_OBJECT_DESTROY) 320 | then 321 | begin 322 | if (idObject = OBJID_WINDOW) //or (idChild = INDEXID_CONTAINER) 323 | then 324 | begin 325 | WinDroidHwnd.CheckWsaClientStatus; 326 | end; 327 | end; 328 | end; 329 | 330 | function WndProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; 331 | var 332 | msg: TCWPRetStruct; 333 | LMonitor: HMONITOR; 334 | MonInfo: MONITORINFO; 335 | IsFull: Boolean; 336 | begin 337 | if (nCode >= HC_ACTION) {and (lParam > 0)} then 338 | begin 339 | msg := PCWPRetStruct(lParam)^; 340 | 341 | if (msg.message = WM_TOGGLEFULLSCREEN) then 342 | begin 343 | // OutputDebugString('F11 EVENT'); 344 | // WinDroidHwnd.lbWSAVersion.Text := 'F11 ' + inttoStr(Random(100)); 345 | // if current foreground window is an Android app, let's toogle its size to mimix windowed fullscreen 346 | if IsForegroundWSA 347 | and (GetForegroundWindow = ForegroundWSA) 348 | and IsWindow(ForegroundWSA) 349 | then 350 | begin 351 | var style := GetWindowLong(ForegroundWSA, GWL_STYLE); 352 | if (style and WS_CAPTION = WS_CAPTION) 353 | and (style and WS_THICKFRAME = WS_THICKFRAME) 354 | then 355 | begin 356 | style := style and not WS_CAPTION; 357 | style := style and not WS_THICKFRAME; 358 | IsFull := False; //current fullscreen state 359 | end 360 | else 361 | begin 362 | style := style or WS_CAPTION; 363 | style := style or WS_THICKFRAME; 364 | IsFull := True; 365 | end; 366 | 367 | SetWindowLong(ForegroundWSA, GWL_STYLE, style); 368 | 369 | LMonitor := Winapi.MultiMon.MonitorFromWindow(ForegroundWSA, MONITOR_DEFAULTTOPRIMARY); 370 | MonInfo.cbSize := SizeOf(MONITORINFO); 371 | GetMonitorInfo(LMonitor, @MonInfo); 372 | 373 | // if IsFull then 374 | // SetWindowPos(ForegroundWSA, 0, 375 | // MonInfo.rcWork.Left, 376 | // MonInfo.rcWork.Top, 377 | // MonInfo.rcWork.Width, 378 | // MonInfo.rcWork.Height, 379 | // {SWP_NOSIZE or} SWP_NOMOVE or SWP_FRAMECHANGED or SWP_NOACTIVATE) 380 | // else 381 | // SetWindowPos(ForegroundWSA, 0, 382 | // MonInfo.rcMonitor.Left, 383 | // MonInfo.rcMonitor.Top, 384 | // MonInfo.rcMonitor.Width, 385 | // MonInfo.rcMonitor.Height, 386 | // SWP_NOMOVE or SWP_FRAMECHANGED or SWP_NOACTIVATE); 387 | // Sleep(1); 388 | if IsFull then 389 | SendMessage(ForegroundWSA, WM_SYSCOMMAND, SC_RESTORE, 0) 390 | else 391 | SendMessage(ForegroundWSA, WM_SYSCOMMAND, SC_MAXIMIZE, 0); 392 | end; 393 | end; 394 | end; 395 | 396 | Result := CallNextHookEx(WndProcHook, nCode, wParam, lParam); 397 | end; 398 | 399 | procedure TWinDroidHwnd.btnDownloadADBClick(Sender: TObject); 400 | begin 401 | // Start debug client apk 402 | //"C:\Program Files\WindowsApps\MicrosoftCorporationII.WindowsSubsystemForAndroid_1.7.32815.0_x64__8wekyb3d8bbwe\WsaClient\WsaClient.exe" /deeplink wsa-client://developer-settings 403 | 404 | end; 405 | 406 | procedure TWinDroidHwnd.btnRefreshAppsListClick(Sender: TObject); 407 | var 408 | io: IKnownFolderManager; 409 | count: Cardinal; 410 | // vie: array [0..65534] of TGUID; 411 | a: PGUIDList; 412 | knownfoldernative: IKnownFolder; 413 | hr: HRESULT; 414 | oguid: TGUID; 415 | si: IShellItem2; 416 | sfgao: Cardinal; 417 | isFileSystem: Boolean; 418 | fd: TKnownFolderDefinition; 419 | Item: TListViewItem; 420 | begin 421 | 422 | CoInitialize(nil); 423 | //FOLDERID_AppsFolder 1e87508d-89c2-42f0-8a7e-645a0f50ca58 424 | CoCreateInstance(CLSID_KnownFolderManager, nil, CLSCTX_ALL, IKnownFolderManager, io); 425 | if Assigned(io) then 426 | begin 427 | //SHGetKnownFolderIDList(FOLDERID_NetworkFolder) 428 | // io.GetFolderIds(vie, count); 429 | hr := io.GetFolder(FOLDERID_AppsFolder, knownfoldernative); 430 | if hr = S_OK then 431 | begin 432 | //kf := get 433 | hr := knownfoldernative.GetShellItem(0, IID_IShellItem2, si); 434 | if Succeeded(hr) then 435 | begin 436 | if si <> nil then 437 | begin 438 | si.GetAttributes(SFGAO_FILESYSTEM, sfgao); 439 | // sfgao and 440 | isFileSystem := (sfgao and SFGAO_FILESYSTEM) <> 0; 441 | end; 442 | // not file system 443 | if not isFileSystem then 444 | begin 445 | knownfoldernative.GetShellItem(0, IID_IShellItem2, si); //nativeShellItem should go instead of si 446 | knownfoldernative.GetFolderDefinition(fd); 447 | var pidControl: PItemIDList; 448 | var psfDesktop, dt: IShellFolder; 449 | var psfControl: IShellFolder; 450 | var pc: IShellFolder2; 451 | var pEnumList: IEnumIDList; 452 | var pidChild: PItemIDList; 453 | var pidAbsolute: PItemIDList; 454 | var celtFetched: ULONG; 455 | var FileInfo: SHFILEINFOW; 456 | 457 | OleCheck(SHGetDesktopFolder(psfDesktop)); 458 | OleCheck(SHGetDesktopFolder(dt)); 459 | olecheck(knownfoldernative.GetIDList(KF_FLAG_DEFAULT, pidControl)); 460 | OleCheck(psfDesktop.BindToObject(pidControl, nil, IID_IShellFolder, psfControl)); 461 | OleCheck(psfControl.EnumObjects(0, SHCONTF_NONFOLDERS or SHCONTF_INCLUDEHIDDEN, pEnumList)); 462 | 463 | ListView1.Items.Clear; 464 | AppsClasses.Clear; 465 | // ImageList1. 466 | while pEnumList.Next(1, pidChild, celtFetched) = 0 do 467 | begin 468 | pidAbsolute := ILCombine(pidControl, pidChild); 469 | OleCheck(dt.BindToObject(pidControl, nil, IID_IShellFolder2, Pointer(pc))); 470 | var sa,lnk: OleVariant; 471 | // var cs: SHCOLUMNID; 472 | // cs.fmtid := StringToGUID('{9F4C2855-9F79-4B39-A8D0-E1D42DE1D5F3}'); 473 | // cs.pid := 5; 474 | OleCheck((pc.GetDetailsEx(pidChild, SHCOLUMNID(PKEY_AppUserModel_ID), @sa))); 475 | var re:HRESULT; 476 | try 477 | re := (pc.GetDetailsEx(pidChild, SHCOLUMNID(PKEY_Link_TargetParsingPath), @lnk)); 478 | except 479 | lnk := ''; 480 | end; 481 | { TODO : If ADB connection is established, better list using adb shell cmd package list packages -3 } 482 | // if (Pos('com.', sa) = 1) 483 | // or (Pos('org.', sa) = 1) 484 | // or (Pos('net.', sa) = 1) 485 | // or (Pos('tv.', sa) = 1) 486 | if IsValidAppPackageName(sa) 487 | or (Pos('!Setti', sa) > 0) 488 | then 489 | begin 490 | // SHILCreateFromPath(LPCTSTR(pidAbsolute), pidAbsolute, nil); 491 | SHGetFileInfo(LPCTSTR(pidAbsolute), 0, FileInfo, SizeOf(FileInfo), SHGFI_PIDL or SHGFI_DISPLAYNAME or SHGFI_ICON or SHGFI_SYSICONINDEX or SHGFI_SHELLICONSIZE or SHGFI_LARGEICON); 492 | // pc.GetUIObjectOf(0, ) 493 | // var c:uint32; 494 | // pc.GetAttributesOf(1,pidChild,c); 495 | CoTaskMemFree(pidAbsolute); 496 | 497 | var icon := TIcon.Create; 498 | icon.Handle := FileInfo.hIcon; 499 | 500 | if (Pos('!Sett', sa) > 0) then 501 | begin 502 | lbWSAInfo.Text := FileInfo.szDisplayName; 503 | 504 | 505 | lbWSAMUI.Text := sa; 506 | // Icon2Bitmap(icon.Handle, imgWSA.Bitmap); 507 | end 508 | else if (LowerCase(lnk).Contains('wsaclient.exe')) then//if IsWsaClientLnkTarget(sa) then 509 | begin 510 | Item := ListView1.Items.Add; 511 | Item.Text := FileInfo.szDisplayName; 512 | Item.ButtonText := 'Execute'; 513 | Item.Detail := sa; 514 | Item.TagString := lnk; 515 | Icon2Bitmap(icon.Handle, Item.Bitmap); 516 | AppsClasses.Add(sa); 517 | end; 518 | 519 | icon.Free; 520 | end; 521 | CoTaskMemFree(pidChild); 522 | end; 523 | 524 | CoTaskMemFree(pidControl); 525 | 526 | // ListBox1.Items.Add(fd.pszParsingName);//'shell:::{4234d49b-0245-4df3-b780-3893943456e1}' 527 | // 528 | // SHCreateItemFromParsingName(fd.pszParsingName, nil, IID_IShellItem2, si); 529 | end; 530 | end 531 | else 532 | OleCheck(hr); 533 | 534 | 535 | end; 536 | 537 | 538 | // ListBox1.Clear; 539 | // ListBox1.Items.Add(IntToStr(count)); 540 | // CoTaskMemFree(@vie); 541 | end; 542 | 543 | CoUninitialize; 544 | end; 545 | 546 | procedure TWinDroidHwnd.Button1Click(Sender: TObject); 547 | begin 548 | TrayIconClick(Self); 549 | end; 550 | 551 | procedure TWinDroidHwnd.CheckWsaClientStatus; 552 | var 553 | state: Boolean; 554 | begin 555 | state := IsWsaClientRunning; 556 | if state then 557 | lbWSAStatus.Text := 'Running' 558 | else 559 | begin 560 | lbWSAStatus.Text := 'Not running'; 561 | end; 562 | MonochromeEffect1.Enabled := not state; 563 | end; 564 | 565 | procedure TWinDroidHwnd.DropTarget1Click(Sender: TObject); 566 | begin 567 | 568 | frmInstaller.Show; 569 | Exit; 570 | OpenDialog1.Filter := 'APK|*.apk|XAPK|*.xapk'; 571 | if OpenDialog1.Execute then 572 | begin 573 | 574 | end; 575 | end; 576 | 577 | procedure TWinDroidHwnd.DropTarget1DragOver(Sender: TObject; 578 | const Data: TDragObject; const Point: TPointF; var Operation: TDragOperation); 579 | begin 580 | if Length(Data.Files) = 1 then 581 | Operation := TDragOperation.Move 582 | else 583 | Operation := TDragOperation.None; 584 | end; 585 | 586 | procedure TWinDroidHwnd.DropTarget1Dropped(Sender: TObject; 587 | const Data: TDragObject; const Point: TPointF); 588 | begin 589 | // for d in Data.Files 590 | end; 591 | 592 | procedure TWinDroidHwnd.Edit4ChangeTracking(Sender: TObject); 593 | begin 594 | 595 | end; 596 | 597 | //https://developer.android.com/guide/topics/manifest/manifest-element#package 598 | function TWinDroidHwnd.IsValidAppPackageName(value: string): Boolean; 599 | const 600 | VALIDCHARS='abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789._'; 601 | var 602 | ch: PChar; 603 | I: Integer; 604 | dotsCounter: Integer; 605 | dotsoffset: Integer; 606 | begin 607 | dotsCounter := 0; 608 | dotsoffset := 0; 609 | Result := True; 610 | I := 1; // first char must be A_Z only 611 | if value[I] in ['A'..'Z', 'a'..'z'] then 612 | begin 613 | for I := 2 to value.Length do 614 | begin 615 | if value[I] = '.' then 616 | begin 617 | Inc(dotsCounter); 618 | if dotsoffset = 0 then 619 | dotsoffset := I; 620 | end; 621 | 622 | if not(value[I] in ['A'..'Z','a'..'z','0'..'9','_','.']) then 623 | Result := False; 624 | 625 | if (value[I-1] = '.') and (value[I] = '.') // two consecutive dots are not allowed 626 | then 627 | Result := False; 628 | 629 | if not Result then Break; 630 | end; 631 | if Result and (dotsCounter < 2) then 632 | Result := False; 633 | // hacky (bad) way to ignore other windows apps like Microsoft.Windows.Explorer 634 | // since they also use its AppUserModelID similarly to an Android Package Name 635 | // but most Android apps tend to use com. tv. org. net. etc which are shorter Microsoft. 636 | { TODO : compare to ADB's list result better, but we need to install/configure its path first } 637 | if (dotsoffset > 4) or (dotsoffset < 2) then 638 | Result := False; 639 | end 640 | else 641 | Result := False; 642 | end; 643 | 644 | // Verify that lnk located at 645 | function TWinDroidHwnd.IsWsaClientLnkTarget(value: string): Boolean; 646 | var 647 | lnk: IShellLink; 648 | storage: IPersistFile; 649 | widePath: WideString; 650 | buf: array[0..4096] of Char; 651 | fileData: TWin32FindData; 652 | realPath: LPCWSTR; 653 | begin 654 | Result := False; 655 | OleCheck(CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER, IShellLink, lnk)); 656 | OleCheck(lnk.QueryInterface(IPersistFile, storage)); 657 | 658 | if Succeeded(SHGetKnownFolderPath(FOLDERID_AppsFolder, KF_FLAG_DEFAULT, 0, realPath)) then 659 | begin 660 | // widePath := 'shell:::{4234d49b-0245-4df3-b780-3893943456e1}\'+value; 661 | widePath := {utf16toutf8}realPath + '\' + value; 662 | if Succeeded(storage.Load(@widePath[1], STGM_READ)) then 663 | if Succeeded(lnk.Resolve(GetActiveWindow, SLR_NOUPDATE)) then 664 | if Succeeded( lnk.GetPath(buf, SizeOf(buf), fileData, SLGP_UNCPRIORITY) ) 665 | then 666 | begin 667 | Result := LowerCase(buf).Contains('\wsaclient.exe'); 668 | end; 669 | CoTaskMemFree(realPath); 670 | end; 671 | storage := nil; 672 | lnk := nil; 673 | end; 674 | 675 | function TWinDroidHwnd.IsWsaClientRunning: Boolean; 676 | const 677 | WSA_CLIENT_MUTEX = '{42CEB0DF-325A-4FBE-BBB6-C259A6C3F0BB}'; 678 | var 679 | Mutex: NativeUInt; 680 | begin 681 | Result := False; 682 | Mutex := OpenMutex(MUTEX_ALL_ACCESS, False, WSA_CLIENT_MUTEX); 683 | if Mutex <> 0 then 684 | begin 685 | Result := True; 686 | end; 687 | 688 | CloseHandle(Mutex); 689 | 690 | end; 691 | 692 | procedure TWinDroidHwnd.FloatAnimation1Finish(Sender: TObject); 693 | begin 694 | FloatAnimation1.Enabled := False; 695 | end; 696 | 697 | procedure TWinDroidHwnd.FloatAnimation1Process(Sender: TObject); 698 | begin 699 | if not Visible then 700 | Visible := True; 701 | end; 702 | 703 | procedure TWinDroidHwnd.FloatAnimation2Finish(Sender: TObject); 704 | begin 705 | FloatAnimation2.Enabled := False; 706 | Visible := False; 707 | end; 708 | 709 | procedure TWinDroidHwnd.FormCreate(Sender: TObject); 710 | begin 711 | // Lang1.Lang := 'es'; 712 | 713 | AppsClasses := TStringList.Create; 714 | AppsClasses.Sorted := True; 715 | 716 | Layout1.Align := TAlignLayout.None; 717 | TrayIcon := TTrayIcon.Create(Self); 718 | TrayIcon.SetOnClick(TrayIconClick); 719 | TrayIcon.AddMenuAction('Exit', TrayIconExit); 720 | TrayIcon.Show('WSA Manager'); 721 | 722 | with FloatAnimation1 do 723 | begin 724 | AnimationType := TAnimationType.Out; 725 | Duration := 0.3; 726 | Interpolation := TInterpolationType.Circular; 727 | PropertyName := 'Position.X'; 728 | StartValue := Width; 729 | StartFromCurrent := True; 730 | StopValue := 0.0; 731 | end; 732 | 733 | with FloatAnimation2 do 734 | begin 735 | Duration := 0.2; 736 | Interpolation := TInterpolationType.Circular; 737 | PropertyName := 'Position.X'; 738 | StartValue := 0.0; 739 | StartFromCurrent := True; 740 | StopValue := Width; 741 | end; 742 | 743 | // Layout1.BoundsRect := Bounds; 744 | Layout1.Position.X := Width; 745 | 746 | btnRefreshAppsListClick(Sender); // this gets WSA Settings app AppUserModelID 747 | GetWSAInstallationPath(lbWSAMUI.Text); // this makes sure it is correct and updates WSA record info 748 | lbWSAVersion.Text := 'Version: ' + WSA.Version; 749 | lbWSAMinWinVer.Text := 'Minimum Windows Build: ' + WSA.MinWinVersion; 750 | lbWSAPublisher.Text := 'Publisher: ' + WSA.PublisherDisplayName; 751 | 752 | // FHookWndHandle := AllocateHWnd(WndMethod); 753 | 754 | // detect window change foreground 755 | Hook := SetWinEventHook(EVENT_MIN, EVENT_MAX, 0, @WinEventProc, 0, 0, WINEVENT_OUTOFCONTEXT or WINEVENT_SKIPOWNPROCESS); 756 | if Hook = 0 then 757 | raise Exception.Create('Couldn''t create event hook!'); 758 | // RunHook(Handle); 759 | if not StartHook then 760 | raise Exception.Create('Couldn''t set global hook to intercept F11'); 761 | end; 762 | 763 | procedure TWinDroidHwnd.FormDestroy(Sender: TObject); 764 | begin 765 | StopHook; 766 | // KillHook; 767 | UnhookWinEvent(Hook); 768 | 769 | // DeallocateHWnd(FHookWndHandle); 770 | TrayIcon.Destroy; 771 | 772 | AppsClasses.Free; 773 | end; 774 | 775 | function TWinDroidHwnd.GetMainTaskbarPosition: Integer; 776 | const ABNONE = -1; 777 | var 778 | AMonitor: HMonitor; 779 | MonInfo: MONITORINFO; 780 | TaskbarHandle: THandle; 781 | ABData: TAppBarData; 782 | Res: HRESULT; 783 | TaskbarRect: TRect; 784 | begin 785 | Result := ABNONE; 786 | ABData.cbSize := SizeOf(TAppbarData); 787 | Res := SHAppBarMessage(ABM_GETTASKBARPOS, ABData); 788 | if BOOL(Res) then 789 | begin 790 | // return ABE_LEFT=0, ABE_TOP, ABE_RIGHT or ABE_BOTTOM values 791 | Result := ABData.uEdge; 792 | end 793 | else // this might fail if explorer process is hung or is not set as shell (rare) 794 | begin 795 | TaskbarHandle := Winapi.Windows.FindWindow('Shell_TrayWnd', nil); 796 | if TaskbarHandle <> 0 then 797 | begin 798 | AMonitor := Winapi.MultiMon.MonitorFromWindow(TaskbarHandle, MONITOR_DEFAULTTOPRIMARY); 799 | MonInfo.cbSize := SizeOf(MONITORINFO); 800 | GetMonitorInfo(AMonitor, @MonInfo); 801 | if (MonInfo.rcMonitor.Left = TaskbarRect.Left) and (MonInfo.rcMonitor.Top = TaskbarRect.Top) 802 | and (MonInfo.rcMonitor.Width = TaskbarRect.Width) 803 | then 804 | Result := ABE_TOP 805 | else if (MonInfo.rcMonitor.Left + MonInfo.rcMonitor.Width = TaskbarRect.Right) 806 | and (MonInfo.rcMonitor.Width <> TaskbarRect.Width) 807 | then 808 | Result := ABE_RIGHT 809 | else if (MonInfo.rcMonitor.Left = TaskbarRect.Left) and (MonInfo.rcMonitor.Top + MonInfo.rcMonitor.Height = TaskbarRect.Bottom) 810 | and (MonInfo.rcMonitor.Width = TaskbarRect.Width) 811 | then 812 | Result := ABE_BOTTOM 813 | else 814 | Result := ABE_LEFT; 815 | end; 816 | // no explorer with taskbar running here, maybe 817 | end; 818 | 819 | 820 | end; 821 | 822 | { TODO : If for some weird reason there is more than one WSA installed (maybe a variant), we must make sure it picks the correct on :-/ } 823 | function TWinDroidHwnd.GetWSAInstallationPath(amui: string): string; 824 | var 825 | reg: TRegistry; 826 | list: TStringList; 827 | I, J, K: Integer; 828 | xmlstr: string; 829 | xml: IXMLDOMDocument2; 830 | node: IXMLDOMNode; 831 | nodes_row, nodes_se: IXMLDOMNodeList; 832 | name, vers, arqt, appid: string; 833 | appUserModelID: string; 834 | installPath: string; 835 | begin 836 | Result := ''; 837 | reg := TRegistry.Create; 838 | list := TStringList.Create; 839 | try 840 | reg.RootKey := HKEY_CURRENT_USER; 841 | reg.OpenKeyReadOnly('Software\Classes\ActivatableClasses\Package'); 842 | reg.GetKeyNames(list); 843 | for I := 0 to list.Count - 1 do 844 | begin 845 | installPath := GetEnvironmentVariable('PROGRAMW6432')+'\WindowsApps\'+list[I]; 846 | if list[I].Contains('MicrosoftCorporationII.WindowsSubsystemForAndroid') 847 | and FileExists(installPath+'\AppxManifest.xml') then 848 | begin 849 | Result := installPath; 850 | xmlstr := TFile.ReadAllText(installPath+'\AppxManifest.xml'); 851 | xml := CreateOleObject('Microsoft.XMLDOM') as IXMLDOMDocument2; 852 | xml.async := False; 853 | 854 | xml.loadXML(xmlstr); 855 | if xml.parseError.errorCode <> 0 then 856 | raise Exception.Create('XML Load Error: ' + xml.parseError.reason); 857 | 858 | nodes_row := xml.selectNodes('/Package'); 859 | 860 | for J := 0 to nodes_row.length - 1 do 861 | begin 862 | node := nodes_row.item[J]; 863 | name := node.selectSingleNode('Identity').attributes.getNamedItem('Name').text; 864 | vers := node.selectSingleNode('Identity').attributes.getNamedItem('Version').text; 865 | try 866 | arqt := node.selectSingleNode('Identity').attributes.getNamedItem('ProcessorArchitecture').text; 867 | except 868 | arqt := 'Unknown'; //applies for extension for old edge, I guess we don't need it. 869 | end; 870 | 871 | try 872 | WSA.PublisherDisplayName := node.selectSingleNode('Properties').selectSingleNode('PublisherDisplayName').text; 873 | WSA.LogoPath := node.selectSingleNode('Properties').selectSingleNode('Logo').text; 874 | WSA.MinWinVersion := node.selectSingleNode('Dependencies').selectSingleNode('TargetDeviceFamily').attributes.getNamedItem('MinVersion').text; 875 | except 876 | 877 | end; 878 | 879 | nodes_se := node.selectNodes('Applications'); 880 | for K := 0 to nodes_se.length - 1 do 881 | begin 882 | node := nodes_se.item[K]; 883 | appid := node.selectSingleNode('Application').attributes.getNamedItem('Id').text; 884 | // let's forge the Settings app AMUI listed which we passed to make sure it belong to our app 885 | appUserModelID := name + Copy(list[I], StrLen(PChar(name + '_' + vers + '_' + arqt + '_'))+1, 886 | StrLen(PChar(name + '_' + vers + '_' + arqt + '_'))) + '!Settings' + appid; 887 | 888 | if appUserModelID <> amui then 889 | Result := ''; 890 | end; 891 | end; 892 | end; 893 | // let's just use the first occurrence 894 | if Result <> '' then 895 | begin 896 | // we found it, let's update our WSA info 897 | WSA.InstallPath := installPath; 898 | WSA.Version := vers; 899 | WSA.AppUserModelID := appUserModelID; 900 | WSA.DisplayName := name; 901 | WSA.WsaSettings := ''; 902 | if FileExists(installPath + '\WsaSettings.exe') then 903 | WSA.WsaSettings := '\WsaSettings.exe'; 904 | WSA.WsaClient := ''; 905 | if FileExists(installPath + '\WsaClient\WsaClient.exe') then 906 | begin 907 | WSA.WsaClient := '\WsaClient\WsaClient.exe'; 908 | WsaClientPath := Trim(installPath + '\WsaClient\WsaClient.exe'); 909 | end; 910 | Break; 911 | end; 912 | end; 913 | finally 914 | list.Free; 915 | reg.Free; 916 | end; 917 | end; 918 | 919 | procedure TWinDroidHwnd.imgWSAClick(Sender: TObject); 920 | begin 921 | ShellExecute(0, 'OPEN', 'explorer.exe', PChar('shell:::{4234d49b-0245-4df3-b780-3893943456e1}\'+lbWSAMUI.Text), nil, SW_SHOWNORMAL) 922 | end; 923 | 924 | procedure TWinDroidHwnd.ListView1ButtonClick(const Sender: TObject; 925 | const AItem: TListItem; const AObject: TListItemSimpleControl); 926 | var 927 | LItem: TListViewItem; 928 | begin 929 | // ShowMessage(AItem.TagString); 930 | LItem := ListView1.Items[AItem.Index]; 931 | ShellExecute(0, 'OPEN', 'explorer.exe', PChar('shell:::{4234d49b-0245-4df3-b780-3893943456e1}\'+LItem.Detail), nil, SW_SHOWNORMAL) 932 | end; 933 | 934 | procedure TWinDroidHwnd.ListView1ItemClickEx(const Sender: TObject; 935 | ItemIndex: Integer; const LocalClickPos: TPointF; 936 | const ItemObject: TListItemDrawable); 937 | var 938 | LItem: TListViewItem; 939 | begin 940 | LItem := ListView1.Items[ItemIndex]; 941 | // ShowMessage(LItem.Text); 942 | end; 943 | 944 | procedure TWinDroidHwnd.MenuItem1Click(Sender: TObject); 945 | var 946 | LItem: TListViewItem; 947 | begin 948 | //"C:\Users\\AppData\Local\Microsoft\WindowsApps\MicrosoftCorporationII.WindowsSubsystemForAndroid_8wekyb3d8bbwe\WsaClient.exe" /uninstall com.amazon.venezia 949 | if Assigned(ListView1.Selected) then 950 | begin 951 | // ShowMessage(ListView1.Selected.TagString); 952 | LItem := ListView1.Items[ListView1.Selected.Index]; 953 | if MessageDlg('Are you sure to uninstall ' + LItem.Detail + '?'#13#10'This procedure is irreversible!', TMsgDlgType.mtWarning, [TMsgDlgBtn.mbYes, TMsgDlgBtn.mbNo], 0) = mrYes then 954 | begin 955 | ShellExecute(0, 'OPEN', PChar(WSA.InstallPath + WSA.WsaClient), PChar('/uninstall ' + LItem.Detail), nil, SW_SHOWNORMAL); 956 | end; 957 | end; 958 | end; 959 | 960 | procedure TWinDroidHwnd.MenuItem3Click(Sender: TObject); 961 | //var 962 | // appPath: string; 963 | begin 964 | // var p := Pos('!', lbWSAMUI.Text); 965 | // appPath := Copy(lbWSAMUI.Text, 1, p - 1); 966 | // ShellExecute(0, 'OPEN', 'explorer.exe', PChar('%PROGRAMFILES%\WindowsApps\'+appPath), nil, SW_SHOWNORMAL); 967 | ShellExecute(0, 'OPEN', 'explorer.exe', PChar(GetWSAInstallationPath(lbWSAMUI.Text)), nil, SW_SHOWNORMAL); 968 | // ShellExecute(0, 'OPEN', 'explorer.exe', PChar('shell:::{4234d49b-0245-4df3-b780-3893943456e1}\'+lbWSAMUI.Text), nil, SW_SHOWNORMAL) 969 | end; 970 | 971 | procedure TWinDroidHwnd.MenuItem4Click(Sender: TObject); 972 | begin 973 | imgWSAClick(Self); 974 | end; 975 | 976 | procedure TWinDroidHwnd.PopupMenu1Popup(Sender: TObject); 977 | var 978 | LItem: TListViewItem; 979 | begin 980 | MenuItem1.Enabled := Assigned(ListView1.Selected); 981 | if MenuItem1.Enabled then 982 | begin 983 | LItem := ListView1.Items[ListView1.Selected.Index]; 984 | MenuItem1.Text := 'Uninstall ' + LItem.Text; 985 | end; 986 | end; 987 | 988 | function TWinDroidHwnd.ReplaceAmazonAppstore: Boolean; 989 | begin 990 | //https://amazonadsi-a.akamaihd.net/public/ix/stable/default/us/Amazon_App.apk 991 | 992 | end; 993 | 994 | procedure TWinDroidHwnd.TrayIconClick(Sender: TObject); 995 | const 996 | ABE_NONE = -1; 997 | GAP = 0; 998 | var 999 | TaskbarMonitor: THandle; 1000 | TaskbarRect: TRect; 1001 | AMonitor: HMonitor; 1002 | MonInfo: MONITORINFO; 1003 | CurPos: TPoint; 1004 | LeftGap: Integer; 1005 | TopGap: Integer; 1006 | begin 1007 | TaskbarMonitor := Winapi.Windows.FindWindow('Shell_TrayWnd', nil); 1008 | GetCursorPos(CurPos); 1009 | LeftGap := Width - ClientWidth; 1010 | Layout1.Position.Y := 0; 1011 | TopGap := Height - Round(Layout1.Height) - 5; 1012 | if TaskbarMonitor <> 0 then 1013 | begin 1014 | AMonitor := Winapi.MultiMon.MonitorFromWindow(TaskbarMonitor, MONITOR_DEFAULTTOPRIMARY); 1015 | MonInfo.cbSize := SizeOf(MONITORINFO); 1016 | GetMonitorInfo(AMonitor, @MonInfo); 1017 | GetWindowRect(TaskbarMonitor, TaskbarRect); 1018 | case GetMainTaskbarPosition of 1019 | ABE_LEFT: begin 1020 | Left := MonInfo.rcMonitor.Left + TaskbarRect.Width + GAP - LeftGap div 2; 1021 | Top := CurPos.Y - Height div 2; 1022 | end; 1023 | ABE_TOP: begin 1024 | Left := MonInfo.rcMonitor.Left + MonInfo.rcMonitor.Width - Width - GAP + LeftGap; 1025 | Top := MonInfo.rcMonitor.Top + TaskbarRect.Height + GAP - TopGap; 1026 | end; 1027 | ABE_RIGHT: begin 1028 | Left := MonInfo.rcMonitor.Left + MonInfo.rcMonitor.Width - TaskbarRect.Width - Width - GAP + LeftGap div 2; 1029 | Top := CurPos.Y - Height div 2; 1030 | end; 1031 | ABE_BOTTOM: begin 1032 | Left := MonInfo.rcMonitor.Left + MonInfo.rcMonitor.Width - Width - GAP + LeftGap; 1033 | Top := MonInfo.rcMonitor.Top + MonInfo.rcMonitor.Height - TaskbarRect.Height - Height - GAP + TopGap; 1034 | if not Visible then 1035 | Layout1.Position.X := Width 1036 | else 1037 | Layout1.Position.X := 0; 1038 | end; 1039 | ABE_NONE: begin 1040 | //Position := poScreenCenter; 1041 | end; 1042 | end; 1043 | end; 1044 | 1045 | WindowState := TWindowState.wsNormal; 1046 | //SetForegroundWindow(Handle); 1047 | if not Visible then 1048 | begin 1049 | if WindowState = TWindowState.wsMinimized then 1050 | WindowState := TWindowState.wsNormal; 1051 | FloatAnimation2.Stop; 1052 | FloatAnimation2.Enabled := False; 1053 | FloatAnimation1.Enabled := True 1054 | end 1055 | else 1056 | begin 1057 | FloatAnimation1.Stop; 1058 | FloatAnimation1.Enabled := False; 1059 | FloatAnimation2.Stop; 1060 | FloatAnimation2.Enabled := True; 1061 | end; 1062 | end; 1063 | 1064 | procedure TWinDroidHwnd.TrayIconExit(Sender: TObject); 1065 | begin 1066 | Close; 1067 | end; 1068 | 1069 | //procedure TWinDroidHwnd.WndMethod(var Msg: TMessage); 1070 | //begin 1071 | // if Msg.Msg = WM_TOGGLEFULLSCREEN then 1072 | // begin 1073 | // OutputDebugString('F11 WndMethod EVENT'); 1074 | // WinDroidHwnd.lbWSAVersion.Text := 'F11 ' + inttoStr(Random(100)); 1075 | // end; 1076 | //end; 1077 | 1078 | { TDownloader } 1079 | 1080 | procedure TDownloader.AbortDownload; 1081 | begin 1082 | if FDownloading then 1083 | FAbortNow := True; 1084 | end; 1085 | 1086 | constructor TDownloader.Create; 1087 | begin 1088 | inherited; 1089 | FDownloading := False; 1090 | FAbortNow := False; 1091 | FAborted := False; 1092 | 1093 | FClient := THTTPClient.Create; 1094 | FClient.OnReceiveData := DoReceiveDataEvent; 1095 | 1096 | FValue := 0; 1097 | 1098 | end; 1099 | 1100 | destructor TDownloader.Destroy; 1101 | begin 1102 | FClient.Free; 1103 | FDownloaderStream.Free; 1104 | 1105 | inherited; 1106 | end; 1107 | 1108 | procedure TDownloader.DoEndDownload(const AsyncResult: IAsyncResult); 1109 | var 1110 | LResponse: IHTTPResponse; 1111 | begin 1112 | try 1113 | LResponse := THTTPClient.EndAsyncHTTP(AsyncResult); 1114 | TThread.Synchronize(nil, 1115 | procedure 1116 | begin 1117 | if LResponse.StatusCode = 200 then 1118 | begin 1119 | if FAborted then 1120 | begin 1121 | FAborted := False; 1122 | FOnDownloaded(Self, 209) // Let's consider 209 as aborted successfully 1123 | end 1124 | else 1125 | FOnDownloaded(Self, 200); 1126 | end 1127 | else 1128 | begin 1129 | // some other error has occurred 1130 | FOnDownloaded(Self, LResponse.StatusCode); 1131 | end; 1132 | FDownloading := False; 1133 | end 1134 | ); 1135 | finally 1136 | LResponse := nil; 1137 | FreeAndNil(FDownloaderStream); 1138 | // Show success or something 1139 | end; 1140 | end; 1141 | 1142 | procedure TDownloader.DoReceiveDataEvent(const Sender: TObject; AContentLength, 1143 | AReadCount: Int64; var Abort: Boolean); 1144 | var 1145 | LTime: Cardinal; 1146 | LSpeed: Integer; 1147 | begin 1148 | if FAbortNow then 1149 | begin 1150 | Abort := True; 1151 | FAbortNow := False; 1152 | FAborted := True; 1153 | end; 1154 | LTime := TThread.GetTickCount - FGlobalStart; 1155 | LSpeed := (AReadCount * 1000) div LTime; 1156 | TThread.Queue(nil, 1157 | procedure 1158 | begin 1159 | FValue := Round(100 / FSize * AReadCount); 1160 | // FStatus := Format('%d KB/s', [LSpeed div 1024]); 1161 | end 1162 | ); 1163 | end; 1164 | 1165 | procedure TDownloader.DoStartDownload; 1166 | var 1167 | LResponse: IHTTPResponse; 1168 | begin 1169 | if FDownloading then 1170 | begin 1171 | raise Exception.Create('Already downloading, stop first!'); 1172 | Exit; 1173 | end; 1174 | try 1175 | LResponse := FClient.Head(FURL); 1176 | FSize := LResponse.ContentLength; 1177 | LResponse := nil; 1178 | FValue := 0; 1179 | FDownloaderStream := TFileStream.Create(FSavePath, fmCreate); 1180 | FDownloaderStream.Position := 0; 1181 | 1182 | FGlobalStart := TThread.GetTickCount; 1183 | 1184 | FDownloading := True; 1185 | FClient.CustomHeaders['Connection'] := 'close'; // to close connection afterwards 1186 | FAsyncResult := FClient.BeginGet(DoEndDownload, FURL, FDownloaderStream); 1187 | finally 1188 | FAsyncResult := nil; 1189 | end; 1190 | end; 1191 | 1192 | procedure TDownloader.SetValue(const Value: byte); 1193 | begin 1194 | if Value <> FValue then 1195 | if Value <= 100 then 1196 | begin 1197 | FValue := Value; 1198 | // 1199 | end; 1200 | end; 1201 | 1202 | initialization 1203 | CoInitialize(nil); 1204 | WndProcHook := 0; 1205 | WndProcHook := SetWindowsHookEx(WH_CALLWNDPROCRET, @WndProc, 0, GetCurrentThreadId); 1206 | if WndProcHook = 0 then 1207 | raise Exception.Create('Couldn''t create secondary Window Proc'); 1208 | finalization 1209 | UnhookWindowsHookEx(WndProcHook); 1210 | CoUninitialize; 1211 | 1212 | end. 1213 | --------------------------------------------------------------------------------