├── Examples ├── MouseTest │ ├── Main.dfm │ ├── Main.pas │ └── MouseTest.dpr ├── PingGoogle │ ├── PingGoogle.dpr │ ├── PingGoogle.dproj │ └── PingGoogle.exe └── WindowsFlip │ ├── Readme.txt │ ├── WindowsFlip.dpr │ ├── WindowsFlip.dproj │ └── WindowsFlip.exe ├── README.md └── SendInputHelper.pas /Examples/MouseTest/Main.dfm: -------------------------------------------------------------------------------- 1 | object MainForm: TMainForm 2 | Left = 0 3 | Top = 0 4 | Caption = 'MainForm' 5 | ClientHeight = 411 6 | ClientWidth = 852 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 | PixelsPerInch = 96 15 | TextHeight = 13 16 | object RelativeClickTestButton: TButton 17 | Left = 184 18 | Top = 72 19 | Width = 137 20 | Height = 33 21 | Caption = 'Click here (relative)' 22 | TabOrder = 0 23 | OnClick = RelativeClickTestButtonClick 24 | end 25 | object TargetTestClickButton: TButton 26 | Left = 352 27 | Top = 72 28 | Width = 393 29 | Height = 249 30 | Caption = 'Not here' 31 | TabOrder = 1 32 | OnClick = TargetTestClickButtonClick 33 | end 34 | object AbsoluteClickTestButton: TButton 35 | Left = 184 36 | Top = 128 37 | Width = 137 38 | Height = 33 39 | Caption = 'Click here (absolute)' 40 | TabOrder = 2 41 | OnClick = AbsoluteClickTestButtonClick 42 | end 43 | end 44 | -------------------------------------------------------------------------------- /Examples/MouseTest/Main.pas: -------------------------------------------------------------------------------- 1 | unit Main; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, 7 | Winapi.Messages, 8 | System.SysUtils, 9 | System.Variants, 10 | System.Classes, 11 | System.UITypes, 12 | Vcl.Graphics, 13 | Vcl.Controls, 14 | Vcl.Forms, 15 | Vcl.Dialogs, 16 | Vcl.StdCtrls, 17 | 18 | SendInputHelper; 19 | 20 | type 21 | TMainForm = class(TForm) 22 | RelativeClickTestButton: TButton; 23 | TargetTestClickButton: TButton; 24 | AbsoluteClickTestButton: TButton; 25 | procedure TargetTestClickButtonClick(Sender: TObject); 26 | procedure RelativeClickTestButtonClick(Sender: TObject); 27 | procedure AbsoluteClickTestButtonClick(Sender: TObject); 28 | private 29 | SIH: TSendInputHelper; 30 | public 31 | { Public-Deklarationen } 32 | end; 33 | 34 | var 35 | MainForm: TMainForm; 36 | 37 | implementation 38 | 39 | {$R *.dfm} 40 | 41 | procedure TMainForm.RelativeClickTestButtonClick(Sender: TObject); 42 | begin 43 | if not Assigned(SIH) then 44 | SIH := TSendInputHelper.Create; 45 | 46 | SIH.AddRelativeMouseMove(100, 80); 47 | SIH.AddMouseClick(mbLeft); 48 | SIH.Flush; 49 | end; 50 | 51 | procedure TMainForm.AbsoluteClickTestButtonClick(Sender: TObject); 52 | var 53 | TargetPos: TPoint; 54 | begin 55 | if not Assigned(SIH) then 56 | SIH := TSendInputHelper.Create; 57 | 58 | TargetPos := TargetTestClickButton.BoundsRect.Location; 59 | TargetPos.X := TargetPos.X + (TargetTestClickButton.Width div 2); 60 | TargetPos.Y := TargetPos.Y + (TargetTestClickButton.Height div 2); 61 | TargetPos := ClientToScreen(TargetPos); 62 | 63 | SIH.AddAbsoluteMouseMove(TargetPos.X, TargetPos.Y); 64 | SIH.AddMouseClick(mbLeft); 65 | SIH.Flush; 66 | end; 67 | 68 | procedure TMainForm.TargetTestClickButtonClick(Sender: TObject); 69 | begin 70 | if Assigned(SIH) then 71 | begin 72 | ShowMessage('Yeah it has clicked through TSendInputHelper!'); 73 | FreeAndNil(SIH); 74 | end 75 | else 76 | ShowMessage('You should not click here manually'); 77 | end; 78 | 79 | end. 80 | -------------------------------------------------------------------------------- /Examples/MouseTest/MouseTest.dpr: -------------------------------------------------------------------------------- 1 | program MouseTest; 2 | 3 | uses 4 | Vcl.Forms, 5 | Main in 'Main.pas' {MainForm}, 6 | SendInputHelper in '..\..\SendInputHelper.pas'; 7 | 8 | {$R *.res} 9 | 10 | begin 11 | Application.Initialize; 12 | Application.MainFormOnTaskbar := True; 13 | Application.CreateForm(TMainForm, MainForm); 14 | Application.Run; 15 | end. 16 | -------------------------------------------------------------------------------- /Examples/PingGoogle/PingGoogle.dpr: -------------------------------------------------------------------------------- 1 | program PingGoogle; 2 | 3 | {$APPTYPE CONSOLE} 4 | 5 | uses 6 | SysUtils, 7 | Windows, 8 | SendInputHelper in '..\..\SendInputHelper.pas'; 9 | 10 | procedure Main; 11 | var 12 | SIH: TSendInputHelper; 13 | 14 | procedure SwitchWithTab; 15 | begin 16 | SIH.AddShift([ssAlt], True, False); 17 | SIH.AddDelay(50); 18 | SIH.AddVirtualKey(VK_TAB, True, False); 19 | SIH.AddDelay(50); 20 | SIH.AddVirtualKey(VK_TAB, False, True); 21 | SIH.AddShift([ssAlt], False, True); 22 | SIH.AddDelay(50); 23 | end; 24 | 25 | procedure SendLine(Line: string; Delay: Integer = 100); 26 | begin 27 | SIH.AddText(Line, True); 28 | SwitchWithTab; 29 | SIH.AddText(Line, True); 30 | SwitchWithTab; 31 | SIH.AddDelay(Delay); 32 | SIH.Flush; 33 | end; 34 | 35 | function IsWin7OrAbove: Boolean; 36 | begin 37 | Result := ((Win32MajorVersion * 1000) + Win32MinorVersion) >= 6001; 38 | end; 39 | begin 40 | Writeln('A command shell and a notepad-instance will be launched [ENTER]'); 41 | Readln; 42 | 43 | SIH := TSendInputHelper.Create; 44 | try 45 | // Start command shell 46 | SIH.AddShortCut([ssWin], 'r'); 47 | SIH.AddDelay(100); 48 | SIH.AddText('cmd', True); 49 | SIH.AddDelay(500); 50 | // Align on the left screen side (shortcut available since Win 7) 51 | if IsWin7OrAbove then 52 | begin 53 | SIH.AddShortCut([ssWin], VK_LEFT); 54 | SIH.AddDelay(150); 55 | end; 56 | 57 | // Start notepad 58 | SIH.AddShortCut([ssWin], 'r'); 59 | SIH.AddDelay(100); 60 | SIH.AddText('notepad', True); 61 | SIH.AddDelay(500); 62 | // Align on the right screen side (shortcut available since Win 7) 63 | if IsWin7OrAbove then 64 | begin 65 | SIH.AddShortCut([ssWin], VK_RIGHT); 66 | SIH.AddDelay(150); 67 | end; 68 | 69 | SIH.Flush; 70 | 71 | SendLine('cls'); 72 | SendLine('ping google.de', 1000); 73 | SendLine('ping gmail.com', 1000); 74 | 75 | // Some self promo ;-) 76 | SIH.AddVirtualKey(VK_RETURN); 77 | SIH.AddText('This is a example, how it can be easy', True); 78 | SIH.AddDelay(100); 79 | SIH.AddText('to use the Windows.SendInput-API. ', True); 80 | SIH.AddVirtualKey(VK_RETURN); 81 | SIH.AddText('Test of Unicode: '); 82 | SIH.AddText('Привет! Cześć! 你好! !שלום éèáà', True); 83 | SIH.AddDelay(100); 84 | SIH.AddVirtualKey(VK_RETURN); 85 | SIH.AddText('Simplified by the SendInputHelper (Unit for Delphi):', True); 86 | SIH.AddDelay(100); 87 | SIH.AddText('https://github.com/WladiD/SendInputHelper'); 88 | 89 | SIH.Flush; 90 | finally 91 | SIH.Free; 92 | end; 93 | 94 | WriteLn('All keystrokes was flushed. Press [Enter] to exit.'); 95 | Readln; 96 | end; 97 | 98 | begin 99 | try 100 | Main; 101 | except 102 | on E:Exception do 103 | Writeln(E.ClassName, ': ', E.Message); 104 | end; 105 | end. 106 | -------------------------------------------------------------------------------- /Examples/PingGoogle/PingGoogle.dproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {3E1FBF96-AB19-4727-B233-F75A648E1F20} 4 | 18.4 5 | PingGoogle.dpr 6 | Debug 7 | DCC32 8 | None 9 | True 10 | Win32 11 | 1 12 | Console 13 | 14 | 15 | true 16 | 17 | 18 | true 19 | Base 20 | true 21 | 22 | 23 | true 24 | Base 25 | true 26 | 27 | 28 | true 29 | Base 30 | true 31 | 32 | 33 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 34 | 1031 35 | $(BDS)\bin\delphi_PROJECTICNS.icns 36 | PingGoogle 37 | System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace) 38 | $(BDS)\bin\delphi_PROJECTICON.ico 39 | PingGoogle.exe 40 | 00400000 41 | x86 42 | false 43 | false 44 | false 45 | false 46 | false 47 | 48 | 49 | 1033 50 | System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 51 | 52 | 53 | false 54 | RELEASE;$(DCC_Define) 55 | 0 56 | 0 57 | 58 | 59 | DEBUG;$(DCC_Define) 60 | 61 | 62 | 63 | MainSource 64 | 65 | 66 | 67 | Cfg_2 68 | Base 69 | 70 | 71 | Base 72 | 73 | 74 | Cfg_1 75 | Base 76 | 77 | 78 | 79 | 80 | Delphi.Personality.12 81 | 82 | 83 | 84 | 85 | PingGoogle.dpr 86 | 87 | 88 | False 89 | True 90 | False 91 | 92 | 93 | False 94 | False 95 | 1 96 | 0 97 | 0 98 | 0 99 | False 100 | False 101 | False 102 | False 103 | False 104 | 1031 105 | 1252 106 | 107 | 108 | 109 | 110 | 1.0.0.0 111 | 112 | 113 | 114 | 115 | 116 | 1.0.0.0 117 | 118 | 119 | 120 | 121 | False 122 | True 123 | 124 | 125 | 12 126 | 127 | 128 | 129 | -------------------------------------------------------------------------------- /Examples/PingGoogle/PingGoogle.exe: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/WladiD/SendInputHelper/3dfa2e8d7eac0d32cbf74e9c3519dc5c40478449/Examples/PingGoogle/PingGoogle.exe -------------------------------------------------------------------------------- /Examples/WindowsFlip/Readme.txt: -------------------------------------------------------------------------------- 1 | This example flip through the opened windows using shortcuts [Win] + [Tab] 2 | for 2 seconds. 3 | Windows Flip 3D is available since Windows Vista and must be activated, to 4 | get this examlpe working. -------------------------------------------------------------------------------- /Examples/WindowsFlip/WindowsFlip.dpr: -------------------------------------------------------------------------------- 1 | program WindowsFlip; 2 | 3 | {$APPTYPE CONSOLE} 4 | 5 | uses 6 | SysUtils, 7 | Windows, 8 | SendInputHelper in '..\..\SendInputHelper.pas'; 9 | 10 | procedure Main; 11 | var 12 | cc: Integer; 13 | SIH: TSendInputHelper; 14 | begin 15 | SIH := TSendInputHelper.Create; 16 | try 17 | SIH.AddShift([ssWin], True, False); 18 | for cc := 1 to 20 do 19 | begin 20 | SIH.AddVirtualKey(VK_TAB, True, False); 21 | SIH.AddDelay(100); 22 | end; 23 | SIH.AddVirtualKey(VK_TAB, False, True); 24 | SIH.AddVirtualKey(VK_ESCAPE); 25 | SIH.AddShift([ssWin], False, True); 26 | SIH.Flush; 27 | finally 28 | SIH.Free; 29 | end; 30 | end; 31 | 32 | begin 33 | try 34 | Main; 35 | except 36 | on E: Exception do 37 | Writeln(E.ClassName, ': ', E.Message); 38 | end; 39 | 40 | end. 41 | -------------------------------------------------------------------------------- /Examples/WindowsFlip/WindowsFlip.dproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {7E5F7F56-A852-4464-A8BB-93C33A585F39} 4 | 18.1 5 | WindowsFlip.dpr 6 | Debug 7 | DCC32 8 | None 9 | True 10 | Win32 11 | 1 12 | Console 13 | 14 | 15 | true 16 | 17 | 18 | true 19 | Base 20 | true 21 | 22 | 23 | true 24 | Base 25 | true 26 | 27 | 28 | true 29 | Base 30 | true 31 | 32 | 33 | true 34 | Base 35 | true 36 | 37 | 38 | true 39 | Base 40 | true 41 | 42 | 43 | true 44 | Base 45 | true 46 | 47 | 48 | true 49 | Base 50 | true 51 | 52 | 53 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 54 | 1031 55 | $(BDS)\bin\delphi_PROJECTICNS.icns 56 | WindowsFlip 57 | System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace) 58 | $(BDS)\bin\delphi_PROJECTICON.ico 59 | WindowsFlip.exe 60 | 00400000 61 | x86 62 | false 63 | false 64 | false 65 | false 66 | false 67 | 68 | 69 | $(BDS)\bin\Artwork\Android\FM_LauncherIcon_144x144.png 70 | $(BDS)\bin\Artwork\Android\FM_LauncherIcon_72x72.png 71 | true 72 | $(BDS)\bin\Artwork\Android\FM_SplashImage_426x320.png 73 | true 74 | true 75 | true 76 | true 77 | true 78 | $(BDS)\bin\Artwork\Android\FM_SplashImage_470x320.png 79 | $(BDS)\bin\Artwork\Android\FM_SplashImage_640x480.png 80 | true 81 | $(BDS)\bin\Artwork\Android\FM_LauncherIcon_96x96.png 82 | true 83 | $(BDS)\bin\Artwork\Android\FM_LauncherIcon_48x48.png 84 | $(BDS)\bin\Artwork\Android\FM_LauncherIcon_36x36.png 85 | $(BDS)\bin\Artwork\Android\FM_SplashImage_960x720.png 86 | true 87 | true 88 | 89 | 90 | $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImagePortrait_1536x2048.png 91 | $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImageLandscape_2048x1536.png 92 | $(BDS)\bin\Artwork\iOS\iPhone\FM_SpotlightSearchIcon_80x80.png 93 | $(BDS)\bin\Artwork\iOS\iPad\FM_ApplicationIcon_152x152.png 94 | $(BDS)\bin\Artwork\iOS\iPhone\FM_SpotlightSearchIcon_40x40.png 95 | $(BDS)\bin\Artwork\iOS\iPad\FM_ApplicationIcon_76x76.png 96 | $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImagePortrait_768x1024.png 97 | $(BDS)\bin\Artwork\iOS\iPad\FM_SpotlightSearchIcon_40x40.png 98 | $(BDS)\bin\Artwork\iOS\iPad\FM_SpotlightSearchIcon_80x80.png 99 | $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImageLandscape_1024x768.png 100 | $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_120x120.png 101 | $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_60x60.png 102 | 103 | 104 | $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImagePortrait_1536x2048.png 105 | $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImageLandscape_2048x1536.png 106 | $(BDS)\bin\Artwork\iOS\iPhone\FM_SpotlightSearchIcon_80x80.png 107 | $(BDS)\bin\Artwork\iOS\iPad\FM_ApplicationIcon_152x152.png 108 | $(BDS)\bin\Artwork\iOS\iPhone\FM_SpotlightSearchIcon_40x40.png 109 | $(BDS)\bin\Artwork\iOS\iPad\FM_ApplicationIcon_76x76.png 110 | $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImagePortrait_768x1024.png 111 | $(BDS)\bin\Artwork\iOS\iPad\FM_SpotlightSearchIcon_40x40.png 112 | $(BDS)\bin\Artwork\iOS\iPad\FM_SpotlightSearchIcon_80x80.png 113 | $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImageLandscape_1024x768.png 114 | $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_120x120.png 115 | $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_60x60.png 116 | 117 | 118 | $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImagePortrait_1536x2048.png 119 | $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImageLandscape_2048x1536.png 120 | $(BDS)\bin\Artwork\iOS\iPhone\FM_SpotlightSearchIcon_80x80.png 121 | $(BDS)\bin\Artwork\iOS\iPad\FM_ApplicationIcon_152x152.png 122 | $(BDS)\bin\Artwork\iOS\iPhone\FM_SpotlightSearchIcon_40x40.png 123 | $(BDS)\bin\Artwork\iOS\iPad\FM_ApplicationIcon_76x76.png 124 | $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImagePortrait_768x1024.png 125 | $(BDS)\bin\Artwork\iOS\iPad\FM_SpotlightSearchIcon_40x40.png 126 | $(BDS)\bin\Artwork\iOS\iPad\FM_SpotlightSearchIcon_80x80.png 127 | $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImageLandscape_1024x768.png 128 | $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_120x120.png 129 | $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_60x60.png 130 | 131 | 132 | 1033 133 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 134 | 135 | 136 | false 137 | RELEASE;$(DCC_Define) 138 | 0 139 | 0 140 | 141 | 142 | DEBUG;$(DCC_Define) 143 | 144 | 145 | 146 | MainSource 147 | 148 | 149 | 150 | Cfg_2 151 | Base 152 | 153 | 154 | Base 155 | 156 | 157 | Cfg_1 158 | Base 159 | 160 | 161 | 162 | 163 | Delphi.Personality.12 164 | 165 | 166 | 167 | 168 | WindowsFlip.dpr 169 | 170 | 171 | False 172 | True 173 | False 174 | 175 | 176 | False 177 | False 178 | 1 179 | 0 180 | 0 181 | 0 182 | False 183 | False 184 | False 185 | False 186 | False 187 | 1031 188 | 1252 189 | 190 | 191 | 192 | 193 | 1.0.0.0 194 | 195 | 196 | 197 | 198 | 199 | 1.0.0.0 200 | 201 | 202 | 203 | 204 | False 205 | False 206 | False 207 | False 208 | False 209 | True 210 | False 211 | 212 | 213 | 12 214 | 215 | 216 | 217 | -------------------------------------------------------------------------------- /Examples/WindowsFlip/WindowsFlip.exe: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/WladiD/SendInputHelper/3dfa2e8d7eac0d32cbf74e9c3519dc5c40478449/Examples/WindowsFlip/WindowsFlip.exe -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # SendInputHelper 2 | SendInputHelper is a unit for Delphi, that contains a class for simple and safe usage 3 | for the SendInput-API of Windows. With it you can pass any chars, strings, "shift"-keys 4 | and shortcuts as regular keyboard strokes. 5 | 6 | ## Example 7 | ```delphi 8 | uses 9 | ..., SendInputHelper; 10 | 11 | procedure TForm1.Button1Click(Sender: TObject); 12 | var 13 | SIH: TSendInputHelper; 14 | begin 15 | SIH := TSendInputHelper.Create; 16 | try 17 | // Start command shell 18 | SIH.AddShortCut([ssWin], 'r'); // Win+R 19 | SIH.AddDelay(100); 20 | SIH.AddText('cmd', True); // Second parameter True means AppendReturn 21 | SIH.AddDelay(500); 22 | 23 | SIH.AddText('ping google.de', True); // Perform a ping. 24 | 25 | SIH.Flush; // Isn't it easy? 26 | finally 27 | SIH.Free; 28 | end; 29 | end; 30 | ``` 31 | -------------------------------------------------------------------------------- /SendInputHelper.pas: -------------------------------------------------------------------------------- 1 | // License 2 | // 3 | // The contents of this file are subject to the Mozilla Public License 4 | // Version 1.1 (the "License"); you may not use this file except in 5 | // compliance with the License. You may obtain a copy of the License at 6 | // http://www.mozilla.org/MPL/ 7 | // 8 | // Software distributed under the License is distributed on an "AS IS" 9 | // basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the 10 | // License for the specific language governing rights and limitations 11 | // under the License. 12 | // 13 | // The Original Code is SendInputHelper.pas. 14 | // 15 | // The Initial Developer of the Original Code is Waldemar Derr. 16 | // Portions created by Waldemar Derr are Copyright (C) Waldemar Derr. 17 | // All Rights Reserved. 18 | // 19 | // 20 | // Acknowledgements 21 | // 22 | // - Thanks to Marco Warm for his code suggest to support any unicode chars 23 | // 24 | // - Thanks to PeterPanino for his bug fix 25 | // 26 | // 27 | // @author Waldemar Derr 28 | 29 | unit SendInputHelper; 30 | 31 | interface 32 | 33 | uses 34 | System.SysUtils, 35 | System.Classes, 36 | System.UITypes, 37 | Vcl.Controls, 38 | Vcl.Forms, 39 | Generics.Collections, 40 | Winapi.Windows; 41 | 42 | type 43 | TInputArray = array of TInput; 44 | 45 | // Local ShiftState type, with the supported subset and the new ssWin entry 46 | TSIHShiftState = set of ( 47 | ssShift = Ord(System.Classes.ssShift), 48 | ssAlt = Ord(System.Classes.ssAlt), 49 | ssCtrl = Ord(System.Classes.ssCtrl), 50 | ssWin = 32); 51 | 52 | TSendInputHelper = class(TList) 53 | protected 54 | class function MergeInputs(InputsBatch: array of TInputArray): TInputArray; 55 | public 56 | class function ConvertShiftState(ClassesShiftState: System.Classes.TShiftState): TSIHShiftState; 57 | class function GetKeyboardInput(VirtualKey, ScanCode: Word; Flags, Time: Cardinal): TInput; 58 | class function GetVirtualKey(VirtualKey: Word; Press, Release: Boolean): TInputArray; 59 | class function GetShift(ShiftState: TSIHShiftState; Press, Release: Boolean): TInputArray; 60 | class function GetChar(SendChar: Char; Press, Release: Boolean): TInputArray; 61 | class function GetUnicodeChar(SendChar: Char; Press, Release: Boolean): TInputArray; 62 | class function GetText(SendText: string; AppendReturn: Boolean): TInputArray; 63 | class function GetShortCut(ShiftState: TSIHShiftState; ShortChar: Char): TInputArray; overload; 64 | class function GetShortCut(ShiftState: TSIHShiftState; ShortVK: Word): TInputArray; overload; 65 | 66 | class function GetMouseInput(X, Y: Integer; MouseData, Flags, Time: DWORD): TInput; 67 | class function GetMouseClick(MouseButton: TMouseButton; Press, Release: Boolean): TInputArray; 68 | class function GetRelativeMouseMove(DeltaX, DeltaY: Integer): TInputArray; 69 | class function GetAbsoluteMouseMove(X, Y: Integer; DesktopCoordinates: Boolean): TInputArray; 70 | 71 | class function IsVirtualKeyPressed(VirtualKey: Word): Boolean; 72 | 73 | procedure AddKeyboardInput(VirtualKey, ScanCode: Word; Flags, Time: Cardinal); 74 | procedure AddVirtualKey(VirtualKey: Word; Press: Boolean = True; Release: Boolean = True); 75 | 76 | procedure AddShift(ShiftState: TSIHShiftState; Press, Release: Boolean); overload; 77 | procedure AddShift(ShiftState: System.Classes.TShiftState; Press, Release: Boolean); overload; 78 | procedure AddShortCut(ShiftState: TSIHShiftState; ShortChar: Char); overload; 79 | procedure AddShortCut(ShiftState: TSIHShiftState; ShortVK: Word); overload; 80 | procedure AddShortCut(ShiftState: System.Classes.TShiftState; ShortChar: Char); overload; 81 | procedure AddShortCut(ShiftState: System.Classes.TShiftState; ShortVK: Word); overload; 82 | procedure AddChar(SendChar: Char; Press: Boolean = True; Release: Boolean = True); 83 | procedure AddText(SendText: string; AppendReturn: Boolean = False); 84 | 85 | procedure AddMouseClick(MouseButton: TMouseButton; Press: Boolean = True; Release: Boolean = True); 86 | procedure AddRelativeMouseMove(DeltaX, DeltaY: Integer); 87 | procedure AddAbsoluteMouseMove(X, Y: Integer; DesktopCoordinates: Boolean = True); 88 | 89 | procedure AddDelay(Milliseconds: Cardinal); 90 | 91 | function GetInputArray: TInputArray; 92 | procedure Flush; 93 | end; 94 | 95 | // Declaration in Windows.pas (until Delphi 2010) is corrupted, this one is correct: 96 | function SendInput(cInputs: Cardinal; pInputs: TInputArray; cbSize: Integer): Cardinal; stdcall; 97 | 98 | implementation 99 | 100 | const 101 | // This constant is used as a fake input type for a delay 102 | // 103 | // @see AddDelay and Flush 104 | INPUT_DELAY = INPUT_HARDWARE + 1; 105 | 106 | // Missing constant in Windows.pas until D2010 107 | KEYEVENTF_UNICODE = 4; 108 | 109 | function SendInput; external user32 name 'SendInput'; 110 | 111 | { TSendInputHelper } 112 | 113 | // Add inputs, that are required to produce the passed char 114 | // 115 | // @see GetChar 116 | procedure TSendInputHelper.AddChar(SendChar: Char; Press, Release: Boolean); 117 | var 118 | Inputs: TInputArray; 119 | begin 120 | Inputs := GetChar(SendChar, Press, Release); 121 | if Assigned(Inputs) then 122 | AddRange(Inputs); 123 | end; 124 | 125 | procedure TSendInputHelper.AddMouseClick(MouseButton: TMouseButton; Press, Release: Boolean); 126 | var 127 | Inputs: TInputArray; 128 | begin 129 | Inputs := GetMouseClick(MouseButton, Press, Release); 130 | if Assigned(Inputs) then 131 | AddRange(Inputs); 132 | end; 133 | 134 | procedure TSendInputHelper.AddRelativeMouseMove(DeltaX, DeltaY: Integer); 135 | var 136 | Inputs: TInputArray; 137 | begin 138 | Inputs := GetRelativeMouseMove(DeltaX, DeltaY); 139 | if Assigned(Inputs) then 140 | AddRange(Inputs); 141 | end; 142 | 143 | procedure TSendInputHelper.AddAbsoluteMouseMove(X, Y: Integer; DesktopCoordinates: Boolean); 144 | var 145 | Inputs: TInputArray; 146 | begin 147 | Inputs := GetAbsoluteMouseMove(X, Y, DesktopCoordinates); 148 | if Assigned(Inputs) then 149 | AddRange(Inputs); 150 | end; 151 | 152 | // Add a delay for passed milliseconds 153 | // 154 | // This is not a part of the SendInput call, but a extension from this class and is exclusively 155 | // supported by using the Flush method. 156 | // 157 | // @see Flush 158 | procedure TSendInputHelper.AddDelay(Milliseconds: Cardinal); 159 | var 160 | DelayInput: TInput; 161 | begin 162 | DelayInput.Itype := INPUT_DELAY; 163 | DelayInput.ki.time := Milliseconds; 164 | Add(DelayInput); 165 | end; 166 | 167 | // Add a single keyboard input 168 | // 169 | // @see GetKeyboardInput 170 | procedure TSendInputHelper.AddKeyboardInput(VirtualKey, ScanCode: Word; Flags, Time: Cardinal); 171 | begin 172 | Add(GetKeyboardInput(VirtualKey, ScanCode, Flags, Time)); 173 | end; 174 | 175 | // Add combined "Shift" keys input, this are Ctrl, Alt, Win or the Shift key 176 | // 177 | // @see GetShift 178 | procedure TSendInputHelper.AddShift(ShiftState: TSIHShiftState; Press, Release: Boolean); 179 | var 180 | Inputs: TInputArray; 181 | begin 182 | Inputs := GetShift(ShiftState, Press, Release); 183 | if Assigned(Inputs) then 184 | AddRange(Inputs); 185 | end; 186 | 187 | procedure TSendInputHelper.AddShift(ShiftState: System.Classes.TShiftState; 188 | Press, Release: Boolean); 189 | begin 190 | AddShift(ConvertShiftState(ShiftState), Press, Release); 191 | end; 192 | 193 | // Add required keyboard inputs, to produce a regular keyboard short cut 194 | // 195 | // @see GetShortCut 196 | procedure TSendInputHelper.AddShortCut(ShiftState: TSIHShiftState; ShortVK: Word); 197 | var 198 | Inputs: TInputArray; 199 | begin 200 | Inputs := GetShortCut(ShiftState, ShortVK); 201 | if Assigned(Inputs) then 202 | AddRange(Inputs); 203 | end; 204 | 205 | procedure TSendInputHelper.AddShortCut(ShiftState: TSIHShiftState; ShortChar: Char); 206 | var 207 | Inputs: TInputArray; 208 | begin 209 | Inputs := GetShortCut(ShiftState, ShortChar); 210 | if Assigned(Inputs) then 211 | AddRange(Inputs); 212 | end; 213 | 214 | procedure TSendInputHelper.AddShortCut(ShiftState: System.Classes.TShiftState; ShortChar: Char); 215 | begin 216 | AddShortCut(ConvertShiftState(ShiftState), ShortChar); 217 | end; 218 | 219 | procedure TSendInputHelper.AddShortCut(ShiftState: System.Classes.TShiftState; ShortVK: Word); 220 | begin 221 | AddShortCut(ConvertShiftState(ShiftState), ShortVK); 222 | end; 223 | 224 | // Add keyboard strokes, to produce the passed string 225 | // 226 | // @see GetText 227 | procedure TSendInputHelper.AddText(SendText: string; AppendReturn: Boolean); 228 | var 229 | Inputs: TInputArray; 230 | begin 231 | Inputs := GetText(SendText, AppendReturn); 232 | if Assigned(Inputs) then 233 | AddRange(Inputs); 234 | end; 235 | 236 | // Add (optional) a press or release keyboard input for the passed VirtualKey 237 | // 238 | // @see GetVirtualKey 239 | procedure TSendInputHelper.AddVirtualKey(VirtualKey: Word; Press, Release: Boolean); 240 | var 241 | Inputs: TInputArray; 242 | begin 243 | Inputs := GetVirtualKey(VirtualKey, Press, Release); 244 | if Assigned(Inputs) then 245 | AddRange(Inputs); 246 | end; 247 | 248 | class function TSendInputHelper.ConvertShiftState( 249 | ClassesShiftState: System.Classes.TShiftState): TSIHShiftState; 250 | begin 251 | Result := []; 252 | if System.Classes.ssShift in ClassesShiftState then 253 | Include(Result, ssShift); 254 | if System.Classes.ssAlt in ClassesShiftState then 255 | Include(Result, ssAlt); 256 | if System.Classes.ssCtrl in ClassesShiftState then 257 | Include(Result, ssCtrl); 258 | end; 259 | 260 | // Flushes all added inputs to SendInput 261 | // 262 | // This method is blocking for summarized milliseconds, if any delays are previously added 263 | // through AddDelay. 264 | // 265 | // After calling it, the list get cleared. 266 | procedure TSendInputHelper.Flush; 267 | var 268 | Input: TInput; 269 | Inputs: TInputArray; 270 | InputsCount: Cardinal; 271 | 272 | procedure LocalSendInput; 273 | begin 274 | if InputsCount > 0 then 275 | SendInput(InputsCount, Inputs, SizeOf(TInput)); 276 | end; 277 | 278 | begin 279 | if Count = 0 then 280 | Exit; 281 | 282 | // Neutralize the real current keyboard state 283 | if GetKeyState(VK_CAPITAL) = 1 then 284 | begin 285 | InsertRange(0, GetVirtualKey(VK_CAPITAL, True, True)); 286 | AddVirtualKey(VK_CAPITAL, True, True); 287 | end; 288 | 289 | InputsCount := 0; 290 | SetLength(Inputs, Count); 291 | for Input in Self do 292 | begin 293 | if Input.Itype = INPUT_DELAY then 294 | begin 295 | LocalSendInput; 296 | Sleep(Input.ki.time); 297 | InputsCount := 0; 298 | Continue; 299 | end; 300 | Inputs[InputsCount] := Input; 301 | Inc(InputsCount); 302 | end; 303 | LocalSendInput; 304 | Clear; 305 | end; 306 | 307 | class function TSendInputHelper.GetUnicodeChar(SendChar: Char; Press, Release: Boolean): TInputArray; 308 | var 309 | KeyDown, KeyUp: TInput; 310 | begin 311 | if not (Press or Release) then 312 | Exit(nil); 313 | 314 | KeyDown.Itype := INPUT_KEYBOARD; 315 | KeyDown.ki.wVk := 0; 316 | KeyDown.ki.wScan := Word(SendChar); 317 | KeyDown.ki.dwFlags := KEYEVENTF_UNICODE; 318 | KeyDown.ki.time := 0; 319 | KeyDown.ki.dwExtraInfo := GetMessageExtraInfo; 320 | 321 | SetLength(Result, Ord(Press) + Ord(Release)); 322 | 323 | if Press then 324 | Result[0] := KeyDown; 325 | if Release then 326 | begin 327 | KeyUp := KeyDown; 328 | KeyUp.ki.dwFlags := KeyUp.ki.dwFlags or KEYEVENTF_KEYUP; 329 | Result[Ord(Press)] := KeyUp; 330 | end; 331 | end; 332 | 333 | // Return a TInputArray with keyboard inputs, that are required to produce the passed char. 334 | class function TSendInputHelper.GetChar(SendChar: Char; Press, Release: Boolean): TInputArray; 335 | var 336 | ScanCode: Word; 337 | ShiftState: TSIHShiftState; 338 | PreShifts, Chars, AppShifts: TInputArray; 339 | begin 340 | if not (Press or Release) then 341 | Exit(nil); 342 | if not ((Ord(SendChar) > 0) and (Ord(SendChar) < 127)) then 343 | begin 344 | Result := GetUnicodeChar(SendChar, Press, Release); 345 | Exit; 346 | end; 347 | 348 | ScanCode := VkKeyScan(SendChar); 349 | PreShifts := nil; 350 | Chars := nil; 351 | AppShifts := nil; 352 | ShiftState := []; 353 | // Shift 354 | if (ScanCode and $100) <> 0 then 355 | Include(ShiftState, ssShift); 356 | // Control 357 | if (ScanCode and $200) <> 0 then 358 | Include(ShiftState, ssCtrl); 359 | // Alt 360 | if (ScanCode and $400) <> 0 then 361 | Include(ShiftState, ssAlt); 362 | 363 | Chars := GetVirtualKey(ScanCode, Press, Release); 364 | if Press then 365 | begin 366 | PreShifts := GetShift(ShiftState, True, False); 367 | AppShifts := GetShift(ShiftState, False, True); 368 | end; 369 | Result := MergeInputs([PreShifts, Chars, AppShifts]); 370 | end; 371 | 372 | // Return a TInputArray with all previously added inputs 373 | // 374 | // This is useful, when you plan to modify or process it further in your custom code. 375 | // 376 | // Notice, that the misused input entries, that are added by AddDelay, are included too, but are 377 | // not suitable for direct flush to SendInput. At best, don't use AddDelay if you use the returned 378 | // array by this method. 379 | function TSendInputHelper.GetInputArray: TInputArray; 380 | var 381 | Input: TInput; 382 | cc: Integer; 383 | begin 384 | SetLength(Result, Count); 385 | cc := 0; 386 | for Input in Self do 387 | begin 388 | Result[cc] := Input; 389 | Inc(cc); 390 | end; 391 | end; 392 | 393 | // Return a single keyboard input entry 394 | class function TSendInputHelper.GetKeyboardInput(VirtualKey, ScanCode: Word; Flags, 395 | Time: Cardinal): TInput; 396 | begin 397 | Result.Itype := INPUT_KEYBOARD; 398 | Result.ki.wVk := VirtualKey; 399 | Result.ki.wScan := ScanCode; 400 | Result.ki.dwFlags := Flags; 401 | Result.ki.time := Time; 402 | end; 403 | 404 | // Return combined TInputArray with "shift" keys input, this are Ctrl, Alt, Win or the Shift key 405 | class function TSendInputHelper.GetShift(ShiftState: TSIHShiftState; 406 | Press, Release: Boolean): TInputArray; 407 | var 408 | Shifts, Ctrls, Alts, Wins: TInputArray; 409 | begin 410 | if ssShift in ShiftState then 411 | Shifts := GetVirtualKey(VK_SHIFT, Press, Release) 412 | else 413 | Shifts := nil; 414 | 415 | if ssCtrl in ShiftState then 416 | Ctrls := GetVirtualKey(VK_CONTROL, Press, Release) 417 | else 418 | Ctrls := nil; 419 | 420 | if ssAlt in ShiftState then 421 | Alts := GetVirtualKey(VK_MENU, Press, Release) 422 | else 423 | Alts := nil; 424 | 425 | if ssWin in ShiftState then 426 | Wins := GetVirtualKey(VK_LWIN, Press, Release) 427 | else 428 | Wins := nil; 429 | 430 | Result := MergeInputs([Ctrls, Alts, Wins, Shifts]); 431 | end; 432 | 433 | // Return required keyboard inputs in a TInputArray, to produce a regular keyboard short cut 434 | class function TSendInputHelper.GetShortCut(ShiftState: TSIHShiftState; ShortChar: Char): TInputArray; 435 | var 436 | PreShifts, Chars, AppShifts: TInputArray; 437 | begin 438 | PreShifts := GetShift(ShiftState, True, False); 439 | Chars := GetChar(ShortChar, True, True); 440 | AppShifts := GetShift(ShiftState, False, True); 441 | Result := MergeInputs([PreShifts, Chars, AppShifts]); 442 | end; 443 | 444 | class function TSendInputHelper.GetShortCut(ShiftState: TSIHShiftState; ShortVK: Word): TInputArray; 445 | var 446 | PreShifts, VKs, AppShifts: TInputArray; 447 | begin 448 | PreShifts := GetShift(ShiftState, True, False); 449 | VKs := GetVirtualKey(ShortVK, True, True); 450 | AppShifts := GetShift(ShiftState, False, True); 451 | Result := MergeInputs([PreShifts, VKs, AppShifts]); 452 | end; 453 | 454 | class function TSendInputHelper.GetMouseInput(X, Y: Integer; MouseData, Flags, Time: DWORD): TInput; 455 | begin 456 | Result.Itype := INPUT_MOUSE; 457 | Result.mi.dx := X; 458 | Result.mi.dy := Y; 459 | Result.mi.mouseData := MouseData; 460 | Result.mi.dwFlags := Flags; 461 | Result.mi.time := Time; 462 | end; 463 | 464 | class function TSendInputHelper.GetMouseClick(MouseButton: TMouseButton; 465 | Press, Release: Boolean): TInputArray; 466 | 467 | function PressFlags: Cardinal; 468 | begin 469 | case MouseButton of 470 | TMouseButton.mbLeft: 471 | Result := MOUSEEVENTF_LEFTDOWN; 472 | TMouseButton.mbRight: 473 | Result := MOUSEEVENTF_RIGHTDOWN; 474 | TMouseButton.mbMiddle: 475 | Result := MOUSEEVENTF_MIDDLEDOWN; 476 | else 477 | Result := 0; 478 | end; 479 | end; 480 | 481 | function ReleaseFlags: Cardinal; 482 | begin 483 | case MouseButton of 484 | TMouseButton.mbLeft: 485 | Result := MOUSEEVENTF_LEFTUP; 486 | TMouseButton.mbRight: 487 | Result := MOUSEEVENTF_RIGHTUP; 488 | TMouseButton.mbMiddle: 489 | Result := MOUSEEVENTF_MIDDLEUP; 490 | else 491 | Result := 0; 492 | end; 493 | end; 494 | 495 | begin 496 | if not (Press or Release) then 497 | Exit(nil); 498 | SetLength(Result, Ord(Press) + Ord(Release)); 499 | if Press then 500 | Result[0] := GetMouseInput(0, 0, 0, PressFlags, 0); 501 | if Release then 502 | Result[Ord(Press)] := GetMouseInput(0, 0, 0, ReleaseFlags, 0); 503 | end; 504 | 505 | class function TSendInputHelper.GetRelativeMouseMove(DeltaX, DeltaY: Integer): TInputArray; 506 | begin 507 | SetLength(Result, 1); 508 | Result[0] := GetMouseInput(DeltaX, DeltaY, 0, MOUSEEVENTF_MOVE, 0); 509 | end; 510 | 511 | class function TSendInputHelper.GetAbsoluteMouseMove(X, Y: Integer; 512 | DesktopCoordinates: Boolean): TInputArray; 513 | const 514 | MOUSEEVENTF_VIRTUALDESK = $4000; 515 | COORDINATE_MAX = $FFFF; 516 | 517 | function NormalizeDimension(Value, RefValue: Integer): Integer; 518 | begin 519 | Result := Round(Value * (COORDINATE_MAX / RefValue)); 520 | end; 521 | 522 | var 523 | Flags: Cardinal; 524 | RefSize: TSize; 525 | DesktopRect: TRect; 526 | begin 527 | SetLength(Result, 1); 528 | Flags := MOUSEEVENTF_MOVE or MOUSEEVENTF_ABSOLUTE; 529 | 530 | if DesktopCoordinates then 531 | begin 532 | DesktopRect := Screen.DesktopRect; 533 | RefSize := DesktopRect.Size; 534 | 535 | // Offset the origin to get the virtual screen coordinates 536 | // This is only in multi monitor setups required. 537 | if DesktopRect.Left <> 0 then 538 | X := X - DesktopRect.Left; 539 | if DesktopRect.Top <> 0 then 540 | Y := Y - DesktopRect.Top; 541 | 542 | Flags := Flags or MOUSEEVENTF_VIRTUALDESK 543 | end 544 | else 545 | RefSize := Screen.PrimaryMonitor.BoundsRect.Size; 546 | 547 | Result[0] := GetMouseInput( 548 | NormalizeDimension(X, RefSize.cx), NormalizeDimension(Y, RefSize.cy), 0, Flags, 0); 549 | end; 550 | 551 | // Return a TInputArray with keyboard inputs, to produce the passed string 552 | // 553 | // @see GetText 554 | class function TSendInputHelper.GetText(SendText: string; AppendReturn: Boolean): TInputArray; 555 | var 556 | cc: Integer; 557 | begin 558 | Result := nil; 559 | for cc := 1 to Length(SendText) do 560 | Result := MergeInputs([Result, GetChar(SendText[cc], True, True)]); 561 | if Assigned(Result) and AppendReturn then 562 | Result := MergeInputs([Result, GetVirtualKey(VK_RETURN, True, True)]); 563 | end; 564 | 565 | // Return a TInputArray that contains entries for a press or release for the passed VirtualKey 566 | // 567 | // @see GetVirtualKey 568 | class function TSendInputHelper.GetVirtualKey(VirtualKey: Word; 569 | Press, Release: Boolean): TInputArray; 570 | begin 571 | if not (Press or Release) then 572 | Exit(nil); 573 | SetLength(Result, Ord(Press) + Ord(Release)); 574 | if Press then 575 | Result[0] := GetKeyboardInput(VirtualKey, 0, 0, 0); 576 | if Release then 577 | Result[Ord(Press)] := GetKeyboardInput(VirtualKey, 0, KEYEVENTF_KEYUP, 0); 578 | end; 579 | 580 | // Determine, whether at the time of call, the passed key is pressed or not 581 | class function TSendInputHelper.IsVirtualKeyPressed(VirtualKey: Word): Boolean; 582 | begin 583 | Result := (GetAsyncKeyState(VirtualKey) and $8000 shr 15) = 1; 584 | end; 585 | 586 | // Merges several TInputArray's into one and return it 587 | // 588 | // If all passed TInputArray's are nil or empty, then nil is returned. 589 | class function TSendInputHelper.MergeInputs(InputsBatch: array of TInputArray): TInputArray; 590 | var 591 | Inputs: TInputArray; 592 | InputsLength, Index: Integer; 593 | cc, ccc: Integer; 594 | begin 595 | Result := nil; 596 | InputsLength := 0; 597 | for cc := 0 to Length(InputsBatch) - 1 do 598 | if Assigned(InputsBatch[cc]) then 599 | InputsLength := InputsLength + Length(InputsBatch[cc]); 600 | if InputsLength = 0 then 601 | Exit; 602 | SetLength(Result, InputsLength); 603 | Index := 0; 604 | for cc := 0 to Length(InputsBatch) - 1 do 605 | begin 606 | if not Assigned(InputsBatch[cc]) then 607 | Continue; 608 | Inputs := InputsBatch[cc]; 609 | for ccc := 0 to Length(Inputs)- 1 do 610 | begin 611 | Result[Index] := Inputs[ccc]; 612 | Inc(Index); 613 | end; 614 | end; 615 | end; 616 | 617 | end. 618 | --------------------------------------------------------------------------------