├── .gitignore ├── CommandRegistry.pas ├── Commands ├── Commands.ClickElement.pas ├── Commands.CreateSession.pas ├── Commands.DeleteSession.pas ├── Commands.GetElementValue.pas ├── Commands.GetEnabled.pas ├── Commands.GetRect.pas ├── Commands.GetText.pas ├── Commands.GetWindowHandle.pas ├── Commands.PostClear.pas ├── Commands.PostElement.pas ├── Commands.PostElementElements.pas ├── Commands.PostElements.pas ├── Commands.PostExecute.pas ├── Commands.PostValue.pas └── Commands.pas ├── DelphiWebDriver.dpk ├── DelphiWebDriver.dproj ├── DelphiWebDriver.res ├── HttpServerCommand.pas ├── JsonAttributeSource.pas ├── LICENSE ├── README.md ├── ResourceProcessing.pas ├── RestServer.pas ├── Server.dpr ├── Server.dproj ├── Server.res ├── ServerAndClient.groupproj ├── Session.pas ├── Sessions.pas ├── TestClient ├── TestClient.dpr ├── TestClient.dproj ├── TestClient.res ├── Unit3.dfm └── Unit3.pas ├── TestHost ├── HostMain.dfm ├── HostMain.pas ├── TestHost.dpr ├── TestHost.dproj └── TestHost.res ├── Unit1.dfm ├── Unit1.pas └── Utils.pas /.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 | -------------------------------------------------------------------------------- /CommandRegistry.pas: -------------------------------------------------------------------------------- 1 | unit CommandRegistry; 2 | 3 | interface 4 | 5 | uses 6 | Vcl.forms, 7 | classes, IdContext, IdCustomHTTPServer, generics.collections, 8 | System.SysUtils; 9 | 10 | type 11 | TRESTCommandClass = class of TRESTCommand; 12 | TRESTCommandREG = class; 13 | 14 | TRESTCommand = class 15 | private 16 | FParams: TStringList; 17 | FContext: TIdContext; 18 | FRequestInfo: TIdHTTPRequestInfo; 19 | FResponseInfo: TIdHTTPResponseInfo; 20 | FReg: TRESTCommandREG; 21 | FStreamContents: String; 22 | procedure ParseParams(const AURI, AMask:String); 23 | procedure ReadStream(ARequestInfo: TIdHTTPRequestInfo); 24 | public 25 | class function GetCommand: String; virtual; 26 | class function GetRoute: String; virtual; 27 | 28 | constructor Create; 29 | 30 | procedure Start(AReg: TRESTCommandREG; AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo; AParams: TStringList); 31 | procedure Execute(AOwner: TForm); virtual; 32 | 33 | procedure ResponseJSON(Json: String); 34 | procedure Error(code: integer); 35 | 36 | destructor Destroy; override; 37 | property Context: TIdContext read FContext; 38 | property RequestInfo: TIdHTTPRequestInfo read FRequestInfo; 39 | property ResponseInfo: TIdHTTPResponseInfo read FResponseInfo; 40 | property Params: TStringList read FParams; 41 | property StreamContents : String read FStreamContents; 42 | property Reg: TRESTCommandREG read FReg; 43 | end; 44 | 45 | TRESTCommandREG = class 46 | public 47 | FTYPE: String; 48 | FPATH: String; 49 | FCommand: TRESTCommandClass; 50 | FHost: TForm; // TComponent; 51 | constructor Create(ATYPE:String; APATH: String; ACommand: TRESTCommandClass); 52 | end; 53 | 54 | THttpServerCommandRegister=class(TComponent) 55 | private 56 | FList: TObjectList; 57 | public 58 | procedure Register(ATYPE:String; APATH: String; ACommand: TRESTCommandClass); overload; 59 | procedure Register(ACommand: TRESTCommandClass); overload; 60 | 61 | constructor Create(AOwner: TComponent); override; 62 | function isUri(AURI: String; AMask: String; AParams: TStringList): boolean; 63 | function FindCommand(ACommand: String; AURI: String; Params: TStringList): TRESTCommandREG; 64 | destructor Destroy; override; 65 | end; 66 | 67 | implementation 68 | 69 | uses 70 | RegularExpressions; 71 | 72 | { THttpServerCommandRegister } 73 | 74 | constructor THttpServerCommandRegister.Create(AOwner: TComponent); 75 | begin 76 | inherited; 77 | FList:= TObjectList.Create(True); 78 | end; 79 | 80 | destructor THttpServerCommandRegister.Destroy; 81 | begin 82 | FList.Free; 83 | inherited; 84 | end; 85 | 86 | function THttpServerCommandRegister.FindCommand(ACommand, AURI: String; Params: TStringList): TRESTCommandREG; 87 | var 88 | I: Integer; 89 | begin 90 | for I := 0 to FList.Count-1 do 91 | begin 92 | if SameText(ACommand,FList[i].FTYPE) then 93 | begin 94 | if isURI(AURI,FList[i].FPATH, Params) then 95 | begin 96 | exit(FList[i]); 97 | end; 98 | end; 99 | end; 100 | result:= nil; 101 | end; 102 | 103 | function THttpServerCommandRegister.isUri(AURI, AMask: String; AParams: TStringList): boolean; 104 | var 105 | x: Integer; 106 | M : TMatch; 107 | 108 | begin 109 | result := TRegEx.IsMatch(AURI, AMask); 110 | 111 | M := TRegEx.Match(AURI, AMask); 112 | 113 | for x := 0 to M.Groups.Count-1 do 114 | begin 115 | AParams.Add(M.Groups[x].Value); 116 | end; 117 | end; 118 | 119 | procedure THttpServerCommandRegister.Register(ATYPE, APATH: String; ACommand: TRESTCommandClass); 120 | begin 121 | FList.Add(TRESTCommandREG.Create(ATYPE, APATH, ACommand)); 122 | end; 123 | 124 | procedure THttpServerCommandRegister.Register(ACommand: TRESTCommandClass); 125 | begin 126 | FList.Add(TRESTCommandREG.Create(ACommand.GetCommand, ACommand.GetRoute, ACommand)); 127 | end; 128 | 129 | { TRESTCommandREG } 130 | 131 | constructor TRESTCommandREG.Create(ATYPE, APATH: String; ACommand: TRESTCommandClass); 132 | begin 133 | FTYPE := AType; 134 | FPATH := APATH; 135 | FCommand := ACommand; 136 | end; 137 | 138 | { TRESTCommand } 139 | 140 | class function TRESTCommand.GetCommand: String; 141 | begin 142 | result := ''; 143 | end; 144 | 145 | class function TRESTCommand.GetRoute: String; 146 | begin 147 | result := ''; 148 | end; 149 | 150 | constructor TRESTCommand.create; 151 | begin 152 | FParams:= TStringList.Create; 153 | end; 154 | 155 | procedure TRESTCommand.ReadStream(ARequestInfo: TIdHTTPRequestInfo); 156 | var 157 | oStream : TStringStream; 158 | 159 | begin 160 | // Decode stream 161 | if ArequestInfo.PostStream <> nil then 162 | begin 163 | oStream := TStringStream.create; 164 | try 165 | oStream.CopyFrom(ArequestInfo.PostStream, ArequestInfo.PostStream.Size); 166 | oStream.Position := 0; 167 | 168 | FStreamContents := oStream.readString(oStream.Size); 169 | finally 170 | oStream.free; 171 | end; 172 | end; 173 | end; 174 | 175 | procedure TRESTCommand.Start(AReg: TRESTCommandREG; AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo; AParams: TStringList); 176 | begin 177 | FContext:= AContext; 178 | FRequestInfo:= ARequestInfo; 179 | FResponseInfo:= AResponseInfo; 180 | FReg:= AReg; 181 | FParams.Assign(AParams); 182 | ParseParams(ARequestInfo.URI, AReg.FPATH); 183 | ReadStream(ARequestInfo); 184 | end; 185 | 186 | destructor TRESTCommand.Destroy; 187 | begin 188 | FParams.free; 189 | inherited; 190 | end; 191 | 192 | procedure TRESTCommand.Execute(AOwner: TForm); 193 | begin 194 | 195 | end; 196 | 197 | procedure TRESTCommand.ParseParams(const AURI, AMask: String); 198 | var 199 | x: Integer; 200 | M : TMatch; 201 | 202 | begin 203 | M := TRegEx.Match(AURI, AMask); 204 | 205 | for x := 0 to M.Groups.Count-1 do 206 | begin 207 | FParams.Add(M.Groups[x].Value); 208 | end; 209 | end; 210 | 211 | procedure TRESTCommand.ResponseJSON(Json: String); 212 | begin 213 | ResponseInfo.ContentText := Json; 214 | ResponseInfo.ContentType := 'Application/JSON'; 215 | end; 216 | 217 | procedure TRESTCommand.Error(code: integer); 218 | begin 219 | ResponseInfo.ResponseNo := code; 220 | end; 221 | 222 | end. 223 | -------------------------------------------------------------------------------- /Commands/Commands.ClickElement.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { DelphiWebDriver } 4 | { } 5 | { Copyright 2017 inpwtepydjuf@gmail.com } 6 | { } 7 | {***************************************************************************} 8 | { } 9 | { Licensed under the Apache License, Version 2.0 (the "License"); } 10 | { you may not use this file except in compliance with the License. } 11 | { You may obtain a copy of the License at } 12 | { } 13 | { http://www.apache.org/licenses/LICENSE-2.0 } 14 | { } 15 | { Unless required by applicable law or agreed to in writing, software } 16 | { distributed under the License is distributed on an "AS IS" BASIS, } 17 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 18 | { See the License for the specific language governing permissions and } 19 | { limitations under the License. } 20 | { } 21 | {***************************************************************************} 22 | unit Commands.ClickElement; 23 | 24 | interface 25 | 26 | uses 27 | CommandRegistry, 28 | Vcl.Forms, 29 | HttpServerCommand; 30 | 31 | type 32 | /// 33 | /// Handles 'POST', '/session/(.*)/element/(.*)/click' 34 | /// 35 | TClickElementCommand = class(TRESTCommand) 36 | private 37 | procedure ProcessHandle(AOwner: TForm); 38 | procedure ProcessControlName(AOwner: TForm); 39 | function OKResponse(const handle: String): String; 40 | public 41 | class function GetCommand: String; override; 42 | class function GetRoute: String; override; 43 | 44 | procedure Execute(AOwner: TForm); override; 45 | end; 46 | 47 | implementation 48 | 49 | uses 50 | Utils, 51 | System.StrUtils, 52 | Vcl.StdCtrls, 53 | Vcl.ComCtrls, 54 | Vcl.Buttons, 55 | Vcl.Controls, 56 | Vcl.Menus, 57 | System.SysUtils, 58 | System.JSON, 59 | System.Classes; 60 | 61 | procedure TClickElementCommand.ProcessHandle(AOwner: TForm); 62 | var 63 | ctrl: TWinControl; 64 | handle: Integer; 65 | checked: boolean; 66 | 67 | begin 68 | handle := StrToInt(self.Params[2]); 69 | ctrl := FindControl(handle); 70 | 71 | if (ctrl <> nil) then 72 | begin 73 | if (ctrl is TButton) then 74 | begin 75 | (ctrl as TButton).click; 76 | end 77 | else if (ctrl is TCheckBox) then 78 | begin 79 | checked := (ctrl as TCheckBox).Checked; 80 | (ctrl as TCheckBox).Checked := not checked; 81 | end 82 | else if (ctrl is TRadioButton) then 83 | begin 84 | (ctrl as TRadioButton).Checked := true; 85 | end; 86 | 87 | ResponseJSON(self.OKResponse(self.Params[2])); 88 | end 89 | else 90 | Error(404); 91 | end; 92 | 93 | procedure TClickElementCommand.ProcessControlName(AOwner: TForm); 94 | var 95 | comp: TComponent; 96 | values : TStringList; 97 | 98 | const 99 | Delimiter = '.'; 100 | 101 | begin 102 | if (ContainsText(self.Params[2], Delimiter)) then 103 | begin 104 | values := TStringList.Create; 105 | try 106 | values.Delimiter := Delimiter; 107 | values.StrictDelimiter := True; 108 | values.DelimitedText := self.Params[2]; 109 | 110 | // Find parent 111 | comp := (AOwner.FindComponent(values[0])); 112 | 113 | if comp <> nil then 114 | begin 115 | if comp is TPageControl then 116 | begin 117 | (comp as TPageControl).ActivePage := 118 | (comp as TPageControl).Pages[StrToInt(values[1])]; 119 | end; 120 | end 121 | else 122 | Error(404); 123 | finally 124 | values.Free; 125 | end 126 | end 127 | else 128 | begin 129 | comp := (AOwner.FindComponent(self.Params[2])); 130 | 131 | if (comp <> nil) then 132 | begin 133 | if (comp is TSpeedButton) then 134 | (comp as TSpeedButton).click 135 | else if (comp is TMenuItem) then 136 | (comp as TMenuItem).click 137 | else if (comp is TToolButton) then 138 | (comp as TToolButton).click; 139 | ResponseJSON(self.OKResponse(self.Params[2])); 140 | end 141 | else 142 | Error(404); 143 | end; 144 | end; 145 | 146 | procedure TClickElementCommand.Execute(AOwner: TForm); 147 | begin 148 | if (isNumber(self.Params[2])) then 149 | ProcessHandle(AOwner) 150 | else 151 | ProcessControlName(AOwner); 152 | end; 153 | 154 | class function TClickElementCommand.GetCommand: String; 155 | begin 156 | result := 'POST'; 157 | end; 158 | 159 | class function TClickElementCommand.GetRoute: String; 160 | begin 161 | result := '/session/(.*)/element/(.*)/click'; 162 | end; 163 | 164 | function TClickElementCommand.OKResponse(const handle: String): String; 165 | var 166 | jsonObject: TJSONObject; 167 | 168 | begin 169 | jsonObject := TJSONObject.Create; 170 | 171 | jsonObject.AddPair(TJSONPair.Create('id', handle)); 172 | 173 | result := jsonObject.ToString; 174 | end; 175 | 176 | end. 177 | -------------------------------------------------------------------------------- /Commands/Commands.CreateSession.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { DelphiWebDriver } 4 | { } 5 | { Copyright 2017 inpwtepydjuf@gmail.com } 6 | { } 7 | {***************************************************************************} 8 | { } 9 | { Licensed under the Apache License, Version 2.0 (the "License"); } 10 | { you may not use this file except in compliance with the License. } 11 | { You may obtain a copy of the License at } 12 | { } 13 | { http://www.apache.org/licenses/LICENSE-2.0 } 14 | { } 15 | { Unless required by applicable law or agreed to in writing, software } 16 | { distributed under the License is distributed on an "AS IS" BASIS, } 17 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 18 | { See the License for the specific language governing permissions and } 19 | { limitations under the License. } 20 | { } 21 | {***************************************************************************} 22 | unit Commands.CreateSession; 23 | 24 | interface 25 | 26 | uses 27 | CommandRegistry, 28 | Vcl.Forms, 29 | HttpServerCommand; 30 | 31 | type 32 | /// 33 | /// Handles 'POST' '/session' 34 | /// 35 | TCreateSessionCommand = class(TRESTCommand) 36 | public 37 | class function GetCommand: String; override; 38 | class function GetRoute: String; override; 39 | 40 | procedure Execute(AOwner: TForm); override; 41 | end; 42 | 43 | implementation 44 | 45 | uses 46 | Commands, 47 | Session; 48 | 49 | class function TCreateSessionCommand.GetCommand: String; 50 | begin 51 | result := 'POST'; 52 | end; 53 | 54 | class function TCreateSessionCommand.GetRoute: String; 55 | begin 56 | result := '/session'; 57 | end; 58 | 59 | procedure TCreateSessionCommand.Execute(AOwner: TForm); 60 | var 61 | request : String; 62 | session : TSession; 63 | begin 64 | request := self.StreamContents; 65 | 66 | session := TSession.Create(request); 67 | 68 | Commands.Sessions.Add(session); 69 | 70 | ResponseJSON(session.GetSessionDetails); 71 | end; 72 | 73 | end. 74 | -------------------------------------------------------------------------------- /Commands/Commands.DeleteSession.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { DelphiWebDriver } 4 | { } 5 | { Copyright 2017 inpwtepydjuf@gmail.com } 6 | { } 7 | {***************************************************************************} 8 | { } 9 | { Licensed under the Apache License, Version 2.0 (the "License"); } 10 | { you may not use this file except in compliance with the License. } 11 | { You may obtain a copy of the License at } 12 | { } 13 | { http://www.apache.org/licenses/LICENSE-2.0 } 14 | { } 15 | { Unless required by applicable law or agreed to in writing, software } 16 | { distributed under the License is distributed on an "AS IS" BASIS, } 17 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 18 | { See the License for the specific language governing permissions and } 19 | { limitations under the License. } 20 | { } 21 | {***************************************************************************} 22 | unit Commands.DeleteSession; 23 | 24 | interface 25 | 26 | uses 27 | Sessions, 28 | Vcl.Forms, 29 | CommandRegistry, 30 | HttpServerCommand; 31 | 32 | type 33 | /// 34 | /// Handles 'DELETE' '/session/(.*)' 35 | /// 36 | TDeleteSessionCommand = class(TRestCommand) 37 | public 38 | class function GetCommand: String; override; 39 | class function GetRoute: String; override; 40 | 41 | procedure Execute(AOwner: TForm); override; 42 | end; 43 | 44 | implementation 45 | 46 | uses 47 | System.SysUtils, 48 | Commands; 49 | 50 | procedure TDeleteSessionCommand.Execute(AOwner: TForm); 51 | begin 52 | try 53 | // Need to delete it! 54 | Commands.Sessions.DeleteSession(self.Params[1]); 55 | 56 | except on e: Exception do 57 | Error(404); 58 | end; 59 | end; 60 | 61 | class function TDeleteSessionCommand.GetCommand: String; 62 | begin 63 | result := 'DELETE'; 64 | end; 65 | 66 | class function TDeleteSessionCommand.GetRoute: String; 67 | begin 68 | result := '/session/(.*)'; 69 | end; 70 | 71 | end. 72 | -------------------------------------------------------------------------------- /Commands/Commands.GetElementValue.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { DelphiWebDriver } 4 | { } 5 | { Copyright 2017 inpwtepydjuf@gmail.com } 6 | { } 7 | {***************************************************************************} 8 | { } 9 | { Licensed under the Apache License, Version 2.0 (the "License"); } 10 | { you may not use this file except in compliance with the License. } 11 | { You may obtain a copy of the License at } 12 | { } 13 | { http://www.apache.org/licenses/LICENSE-2.0 } 14 | { } 15 | { Unless required by applicable law or agreed to in writing, software } 16 | { distributed under the License is distributed on an "AS IS" BASIS, } 17 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 18 | { See the License for the specific language governing permissions and } 19 | { limitations under the License. } 20 | { } 21 | {***************************************************************************} 22 | unit Commands.GetElementValue; 23 | 24 | interface 25 | 26 | uses 27 | Vcl.Forms, 28 | CommandRegistry, 29 | HttpServerCommand; 30 | 31 | type 32 | TGetElementValueCommand = class(TRestCommand) 33 | private 34 | procedure ProcessHandle(AOwner: TForm); 35 | procedure ProcessControlName(AOwner: TForm); 36 | function OKResponse(const session, value: String): String; 37 | public 38 | procedure Execute(AOwner: TForm); override; 39 | 40 | class function GetCommand: String; override; 41 | class function GetRoute: String; override; 42 | end; 43 | 44 | implementation 45 | 46 | uses 47 | System.JSON, 48 | System.JSON.Types, 49 | Vcl.Controls, 50 | Vcl.Grids, 51 | System.SysUtils, 52 | System.Classes, 53 | System.StrUtils, 54 | Vcl.ComCtrls, 55 | Vcl.ExtCtrls, 56 | Vcl.Buttons, 57 | Vcl.StdCtrls, 58 | System.JSON.Writers, 59 | System.JSON.Builders, 60 | utils; 61 | 62 | class function TGetElementValueCommand.GetCommand: String; 63 | begin 64 | result := 'GET'; 65 | end; 66 | 67 | class function TGetElementValueCommand.GetRoute: String; 68 | begin 69 | result := '/session/(.*)/element/(.*)/attribute/(.*)'; 70 | end; 71 | 72 | procedure TGetElementValueCommand.ProcessHandle(AOwner: TForm); 73 | var 74 | ctrl: TWinControl; 75 | handle: Integer; 76 | value: String; 77 | 78 | begin 79 | handle := StrToInt(self.Params[2]); 80 | ctrl := FindControl(handle); 81 | 82 | if (ctrl <> nil) then 83 | begin 84 | if (ctrl is TCheckBox) then 85 | begin 86 | if (self.Params[3] = 'Checked') then 87 | if (ctrl as TCheckBox).Checked then value := 'True' else value := 'False' 88 | else 89 | value := 'Unknown'; 90 | end; 91 | 92 | ResponseJSON(self.OKResponse(self.Params[2], value)); 93 | end 94 | else 95 | Error(404); 96 | end; 97 | 98 | procedure TGetElementValueCommand.ProcessControlName(AOwner: TForm); 99 | var 100 | comp: TComponent; 101 | values : TStringList; 102 | 103 | const 104 | Delimiter = '.'; 105 | 106 | begin 107 | Error(404); 108 | (* 109 | if (ContainsText(self.Params[2], Delimiter)) then 110 | begin 111 | values := TStringList.Create; 112 | try 113 | values.Delimiter := Delimiter; 114 | values.StrictDelimiter := True; 115 | values.DelimitedText := self.Params[2]; 116 | 117 | // Find parent 118 | comp := (AOwner.FindComponent(values[0])); 119 | 120 | if comp <> nil then 121 | begin 122 | if comp is TPageControl then 123 | begin 124 | (comp as TPageControl).ActivePage := 125 | (comp as TPageControl).Pages[StrToInt(values[1])]; 126 | end; 127 | end 128 | else 129 | Error(404); 130 | finally 131 | values.Free; 132 | end 133 | end 134 | else 135 | begin 136 | comp := (AOwner.FindComponent(self.Params[2])); 137 | 138 | if (comp <> nil) then 139 | begin 140 | if (comp is TSpeedButton) then 141 | (comp as TSpeedButton).click 142 | else if (comp is TToolButton) then 143 | (comp as TToolButton).click; 144 | ResponseJSON(self.OKResponse(self.Params[2])); 145 | end 146 | else 147 | Error(404); 148 | end; 149 | *) 150 | end; 151 | 152 | procedure TGetElementValueCommand.Execute(AOwner: TForm); 153 | begin 154 | if (isNumber(self.Params[2])) then 155 | ProcessHandle(AOwner) 156 | else 157 | ProcessControlName(AOwner); 158 | end; 159 | 160 | function TGetElementValueCommand.OKResponse(const session, value: String): String; 161 | var 162 | Builder: TJSONObjectBuilder; 163 | Writer: TJsonTextWriter; 164 | StringWriter: TStringWriter; 165 | StringBuilder: TStringBuilder; 166 | 167 | begin 168 | StringBuilder := TStringBuilder.Create; 169 | StringWriter := TStringWriter.Create(StringBuilder); 170 | Writer := TJsonTextWriter.Create(StringWriter); 171 | Writer.Formatting := TJsonFormatting.Indented; 172 | Builder := TJSONObjectBuilder.Create(Writer); 173 | 174 | Builder 175 | .BeginObject() 176 | .Add('sessionId', session) 177 | .Add('status', 0) 178 | .Add('value', value) 179 | .EndObject; 180 | 181 | result := StringBuilder.ToString; 182 | end; 183 | 184 | end. 185 | -------------------------------------------------------------------------------- /Commands/Commands.GetEnabled.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { DelphiWebDriver } 4 | { } 5 | { Copyright 2017 inpwtepydjuf@gmail.com } 6 | { } 7 | {***************************************************************************} 8 | { } 9 | { Licensed under the Apache License, Version 2.0 (the "License"); } 10 | { you may not use this file except in compliance with the License. } 11 | { You may obtain a copy of the License at } 12 | { } 13 | { http://www.apache.org/licenses/LICENSE-2.0 } 14 | { } 15 | { Unless required by applicable law or agreed to in writing, software } 16 | { distributed under the License is distributed on an "AS IS" BASIS, } 17 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 18 | { See the License for the specific language governing permissions and } 19 | { limitations under the License. } 20 | { } 21 | {***************************************************************************} 22 | unit Commands.GetEnabled; 23 | 24 | interface 25 | 26 | uses 27 | CommandRegistry, 28 | Vcl.Forms, 29 | HttpServerCommand; 30 | 31 | type 32 | /// 33 | /// Handles 'GET' '/session/(.*)/element/(.*)/enabled' 34 | /// 35 | TGetEnabledCommand = class(TRESTCommand) 36 | private 37 | function OKResponse(const SessionID: String; enabled: boolean): String; 38 | public 39 | class function GetCommand: String; override; 40 | class function GetRoute: String; override; 41 | 42 | procedure Execute(AOwner: TForm); override; 43 | end; 44 | 45 | implementation 46 | 47 | uses 48 | Vcl.Controls, 49 | System.SysUtils, 50 | System.Classes, 51 | Vcl.ComCtrls, 52 | Vcl.ExtCtrls, 53 | Vcl.Buttons, 54 | Vcl.StdCtrls, 55 | System.StrUtils, 56 | System.JSON, 57 | System.JSON.Types, 58 | System.JSON.Writers, 59 | System.JSON.Builders, 60 | utils; 61 | 62 | procedure TGetEnabledCommand.Execute(AOwner: TForm); 63 | var 64 | comp: TComponent; 65 | ctrl: TWinControl; 66 | handle: Integer; 67 | values : TStringList; 68 | value: boolean; 69 | parent: TComponent; 70 | 71 | const 72 | Delimiter = '.'; 73 | 74 | begin 75 | ctrl := nil; 76 | comp := nil; 77 | 78 | if (isNumber(self.Params[2])) then 79 | begin 80 | handle := StrToInt(self.Params[2]); 81 | ctrl := FindControl(handle); 82 | 83 | ResponseJSON(OKResponse(self.Params[1], ctrl.Enabled)) 84 | end 85 | else 86 | if (ContainsText(self.Params[2], Delimiter)) then 87 | begin 88 | values := TStringList.Create; 89 | try 90 | values.Delimiter := Delimiter; 91 | values.StrictDelimiter := True; 92 | values.DelimitedText := self.Params[2]; 93 | 94 | // Get parent 95 | parent := AOwner.FindComponent(values[0]); 96 | 97 | if (parent is TToolBar) then 98 | begin 99 | value := (parent as TToolBar).Buttons[StrToInt(values[1])].enabled; 100 | end; 101 | 102 | // Now send it back please 103 | ResponseJSON(OKResponse(self.Params[2], value)); 104 | finally 105 | values.free; 106 | end; 107 | end 108 | else 109 | begin 110 | comp := AOwner.FindComponent(self.Params[2]); 111 | 112 | if (comp <> nil) then 113 | begin 114 | if (comp is TSpeedButton) then 115 | OKResponse(self.Params[1], (comp as TSpeedButton).enabled) 116 | else if (comp is TLabel) then 117 | OKResponse(self.Params[1], (comp as TLabel).enabled); 118 | 119 | ResponseJSON(OKResponse(self.Params[2], value)); 120 | end 121 | else 122 | Error(404); 123 | end; 124 | end; 125 | 126 | class function TGetEnabledCommand.GetCommand: String; 127 | begin 128 | result := 'GET'; 129 | end; 130 | 131 | class function TGetEnabledCommand.GetRoute: String; 132 | begin 133 | result := '/session/(.*)/element/(.*)/enabled'; 134 | end; 135 | 136 | function TGetEnabledCommand.OKResponse(const SessionID: String; enabled: boolean): String; 137 | var 138 | Builder: TJSONObjectBuilder; 139 | Writer: TJsonTextWriter; 140 | StringWriter: TStringWriter; 141 | StringBuilder: TStringBuilder; 142 | value: Variant; 143 | 144 | begin 145 | StringBuilder := TStringBuilder.Create; 146 | StringWriter := TStringWriter.Create(StringBuilder); 147 | Writer := TJsonTextWriter.Create(StringWriter); 148 | Writer.Formatting := TJsonFormatting.Indented; 149 | Builder := TJSONObjectBuilder.Create(Writer); 150 | 151 | value := enabled; 152 | 153 | Builder 154 | .BeginObject() 155 | .Add('sessionId', sessionId) 156 | .Add('status', 0) 157 | .Add('value', value) 158 | .EndObject; 159 | 160 | result := StringBuilder.ToString; 161 | end; 162 | 163 | end. 164 | -------------------------------------------------------------------------------- /Commands/Commands.GetRect.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { DelphiWebDriver } 4 | { } 5 | { Copyright 2017 inpwtepydjuf@gmail.com } 6 | { } 7 | {***************************************************************************} 8 | { } 9 | { Licensed under the Apache License, Version 2.0 (the "License"); } 10 | { you may not use this file except in compliance with the License. } 11 | { You may obtain a copy of the License at } 12 | { } 13 | { http://www.apache.org/licenses/LICENSE-2.0 } 14 | { } 15 | { Unless required by applicable law or agreed to in writing, software } 16 | { distributed under the License is distributed on an "AS IS" BASIS, } 17 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 18 | { See the License for the specific language governing permissions and } 19 | { limitations under the License. } 20 | { } 21 | {***************************************************************************} 22 | unit Commands.GetRect; 23 | 24 | interface 25 | 26 | uses 27 | CommandRegistry, 28 | Vcl.Forms, 29 | HttpServerCommand; 30 | 31 | type 32 | /// 33 | /// Handles 'GET' '/session/(.*)/element/(.*)/rect' 34 | /// 35 | TGetRectCommand = class(TRESTCommand) 36 | private 37 | function OKResponse(const sessionId: String; x, y, width, height: Integer): String; 38 | public 39 | class function GetCommand: String; override; 40 | class function GetRoute: String; override; 41 | 42 | procedure Execute(AOwner: TForm); override; 43 | end; 44 | 45 | implementation 46 | 47 | uses 48 | Vcl.Controls, 49 | System.SysUtils, 50 | System.Classes, 51 | System.StrUtils, 52 | System.JSON, 53 | System.JSON.Types, 54 | System.JSON.Writers, 55 | System.JSON.Builders, 56 | Vcl.Buttons, 57 | Vcl.StdCtrls, 58 | utils; 59 | 60 | procedure TGetRectCommand.Execute(AOwner: TForm); 61 | var 62 | comp: TComponent; 63 | ctrl: TWinControl; 64 | handle: Integer; 65 | 66 | begin 67 | ctrl := nil; 68 | comp := nil; 69 | 70 | if (isNumber(self.Params[2])) then 71 | begin 72 | handle := StrToInt(self.Params[2]); 73 | ctrl := FindControl(handle); 74 | end 75 | else 76 | comp := AOwner.FindComponent(self.Params[2]); 77 | 78 | // Needs to actually be proper rect 79 | if (ctrl <> nil) then 80 | begin 81 | ResponseJSON(OKResponse(self.Params[1], ctrl.top, ctrl.left, ctrl.width, ctrl.height)) 82 | end 83 | // Not possible for components? 84 | // else if (comp <> nil) then 85 | // begin 86 | // ResponseJSON(OKResponse(self.Params[1], comp.top, comp.left, comp.width, comp.height)) 87 | // end 88 | else 89 | begin 90 | Error(404); 91 | end; 92 | end; 93 | 94 | class function TGetRectCommand.GetCommand: String; 95 | begin 96 | result := 'GET'; 97 | end; 98 | 99 | class function TGetRectCommand.GetRoute: String; 100 | begin 101 | result := '/session/(.*)/element/(.*)/rect'; 102 | end; 103 | 104 | function TGetRectCommand.OKResponse(const sessionId: String; x, y, width, height: Integer): String; 105 | var 106 | Builder: TJSONObjectBuilder; 107 | Writer: TJsonTextWriter; 108 | StringWriter: TStringWriter; 109 | StringBuilder: TStringBuilder; 110 | 111 | begin 112 | StringBuilder := TStringBuilder.Create; 113 | StringWriter := TStringWriter.Create(StringBuilder); 114 | Writer := TJsonTextWriter.Create(StringWriter); 115 | Writer.Formatting := TJsonFormatting.Indented; 116 | Builder := TJSONObjectBuilder.Create(Writer); 117 | 118 | Builder 119 | .BeginObject() 120 | .Add('sessionId', sessionId) 121 | .Add('status', 0) 122 | .Add('x', x) 123 | .Add('y', y) 124 | .Add('width', width) 125 | .Add('height', height) 126 | .EndObject; 127 | 128 | result := StringBuilder.ToString; 129 | end; 130 | 131 | end. 132 | -------------------------------------------------------------------------------- /Commands/Commands.GetText.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { DelphiWebDriver } 4 | { } 5 | { Copyright 2017 inpwtepydjuf@gmail.com } 6 | { } 7 | {***************************************************************************} 8 | { } 9 | { Licensed under the Apache License, Version 2.0 (the "License"); } 10 | { you may not use this file except in compliance with the License. } 11 | { You may obtain a copy of the License at } 12 | { } 13 | { http://www.apache.org/licenses/LICENSE-2.0 } 14 | { } 15 | { Unless required by applicable law or agreed to in writing, software } 16 | { distributed under the License is distributed on an "AS IS" BASIS, } 17 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 18 | { See the License for the specific language governing permissions and } 19 | { limitations under the License. } 20 | { } 21 | {***************************************************************************} 22 | unit Commands.GetText; 23 | 24 | interface 25 | 26 | uses 27 | Vcl.Forms, 28 | CommandRegistry, 29 | HttpServerCommand; 30 | 31 | type 32 | /// 33 | /// Handles 'GET' '/session/(.*)/element/(.*)/text' 34 | /// 35 | TGetTextCommand = class(TRESTCommand) 36 | private 37 | function OKResponse(const handle, value: String): String; 38 | public 39 | class function GetCommand: String; override; 40 | class function GetRoute: String; override; 41 | 42 | procedure Execute(AOwner: TForm); override; 43 | end; 44 | 45 | implementation 46 | 47 | uses 48 | System.JSON, 49 | System.JSON.Types, 50 | Vcl.Controls, 51 | Vcl.Grids, 52 | System.SysUtils, 53 | System.Classes, 54 | System.StrUtils, 55 | Vcl.ComCtrls, 56 | Vcl.Menus, 57 | Vcl.ExtCtrls, 58 | Vcl.Buttons, 59 | Vcl.StdCtrls, 60 | utils; 61 | 62 | procedure TGetTextCommand.Execute(AOwner: TForm); 63 | var 64 | comp: TComponent; 65 | ctrl: TWinControl; 66 | handle: Integer; 67 | parent: TComponent; 68 | values : TStringList; 69 | value: String; 70 | 71 | const 72 | Delimiter = '.'; 73 | 74 | begin 75 | if (isNumber(self.Params[2])) then 76 | begin 77 | handle := StrToInt(self.Params[2]); 78 | ctrl := FindControl(handle); 79 | 80 | if (ctrl <> nil) then 81 | begin 82 | if (ctrl is TEdit) then 83 | value := (ctrl as TEdit).Text 84 | else if (ctrl is TStaticText) then 85 | value := (ctrl as TStaticText).Caption 86 | else if (ctrl is TCheckBox) then 87 | value := (ctrl as TCheckBox).Caption 88 | else if (ctrl is TLinkLabel) then 89 | value := (ctrl as TLinkLabel).Caption 90 | else if (ctrl is TRadioButton) then 91 | value := (ctrl as TRadioButton).Caption; 92 | 93 | ResponseJSON(OKResponse(self.Params[2], value)); 94 | end 95 | else 96 | Error(404); 97 | end 98 | else 99 | begin 100 | // This might be a non-WinControl OR a DataItem for a container 101 | if (ContainsText(self.Params[2], Delimiter)) then 102 | begin 103 | values := TStringList.Create; 104 | try 105 | values.Delimiter := Delimiter; 106 | values.StrictDelimiter := True; 107 | values.DelimitedText := self.Params[2]; 108 | 109 | // Get parent 110 | parent := AOwner.FindComponent(values[0]); 111 | 112 | if (parent is TListBox) then 113 | begin 114 | value := (parent as TListBox).items[StrToInt(values[1])]; 115 | end 116 | else if (parent is TStringGrid) then 117 | begin 118 | value := (parent as TStringGrid).Cells[StrToInt(values[1]),StrToInt(values[2])]; 119 | end 120 | else if (parent is TPageControl) then 121 | begin 122 | value := (parent as TPageControl).Pages[StrToInt(values[1])].Caption; 123 | end 124 | else if (parent is TCombobox) then 125 | begin 126 | value := (parent as TCombobox).items[StrToInt(values[1])]; 127 | end; 128 | 129 | // Now send it back please 130 | ResponseJSON(OKResponse(self.Params[2], value)); 131 | finally 132 | values.free; 133 | end; 134 | end 135 | else 136 | begin 137 | comp := AOwner.FindComponent(self.Params[2]); 138 | 139 | if (comp <> nil) then 140 | begin 141 | if (comp is TSpeedButton) then 142 | Value := (comp as TSpeedButton).Caption 143 | else if (comp is TMenuItem) then 144 | Value := (comp as TMenuItem).Caption 145 | else if (comp is TLabel) then 146 | Value := (comp as TLabel).Caption; 147 | 148 | ResponseJSON(OKResponse(self.Params[2], value)); 149 | end 150 | else 151 | Error(404); 152 | end; 153 | end; 154 | end; 155 | 156 | function TGetTextCommand.OKResponse(const handle, value: String): String; 157 | var 158 | jsonObject: TJSONObject; 159 | 160 | begin 161 | jsonObject := TJSONObject.Create; 162 | 163 | jsonObject.AddPair(TJSONPair.Create('id', handle)); 164 | jsonObject.AddPair(TJSONPair.Create('value', value)); 165 | 166 | result := jsonObject.ToString; 167 | end; 168 | 169 | class function TGetTextCommand.GetCommand: String; 170 | begin 171 | result := 'GET'; 172 | end; 173 | 174 | class function TGetTextCommand.GetRoute: String; 175 | begin 176 | result := '/session/(.*)/element/(.*)/text'; 177 | end; 178 | 179 | end. 180 | -------------------------------------------------------------------------------- /Commands/Commands.GetWindowHandle.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { DelphiWebDriver } 4 | { } 5 | { Copyright 2017 inpwtepydjuf@gmail.com } 6 | { } 7 | {***************************************************************************} 8 | { } 9 | { Licensed under the Apache License, Version 2.0 (the "License"); } 10 | { you may not use this file except in compliance with the License. } 11 | { You may obtain a copy of the License at } 12 | { } 13 | { http://www.apache.org/licenses/LICENSE-2.0 } 14 | { } 15 | { Unless required by applicable law or agreed to in writing, software } 16 | { distributed under the License is distributed on an "AS IS" BASIS, } 17 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 18 | { See the License for the specific language governing permissions and } 19 | { limitations under the License. } 20 | { } 21 | {***************************************************************************} 22 | unit Commands.GetWindowHandle; 23 | 24 | interface 25 | 26 | uses 27 | Commands; 28 | 29 | type 30 | TGetWindowHandleCommand = class(TUnimplementedCommand) 31 | public 32 | class function GetCommand: String; override; 33 | class function GetRoute: String; override; 34 | end; 35 | 36 | implementation 37 | 38 | class function TGetWindowHandleCommand.GetCommand: String; 39 | begin 40 | result := 'GET'; 41 | end; 42 | 43 | class function TGetWindowHandleCommand.GetRoute: String; 44 | begin 45 | result := '/session/(.*)/window_handle'; 46 | end; 47 | 48 | end. 49 | -------------------------------------------------------------------------------- /Commands/Commands.PostClear.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { DelphiWebDriver } 4 | { } 5 | { Copyright 2017 inpwtepydjuf@gmail.com } 6 | { } 7 | {***************************************************************************} 8 | { } 9 | { Licensed under the Apache License, Version 2.0 (the "License"); } 10 | { you may not use this file except in compliance with the License. } 11 | { You may obtain a copy of the License at } 12 | { } 13 | { http://www.apache.org/licenses/LICENSE-2.0 } 14 | { } 15 | { Unless required by applicable law or agreed to in writing, software } 16 | { distributed under the License is distributed on an "AS IS" BASIS, } 17 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 18 | { See the License for the specific language governing permissions and } 19 | { limitations under the License. } 20 | { } 21 | {***************************************************************************} 22 | unit Commands.PostClear; 23 | 24 | interface 25 | 26 | uses 27 | Sessions, 28 | Vcl.Forms, 29 | CommandRegistry, 30 | HttpServerCommand; 31 | 32 | type 33 | TPostClearCommand = class(TRestCommand) 34 | private 35 | function OKResponse(const sessionId, value: String): String; 36 | public 37 | class function GetCommand: String; override; 38 | class function GetRoute: String; override; 39 | 40 | procedure Execute(AOwner: TForm); override; 41 | end; 42 | 43 | implementation 44 | 45 | uses 46 | Vcl.StdCtrls, 47 | Vcl.Controls, 48 | System.StrUtils, 49 | System.SysUtils, 50 | Utils, 51 | System.Classes, 52 | System.JSON; 53 | 54 | procedure TPostClearCommand.Execute(AOwner: TForm); 55 | var 56 | value: String; 57 | handle: integer; 58 | ctrl: TComponent; 59 | 60 | begin 61 | try 62 | if (isNumber(self.Params[2])) then 63 | begin 64 | handle := StrToInt(self.Params[2]); 65 | ctrl := FindControl(handle); 66 | 67 | if (ctrl <> nil) then 68 | begin 69 | if (ctrl is TEdit) then 70 | (ctrl as TEdit).Text := ''; 71 | // else if (ctrl is TStaticText) then 72 | // (ctrl as TStaticText).Caption := value 73 | // else if (ctrl is TCheckBox) then 74 | // (ctrl as TCheckBox).Caption := value 75 | // else if (ctrl is TLinkLabel) then 76 | // (ctrl as TLinkLabel).Caption := value 77 | // else if (ctrl is TRadioButton) then 78 | // (ctrl as TRadioButton).Caption := value; 79 | 80 | ResponseJSON(OKResponse(self.Params[2], value)); 81 | end 82 | else 83 | Error(404); 84 | end 85 | else 86 | begin 87 | // simple controls? 88 | Error(404); 89 | end; 90 | except on e: Exception do 91 | Error(404); 92 | end; 93 | 94 | end; 95 | 96 | function TPostClearCommand.OKResponse(const sessionId, value: String): String; 97 | var 98 | jsonObject: TJSONObject; 99 | 100 | begin 101 | jsonObject := TJSONObject.Create; 102 | 103 | jsonObject.AddPair(TJSONPair.Create('sessionId', sessionId)); 104 | // jsonObject.AddPair(TJSONPair.Create('status', '0')); 105 | 106 | result := jsonObject.ToString; 107 | end; 108 | 109 | class function TPostClearCommand.GetCommand: String; 110 | begin 111 | result := 'POST'; 112 | end; 113 | 114 | class function TPostClearCommand.GetRoute: String; 115 | begin 116 | result := '/session/(.*)/element/(.*)/clear'; 117 | end; 118 | 119 | end. 120 | -------------------------------------------------------------------------------- /Commands/Commands.PostElement.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { DelphiWebDriver } 4 | { } 5 | { Copyright 2017 inpwtepydjuf@gmail.com } 6 | { } 7 | {***************************************************************************} 8 | { } 9 | { Licensed under the Apache License, Version 2.0 (the "License"); } 10 | { you may not use this file except in compliance with the License. } 11 | { You may obtain a copy of the License at } 12 | { } 13 | { http://www.apache.org/licenses/LICENSE-2.0 } 14 | { } 15 | { Unless required by applicable law or agreed to in writing, software } 16 | { distributed under the License is distributed on an "AS IS" BASIS, } 17 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 18 | { See the License for the specific language governing permissions and } 19 | { limitations under the License. } 20 | { } 21 | {***************************************************************************} 22 | unit Commands.PostElement; 23 | 24 | interface 25 | 26 | uses 27 | Vcl.Forms, 28 | CommandRegistry, 29 | HttpServerCommand; 30 | 31 | type 32 | /// 33 | /// Handles 'POST' '/session/(.*)/element' 34 | /// 35 | TPostElementCommand = class(TRestCommand) 36 | private 37 | procedure GetElementByName(const value:String; AOwner: TForm); 38 | procedure GetElementByCaption(const value:String; AOwner: TForm); 39 | procedure GetElementByClassName(const value:String; AOwner: TForm); 40 | procedure GetElementByPartialCaption(const value:String; AOwner: TForm); 41 | 42 | function OKResponse(const sessionId, handle: String): String; 43 | public 44 | class function GetCommand: String; override; 45 | class function GetRoute: String; override; 46 | 47 | procedure Execute(AOwner: TForm); override; 48 | end; 49 | 50 | implementation 51 | 52 | uses 53 | System.JSON, 54 | Vcl.controls, 55 | Vcl.StdCtrls, 56 | Vcl.ExtCtrls, 57 | System.Types, 58 | System.SysUtils, 59 | System.Classes, 60 | System.StrUtils, 61 | System.JSON.Types, 62 | System.JSON.Writers, 63 | System.JSON.Builders; 64 | 65 | procedure TPostElementCommand.GetElementByName(const value:String; AOwner: TForm); 66 | var 67 | comp: TComponent; 68 | 69 | begin 70 | try 71 | if (AOwner.Caption = value) then 72 | comp := AOwner 73 | else 74 | comp := AOwner.FindComponent(value); 75 | 76 | if comp = nil then 77 | raise Exception.Create('Control not found'); 78 | 79 | if (comp is TWinControl) then 80 | ResponseJSON(self.OKResponse(self.Params[1], IntToStr((comp as TWinControl).Handle))) 81 | else 82 | ResponseJSON(self.OKResponse(self.Params[1], comp.name)); 83 | 84 | except on e: Exception do 85 | // Probably should give a different reply 86 | Error(404); 87 | end; 88 | end; 89 | 90 | procedure TPostElementCommand.GetElementByClassName(const value:String; AOwner: TForm); 91 | var 92 | comp: TComponent; 93 | i: Integer; 94 | 95 | begin 96 | comp := nil; 97 | 98 | try 99 | if (AOwner.ClassName = value) then 100 | comp := AOwner 101 | else 102 | begin 103 | for i := 0 to tForm(AOwner).ControlCount -1 do 104 | if tForm(AOwner).Controls[i].ClassName = value then 105 | begin 106 | comp := tForm(AOwner).Controls[i]; 107 | break; 108 | end; 109 | end; 110 | 111 | if comp = nil then 112 | raise Exception.Create('Control not found'); 113 | 114 | ResponseJSON(self.OKResponse(self.Params[1], IntToStr((comp as TWinControl).Handle))); 115 | 116 | except on e: Exception do 117 | // Probably should give a different reply 118 | Error(404); 119 | end; 120 | end; 121 | 122 | procedure TPostElementCommand.GetElementByPartialCaption(const value:String; AOwner: TForm); 123 | begin 124 | Error(404); 125 | end; 126 | 127 | procedure TPostElementCommand.GetElementByCaption(const value:String; AOwner: TForm); 128 | var 129 | comp: TComponent; 130 | i: Integer; 131 | 132 | begin 133 | comp := nil; 134 | 135 | try 136 | if (AOwner.Caption = value) then 137 | comp := AOwner 138 | else 139 | begin 140 | for i := 0 to tForm(AOwner).ControlCount -1 do 141 | 142 | // Vcl.ExtCtrls .. 143 | // TButtonedEdit 144 | // THeader 145 | // TPanel 146 | 147 | // Vcl.StdCtrls .. 148 | // TButton - done 149 | // TCheckBox 150 | // TComboBox 151 | // TEdit 152 | // TLabel 153 | // TListBox 154 | // TRadioButton 155 | // TStaticText 156 | // TMemo 157 | 158 | // Specifically from the test host 159 | // TTreeView 160 | // TRichEdit 161 | // TToolbar 162 | // TToolbarButton 163 | // TPageControl 164 | // TTabSheet 165 | // TStatusBar 166 | // TMainMenu 167 | // TMenuItem 168 | // TPopupMenu 169 | // TStringGrid 170 | // TMaskedEdit 171 | // TLinkLabel 172 | 173 | // TSpeedButton - no window here, need to 'fake' one 174 | 175 | // Need to get each type of control and check the caption / text 176 | if (tForm(AOwner).Controls[i] is TButton) then 177 | begin 178 | if (tForm(AOwner).Controls[i] as TButton).caption = value then 179 | begin 180 | comp := tForm(AOwner).Controls[i]; 181 | break; 182 | end; 183 | end 184 | else if (tForm(AOwner).Controls[i] is TPanel) then 185 | begin 186 | if (tForm(AOwner).Controls[i] as TPanel).caption = value then 187 | begin 188 | comp := tForm(AOwner).Controls[i]; 189 | break; 190 | end; 191 | end 192 | else if (tForm(AOwner).Controls[i] is TEdit) then 193 | begin 194 | if (tForm(AOwner).Controls[i] as TEdit).Text = value then 195 | begin 196 | comp := tForm(AOwner).Controls[i]; 197 | break; 198 | end; 199 | end; 200 | end; 201 | 202 | if comp = nil then 203 | raise Exception.Create('Control not found'); 204 | 205 | ResponseJSON(self.OKResponse(self.Params[1], IntToStr((comp as TWinControl).Handle))); 206 | 207 | except on e: Exception do 208 | // Probably should give a different reply 209 | Error(404); 210 | end; 211 | end; 212 | 213 | procedure TPostElementCommand.Execute(AOwner: TForm); 214 | var 215 | jsonObj : TJSONObject; 216 | using: String; 217 | value: String; 218 | 219 | begin 220 | jsonObj := TJSONObject.ParseJSONValue(TEncoding.ASCII.GetBytes(self.StreamContents),0) as TJSONObject; 221 | try 222 | (jsonObj as TJsonObject).TryGetValue('using', using); 223 | (jsonObj as TJsonObject).TryGetValue('value', value); 224 | finally 225 | jsonObj.Free; 226 | end; 227 | 228 | if (using = 'link text') then 229 | GetElementByCaption(value, AOwner) 230 | else if (using = 'name') then 231 | GetElementByName(value, AOwner) 232 | else if (using = 'class name') then 233 | GetElementByClassName(value, AOwner) 234 | else if (using = 'partial link text') then 235 | GetElementByPartialCaption(value, AOwner) 236 | else 237 | Error(404); 238 | // 'id' (automation id) 239 | end; 240 | 241 | function TPostElementCommand.OKResponse(const sessionId, handle: String): String; 242 | var 243 | Builder: TJSONObjectBuilder; 244 | Writer: TJsonTextWriter; 245 | StringWriter: TStringWriter; 246 | StringBuilder: TStringBuilder; 247 | 248 | begin 249 | StringBuilder := TStringBuilder.Create; 250 | StringWriter := TStringWriter.Create(StringBuilder); 251 | Writer := TJsonTextWriter.Create(StringWriter); 252 | Writer.Formatting := TJsonFormatting.Indented; 253 | Builder := TJSONObjectBuilder.Create(Writer); 254 | 255 | Builder 256 | .BeginObject() 257 | .Add('sessionId', sessionId) 258 | .Add('status', 0) 259 | .BeginObject('value') 260 | .Add('ELEMENT', Handle) 261 | .EndObject 262 | .EndObject; 263 | 264 | result := StringBuilder.ToString; 265 | 266 | end; 267 | 268 | class function TPostElementCommand.GetCommand: String; 269 | begin 270 | result := 'POST'; 271 | end; 272 | 273 | class function TPostElementCommand.GetRoute: String; 274 | begin 275 | result := '/session/(.*)/element'; 276 | end; 277 | 278 | end. 279 | -------------------------------------------------------------------------------- /Commands/Commands.PostElementElements.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { DelphiWebDriver } 4 | { } 5 | { Copyright 2017 inpwtepydjuf@gmail.com } 6 | { } 7 | {***************************************************************************} 8 | { } 9 | { Licensed under the Apache License, Version 2.0 (the "License"); } 10 | { you may not use this file except in compliance with the License. } 11 | { You may obtain a copy of the License at } 12 | { } 13 | { http://www.apache.org/licenses/LICENSE-2.0 } 14 | { } 15 | { Unless required by applicable law or agreed to in writing, software } 16 | { distributed under the License is distributed on an "AS IS" BASIS, } 17 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 18 | { See the License for the specific language governing permissions and } 19 | { limitations under the License. } 20 | { } 21 | {***************************************************************************} 22 | unit Commands.PostElementElements; 23 | 24 | interface 25 | 26 | uses 27 | Vcl.Forms, 28 | System.Classes, 29 | generics.collections, 30 | CommandRegistry, 31 | HttpServerCommand; 32 | 33 | Type 34 | /// 35 | /// Handles 'POST' '/session/(.*)/element(.*)/elements' 36 | /// 37 | TPostElementElementsCommand = class(TRestCommand) 38 | private 39 | function OKResponse(const sessionId: String; elements: TStringList): String; 40 | public 41 | class function GetCommand: String; override; 42 | class function GetRoute: String; override; 43 | 44 | procedure Execute(AOwner: TForm); override; 45 | end; 46 | 47 | implementation 48 | 49 | uses 50 | System.JSON, 51 | Vcl.Grids, 52 | Vcl.controls, 53 | Vcl.StdCtrls, 54 | Vcl.ExtCtrls, 55 | System.Types, 56 | Vcl.ComCtrls, 57 | System.SysUtils, 58 | System.StrUtils, 59 | System.JSON.Types, 60 | System.JSON.Writers, 61 | System.JSON.Builders, 62 | utils; 63 | 64 | procedure TPostElementElementsCommand.Execute(AOwner: TForm); 65 | var 66 | ctrl: TWinControl; 67 | comp: TComponent; 68 | handle: Integer; 69 | i: integer; 70 | comps: TStringList; 71 | 72 | begin 73 | ctrl := nil; 74 | comp := nil; 75 | 76 | comps := TStringList.Create; 77 | 78 | if (isNumber(self.Params[2])) then 79 | begin 80 | handle := StrToInt(self.Params[2]); 81 | ctrl := FindControl(handle); 82 | end 83 | else 84 | comp := (AOwner.FindComponent(self.Params[2])); 85 | 86 | if (ctrl <> nil) then 87 | begin 88 | if (ctrl is TStringGrid) then 89 | begin 90 | for i := 0 to (ctrl as TStringGrid).RowCount -1 do 91 | begin 92 | comps.Add(ctrl.name + '.' + IntToStr(i)); 93 | end; 94 | end 95 | else if (ctrl is TListBox) then 96 | begin 97 | for i := 0 to (ctrl as TListBox).Count -1 do 98 | begin 99 | comps.Add(ctrl.name + '.' + IntToStr(i)); 100 | end; 101 | end 102 | else if (ctrl is TPageControl) then 103 | begin 104 | for i := 0 to (ctrl as TPageControl).PageCount -1 do 105 | begin 106 | comps.Add(ctrl.name + '.' + IntToStr(i)); 107 | end; 108 | end 109 | else if (ctrl is TToolBar) then 110 | begin 111 | for i := 0 to (ctrl as TToolBar).ButtonCount -1 do 112 | begin 113 | comps.Add(ctrl.name + '.' + IntToStr(i)); 114 | end; 115 | end; 116 | 117 | if comps = nil then 118 | raise Exception.Create('Control(s) not found'); 119 | 120 | ResponseJSON(self.OKResponse(self.Params[1], comps)); 121 | end 122 | else 123 | Error(404); 124 | end; 125 | 126 | function TPostElementElementsCommand.OKResponse(const sessionId: String; elements: TStringList): String; 127 | var 128 | i: Integer; 129 | jsonPair: TJSONPair; 130 | jsonObject, arrayObject: TJSONObject; 131 | jsonArray: TJSONArray; 132 | 133 | begin 134 | jsonArray := TJSONArray.Create; 135 | jsonObject := TJSONObject.Create; 136 | jsonPair := TJSONPair.Create('value', jsonArray); 137 | 138 | jsonObject.AddPair(TJSONPair.Create('sessionId', sessionId)); 139 | // jsonObject.AddPair(TJSONPair.Create('status', '0')); 140 | 141 | for i := 0 to elements.count -1 do 142 | begin 143 | arrayObject := TJSONObject.Create; 144 | 145 | arrayObject.AddPair(TJSONPair.Create('ELEMENT', elements[i])); 146 | 147 | jsonArray.AddElement(arrayObject); 148 | end; 149 | 150 | jsonObject.AddPair(jsonPair); 151 | 152 | result := jsonObject.ToString; 153 | end; 154 | 155 | class function TPostElementElementsCommand.GetCommand: String; 156 | begin 157 | result := 'POST'; 158 | end; 159 | 160 | class function TPostElementElementsCommand.GetRoute: String; 161 | begin 162 | result := '/session/(.*)/element/(.*)/elements'; 163 | end; 164 | 165 | end. 166 | -------------------------------------------------------------------------------- /Commands/Commands.PostElements.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { DelphiWebDriver } 4 | { } 5 | { Copyright 2017 inpwtepydjuf@gmail.com } 6 | { } 7 | {***************************************************************************} 8 | { } 9 | { Licensed under the Apache License, Version 2.0 (the "License"); } 10 | { you may not use this file except in compliance with the License. } 11 | { You may obtain a copy of the License at } 12 | { } 13 | { http://www.apache.org/licenses/LICENSE-2.0 } 14 | { } 15 | { Unless required by applicable law or agreed to in writing, software } 16 | { distributed under the License is distributed on an "AS IS" BASIS, } 17 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 18 | { See the License for the specific language governing permissions and } 19 | { limitations under the License. } 20 | { } 21 | {***************************************************************************} 22 | unit Commands.PostElements; 23 | 24 | interface 25 | 26 | uses 27 | generics.collections, 28 | Vcl.Forms, 29 | Vcl.controls, 30 | System.Classes, 31 | CommandRegistry, 32 | HttpServerCommand; 33 | 34 | type 35 | /// 36 | /// Handles 'POST' '/session/(.*)/elements' 37 | /// 38 | TPostElementsCommand = class(TRestCommand) 39 | private 40 | procedure GetElementsByName(const value:String; AOwner: TForm); 41 | procedure GetElementsByCaption(const value:String; AOwner: TForm); 42 | procedure GetElementsByPartialCaption(const value:String; AOwner: TForm); 43 | procedure GetElementsByClassName(const value:String; AOwner: TForm); 44 | 45 | function OKResponse(const sessionId: String; elements: TObjectList): String; 46 | public 47 | class function GetCommand: String; override; 48 | class function GetRoute: String; override; 49 | 50 | procedure Execute(AOwner: TForm); override; 51 | end; 52 | 53 | implementation 54 | 55 | uses 56 | System.JSON, 57 | Vcl.stdctrls, 58 | System.Types, 59 | System.SysUtils, 60 | System.StrUtils, 61 | System.JSON.Types, 62 | System.JSON.Writers, 63 | System.JSON.Builders; 64 | 65 | procedure TPostElementsCommand.GetElementsByName(const value:String; AOwner: TForm); 66 | var 67 | comps: TObjectList; 68 | i: Integer; 69 | 70 | begin 71 | comps:= TObjectList.create; 72 | 73 | try 74 | try 75 | if (AOwner.Name = value) then 76 | comps.Add(AOwner) 77 | else 78 | begin 79 | for i := 0 to tForm(AOwner).ControlCount -1 do 80 | begin 81 | if tForm(AOwner).Controls[i].Name = value then 82 | begin 83 | comps.Add(AOwner.Controls[i]); 84 | end; 85 | end; 86 | end; 87 | 88 | if comps.count = 0 then 89 | raise Exception.Create('Control(s) not found'); 90 | 91 | ResponseJSON(self.OKResponse(self.Params[1], comps)); 92 | 93 | except on e: Exception do 94 | // Probably should give a different reply 95 | 96 | Error(401); 97 | end; 98 | finally 99 | // comps.free; 100 | end; 101 | end; 102 | 103 | procedure TPostElementsCommand.GetElementsByPartialCaption(const value:String; AOwner: TForm); 104 | begin 105 | 106 | end; 107 | 108 | procedure TPostElementsCommand.GetElementsByCaption(const value:String; AOwner: TForm); 109 | begin 110 | 111 | end; 112 | 113 | procedure TPostElementsCommand.GetElementsByClassName(const value:String; AOwner: TForm); 114 | var 115 | comps: TObjectList; 116 | i: Integer; 117 | 118 | begin 119 | comps:= TObjectList.create; 120 | 121 | try 122 | try 123 | if (AOwner.ClassName = value) then 124 | comps.Add(AOwner) 125 | else 126 | begin 127 | for i := 0 to tForm(AOwner).ComponentCount -1 do 128 | begin 129 | if tForm(AOwner).Components[i].ClassName = value then 130 | begin 131 | comps.Add(AOwner.Components[i]); 132 | end; 133 | end; 134 | end; 135 | 136 | if comps.count = 0 then 137 | raise Exception.Create('Control(s) not found'); 138 | 139 | ResponseJSON(self.OKResponse(self.Params[1], comps)); 140 | 141 | except on e: Exception do 142 | // Probably should give a different reply 143 | Error(404); 144 | end; 145 | finally 146 | // comps.free; 147 | end; 148 | end; 149 | 150 | procedure TPostElementsCommand.Execute(AOwner: TForm); 151 | var 152 | jsonObj : TJSONObject; 153 | using: String; 154 | value: String; 155 | 156 | begin 157 | // Decode request 158 | jsonObj := TJSONObject.ParseJSONValue(TEncoding.ASCII.GetBytes(self.StreamContents),0) as TJSONObject; 159 | try 160 | (jsonObj as TJsonObject).TryGetValue('using', using); 161 | (jsonObj as TJsonObject).TryGetValue('value', value); 162 | finally 163 | jsonObj.Free; 164 | end; 165 | 166 | if (using = 'link text') then 167 | GetElementsByCaption(value, AOwner) 168 | else if (using = 'name') then 169 | GetElementsByName(value, AOwner) 170 | else if (using = 'class name') then 171 | GetElementsByClassName(value, AOwner) 172 | else if (using = 'partial link text') then 173 | GetElementsByPartialCaption(value, AOwner) 174 | end; 175 | 176 | function TPostElementsCommand.OKResponse(const sessionId: String; elements: TObjectList): String; 177 | var 178 | i: Integer; 179 | jsonPair: TJSONPair; 180 | jsonObject, arrayObject: TJSONObject; 181 | jsonArray: TJSONArray; 182 | 183 | begin 184 | jsonArray := TJSONArray.Create; 185 | jsonObject := TJSONObject.Create; 186 | jsonPair := TJSONPair.Create('value', jsonArray); 187 | 188 | jsonObject.AddPair(TJSONPair.Create('sessionId', sessionId)); 189 | // jsonObject.AddPair(TJSONPair.Create('status', '0')); 190 | 191 | for i := 0 to elements.count -1 do 192 | begin 193 | arrayObject := TJSONObject.Create; 194 | 195 | if (elements[i] is TWinControl) then 196 | // Great we can use the actual window handle 197 | arrayObject.AddPair(TJSONPair.Create('ELEMENT', IntToStr((elements[i] as TWinControl).Handle))) 198 | else 199 | // Use the name, as it won't have a true handle 200 | arrayObject.AddPair(TJSONPair.Create('ELEMENT', elements[i].name)); 201 | 202 | jsonArray.AddElement(arrayObject); 203 | end; 204 | 205 | jsonObject.AddPair(jsonPair); 206 | 207 | result := jsonObject.ToString; 208 | end; 209 | 210 | class function TPostElementsCommand.GetCommand: String; 211 | begin 212 | result := 'POST'; 213 | end; 214 | 215 | class function TPostElementsCommand.GetRoute: String; 216 | begin 217 | result := '/session/(.*)/elements'; 218 | end; 219 | 220 | end. 221 | -------------------------------------------------------------------------------- /Commands/Commands.PostExecute.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { DelphiWebDriver } 4 | { } 5 | { Copyright 2017 inpwtepydjuf@gmail.com } 6 | { } 7 | {***************************************************************************} 8 | { } 9 | { Licensed under the Apache License, Version 2.0 (the "License"); } 10 | { you may not use this file except in compliance with the License. } 11 | { You may obtain a copy of the License at } 12 | { } 13 | { http://www.apache.org/licenses/LICENSE-2.0 } 14 | { } 15 | { Unless required by applicable law or agreed to in writing, software } 16 | { distributed under the License is distributed on an "AS IS" BASIS, } 17 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 18 | { See the License for the specific language governing permissions and } 19 | { limitations under the License. } 20 | { } 21 | {***************************************************************************} 22 | unit Commands.PostExecute; 23 | 24 | interface 25 | 26 | uses 27 | Sessions, 28 | Vcl.Forms, 29 | CommandRegistry, 30 | HttpServerCommand; 31 | 32 | type 33 | /// 34 | /// Handles POST /session/{sessionId}/execute 35 | /// 36 | /// 37 | /// Only for certain specific controls - StringGrids and ToolButtons 38 | /// 39 | TPostExecuteCommand = class(TRestCommand) 40 | private 41 | /// 42 | /// Right click on the control 43 | /// 44 | /// 45 | /// Currently only implemented for some controls 46 | /// 47 | procedure RightClick (AOwner: TForm; Const control: String); 48 | 49 | /// 50 | /// Right click on the control 51 | /// 52 | /// 53 | /// Currently only implemented for some controls 54 | /// 55 | procedure LeftClick (AOwner: TForm; Const control: String); 56 | 57 | /// 58 | /// Right click on the control 59 | /// 60 | /// 61 | /// Currently only implemented for some controls 62 | /// 63 | procedure DoubleClick (AOwner: TForm; Const control: String); 64 | 65 | function OKResponse(const sessionId, control: String): String; 66 | public 67 | class function GetCommand: String; override; 68 | class function GetRoute: String; override; 69 | 70 | /// 71 | /// Highjacked for left and right clicks on controls 72 | /// 73 | procedure Execute(AOwner: TForm); override; 74 | end; 75 | 76 | implementation 77 | 78 | uses 79 | Vcl.ComCtrls, 80 | System.StrUtils, 81 | System.SysUtils, 82 | Vcl.Grids, 83 | System.Classes, 84 | System.JSON; 85 | 86 | procedure TPostExecuteCommand.Execute(AOwner: TForm); 87 | var 88 | jsonObj : TJSONObject; 89 | argsObj : TJsonValue; 90 | script: String; 91 | control: String; 92 | 93 | begin 94 | // Decode the incoming JSON and see what we have 95 | jsonObj := TJSONObject.ParseJSONValue(TEncoding.ASCII.GetBytes(self.StreamContents),0) as TJSONObject; 96 | try 97 | (jsonObj as TJsonObject).TryGetValue('script', script); 98 | //(jsonObj as TJsonObject).TryGetValue('args', value); 99 | argsObj := jsonObj.Get('args').JsonValue; 100 | 101 | (argsObj as TJsonObject).TryGetValue('first', control); 102 | 103 | finally 104 | jsonObj.Free; 105 | end; 106 | 107 | try 108 | if (script = 'right click') then 109 | RightClick(AOwner, control) 110 | else if (script = 'left click') then 111 | LeftClick(AOwner, control) 112 | else if (script = 'double click') then 113 | DoubleClick(AOwner, control) 114 | else 115 | Error(404); 116 | 117 | except on e: Exception do 118 | Error(404); 119 | end; 120 | end; 121 | 122 | procedure TPostExecuteCommand.DoubleClick (AOwner: TForm; Const control: String); 123 | begin 124 | 125 | end; 126 | 127 | procedure TPostExecuteCommand.LeftClick (AOwner: TForm; Const control: String); 128 | begin 129 | 130 | end; 131 | 132 | procedure TPostExecuteCommand.RightClick (AOwner: TForm; Const control: String); 133 | var 134 | gridTop, top: Integer; 135 | gridLeft, left: Integer; 136 | parent, comp: TComponent; 137 | values : TStringList; 138 | parentGrid: TStringGrid; 139 | 140 | const 141 | Delimiter = '.'; 142 | 143 | begin 144 | // find the control / component - currently only implemented for stringgrids 145 | 146 | if (ContainsText(control, Delimiter)) then 147 | begin 148 | values := TStringList.Create; 149 | try 150 | values.Delimiter := Delimiter; 151 | values.StrictDelimiter := True; 152 | values.DelimitedText := control; 153 | 154 | // Get parent 155 | parent := AOwner.FindComponent(values[0]); 156 | 157 | if (parent is TStringGrid) then 158 | begin 159 | parentGrid := (parent as TStringGrid); 160 | gridTop := parentGrid.top; 161 | gridLeft := parentGrid.left; 162 | 163 | left := parentGrid.CellRect(StrToInt(values[1]),StrToInt(values[2])).left -gridLeft +1; 164 | top := parentGrid.CellRect(StrToInt(values[1]),StrToInt(values[2])).top -gridTop +1; 165 | 166 | // Cell 2,2 : left = 179, top = 85 ??? 167 | // Here we have to call into the grid itself somehow 168 | 169 | ResponseJSON(OKResponse(self.Params[2], control)); 170 | end 171 | else 172 | Error(404); 173 | finally 174 | values.free; 175 | end; 176 | end 177 | else 178 | begin 179 | comp := AOwner.FindComponent(control); 180 | 181 | if comp <> nil then 182 | begin 183 | if (comp is TToolButton) then 184 | begin 185 | if (comp as TToolButton).PopupMenu <> nil then 186 | begin 187 | // Popup a menu item here 188 | (comp as TToolButton).PopupMenu.Popup(100, 100); 189 | ResponseJSON(OKResponse(self.Params[2], control)); 190 | end 191 | else 192 | begin 193 | Error(404); 194 | end; 195 | end; 196 | end 197 | else 198 | Error(404); 199 | end; 200 | end; 201 | 202 | function TPostExecuteCommand.OKResponse(const sessionId, control: String): String; 203 | var 204 | jsonObject: TJSONObject; 205 | 206 | begin 207 | jsonObject := TJSONObject.Create; 208 | 209 | jsonObject.AddPair(TJSONPair.Create('sessionId', sessionId)); 210 | // jsonObject.AddPair(TJSONPair.Create('status', '0')); 211 | jsonObject.AddPair(TJSONPair.Create('value', control)); 212 | 213 | result := jsonObject.ToString; 214 | end; 215 | 216 | class function TPostExecuteCommand.GetCommand: String; 217 | begin 218 | result := 'POST'; 219 | end; 220 | 221 | class function TPostExecuteCommand.GetRoute: String; 222 | begin 223 | result := '/session/(.*)/execute'; 224 | end; 225 | 226 | end. 227 | -------------------------------------------------------------------------------- /Commands/Commands.PostValue.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { DelphiWebDriver } 4 | { } 5 | { Copyright 2017 inpwtepydjuf@gmail.com } 6 | { } 7 | {***************************************************************************} 8 | { } 9 | { Licensed under the Apache License, Version 2.0 (the "License"); } 10 | { you may not use this file except in compliance with the License. } 11 | { You may obtain a copy of the License at } 12 | { } 13 | { http://www.apache.org/licenses/LICENSE-2.0 } 14 | { } 15 | { Unless required by applicable law or agreed to in writing, software } 16 | { distributed under the License is distributed on an "AS IS" BASIS, } 17 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 18 | { See the License for the specific language governing permissions and } 19 | { limitations under the License. } 20 | { } 21 | {***************************************************************************} 22 | unit Commands.PostValue; 23 | 24 | interface 25 | 26 | uses 27 | Sessions, 28 | Vcl.Forms, 29 | CommandRegistry, 30 | HttpServerCommand; 31 | 32 | type 33 | TPostValueCommand = class(TRestCommand) 34 | private 35 | function OKResponse(const sessionId, value: String): String; 36 | public 37 | class function GetCommand: String; override; 38 | class function GetRoute: String; override; 39 | 40 | procedure Execute(AOwner: TForm); override; 41 | end; 42 | 43 | implementation 44 | 45 | uses 46 | Vcl.StdCtrls, 47 | Vcl.Controls, 48 | System.StrUtils, 49 | System.SysUtils, 50 | Utils, 51 | System.Classes, 52 | System.JSON; 53 | 54 | procedure TPostValueCommand.Execute(AOwner: TForm); 55 | var 56 | jsonObj : TJSONObject; 57 | value: String; 58 | handle: integer; 59 | ctrl: TComponent; 60 | 61 | begin 62 | // Decode the incoming JSON and see what we have 63 | jsonObj := TJSONObject.ParseJSONValue(TEncoding.ASCII.GetBytes(self.StreamContents),0) as TJSONObject; 64 | try 65 | (jsonObj as TJsonObject).TryGetValue('value', value); 66 | finally 67 | jsonObj.Free; 68 | end; 69 | 70 | try 71 | if (isNumber(self.Params[2])) then 72 | begin 73 | handle := StrToInt(self.Params[2]); 74 | ctrl := FindControl(handle); 75 | 76 | if (ctrl <> nil) then 77 | begin 78 | if (ctrl is TEdit) then 79 | (ctrl as TEdit).Text := value 80 | else if (ctrl is TCombobox) then 81 | (ctrl as TCombobox).Text := value; 82 | 83 | // else if (ctrl is TStaticText) then 84 | // (ctrl as TStaticText).Caption := value 85 | // else if (ctrl is TCheckBox) then 86 | // (ctrl as TCheckBox).Caption := value 87 | // else if (ctrl is TLinkLabel) then 88 | // (ctrl as TLinkLabel).Caption := value 89 | // else if (ctrl is TRadioButton) then 90 | // (ctrl as TRadioButton).Caption := value; 91 | 92 | ResponseJSON(OKResponse(self.Params[2], value)); 93 | end 94 | else 95 | Error(404); 96 | end 97 | else 98 | begin 99 | // simple controls? 100 | Error(404); 101 | end; 102 | except on e: Exception do 103 | Error(404); 104 | end; 105 | 106 | end; 107 | 108 | function TPostValueCommand.OKResponse(const sessionId, value: String): String; 109 | var 110 | jsonObject: TJSONObject; 111 | 112 | begin 113 | jsonObject := TJSONObject.Create; 114 | 115 | jsonObject.AddPair(TJSONPair.Create('sessionId', sessionId)); 116 | // jsonObject.AddPair(TJSONPair.Create('status', '0')); 117 | jsonObject.AddPair(TJSONPair.Create('value', value)); 118 | 119 | result := jsonObject.ToString; 120 | end; 121 | 122 | class function TPostValueCommand.GetCommand: String; 123 | begin 124 | result := 'POST'; 125 | end; 126 | 127 | class function TPostValueCommand.GetRoute: String; 128 | begin 129 | result := '/session/(.*)/element/(.*)/value'; 130 | end; 131 | 132 | end. 133 | -------------------------------------------------------------------------------- /Commands/Commands.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { DelphiWebDriver } 4 | { } 5 | { Copyright 2017 inpwtepydjuf@gmail.com } 6 | { } 7 | {***************************************************************************} 8 | { } 9 | { Licensed under the Apache License, Version 2.0 (the "License"); } 10 | { you may not use this file except in compliance with the License. } 11 | { You may obtain a copy of the License at } 12 | { } 13 | { http://www.apache.org/licenses/LICENSE-2.0 } 14 | { } 15 | { Unless required by applicable law or agreed to in writing, software } 16 | { distributed under the License is distributed on an "AS IS" BASIS, } 17 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 18 | { See the License for the specific language governing permissions and } 19 | { limitations under the License. } 20 | { } 21 | {***************************************************************************} 22 | unit Commands; 23 | 24 | interface 25 | 26 | uses 27 | Sessions, 28 | Vcl.Forms, 29 | CommandRegistry, 30 | HttpServerCommand; 31 | 32 | type 33 | TUnimplementedCommand = class(TRestCommand) 34 | public 35 | procedure Execute(AOwner: TForm); override; 36 | end; 37 | 38 | type 39 | /// 40 | /// Handles 'GET' '/status' 41 | /// 42 | TStatusCommand = class(TRESTCommand) 43 | public 44 | procedure Execute(AOwner: TForm); override; 45 | 46 | class function GetCommand: String; override; 47 | class function GetRoute: String; override; 48 | end; 49 | 50 | type 51 | TGetSessionsCommand = class(TRESTCommand) 52 | public 53 | procedure Execute(AOwner: TForm); override; 54 | 55 | class function GetCommand: String; override; 56 | class function GetRoute: String; override; 57 | end; 58 | 59 | type 60 | TGetSessionCommand = class(TRESTCommand) 61 | public 62 | procedure Execute(AOwner: TForm); override; 63 | 64 | class function GetCommand: String; override; 65 | class function GetRoute: String; override; 66 | end; 67 | 68 | type 69 | TGetTitleCommand = class(TRestCommand) 70 | public 71 | procedure Execute(AOwner: TForm); override; 72 | 73 | class function GetCommand: String; override; 74 | class function GetRoute: String; override; 75 | end; 76 | 77 | type 78 | TSessionTimeoutsCommand = class(TRESTCommand) 79 | public 80 | procedure Execute(AOwner: TForm); override; 81 | 82 | class function GetCommand: String; override; 83 | class function GetRoute: String; override; 84 | end; 85 | 86 | type 87 | TPostImplicitWaitCommand = class(TRestCommand) 88 | public 89 | procedure Execute(AOwner: TForm); override; 90 | 91 | class function GetCommand: String; override; 92 | class function GetRoute: String; override; 93 | end; 94 | 95 | type 96 | TGetElementCommand = class(TRestCommand) 97 | public 98 | procedure Execute(AOwner: TForm); override; 99 | 100 | class function GetCommand: String; override; 101 | class function GetRoute: String; override; 102 | end; 103 | 104 | type 105 | TGetWindowCommand = class(TRestCommand) 106 | public 107 | procedure Execute(AOwner: TForm); override; 108 | 109 | class function GetCommand: String; override; 110 | class function GetRoute: String; override; 111 | end; 112 | 113 | var 114 | Sessions: TSessions; 115 | 116 | implementation 117 | 118 | uses 119 | windows, 120 | Vcl.stdctrls, 121 | System.Classes, 122 | System.SysUtils, 123 | vcl.controls, 124 | System.JSON, 125 | System.Types, 126 | System.StrUtils, 127 | System.JSON.Types, 128 | System.JSON.Writers, 129 | System.JSON.Builders, 130 | Utils, 131 | Session; 132 | 133 | procedure TStatusCommand.Execute(AOwner: TForm); 134 | begin 135 | try 136 | ResponseJSON(Sessions.GetSessionStatus(self.Params[1])); 137 | except on e: Exception do 138 | Error(404); 139 | end; 140 | end; 141 | 142 | class function TStatusCommand.GetCommand: String; 143 | begin 144 | result := 'GET'; 145 | end; 146 | 147 | class function TStatusCommand.GetRoute: String; 148 | begin 149 | result := '/status'; 150 | end; 151 | 152 | procedure TSessionTimeoutsCommand.Execute(AOwner: TForm); 153 | var 154 | jsonObj : TJSONObject; 155 | requestType: String; 156 | value: String; 157 | 158 | begin 159 | // Set timeout for the session 160 | 161 | // Decode the incoming JSON and see what we have 162 | jsonObj := TJSONObject.ParseJSONValue(TEncoding.ASCII.GetBytes(self.StreamContents),0) as TJSONObject; 163 | try 164 | (jsonObj as TJsonObject).TryGetValue('type', requestType); 165 | (jsonObj as TJsonObject).TryGetValue('ms', value); 166 | finally 167 | jsonObj.Free; 168 | end; 169 | 170 | ResponseJSON(Sessions.SetSessionTimeouts(self.Params[1], StrToInt(value))); 171 | end; 172 | 173 | procedure TPostImplicitWaitCommand.Execute(AOwner: TForm); 174 | var 175 | jsonObj : TJSONObject; 176 | requestType: String; 177 | value: String; 178 | 179 | begin 180 | // Set timeout for the session 181 | 182 | // Decode the incoming JSON and see what we have 183 | jsonObj := TJSONObject.ParseJSONValue(TEncoding.ASCII.GetBytes(self.StreamContents),0) as TJSONObject; 184 | try 185 | (jsonObj as TJsonObject).TryGetValue('type', requestType); 186 | (jsonObj as TJsonObject).TryGetValue('ms', value); 187 | finally 188 | jsonObj.Free; 189 | end; 190 | 191 | ResponseJSON(Sessions.SetSessionImplicitTimeouts(self.Params[1], StrToInt(value))); 192 | end; 193 | 194 | procedure TGetElementCommand.Execute(AOwner: TForm); 195 | begin 196 | ResponseJSON('{''TGetElementCommand'':'''+ self.Params[1] + '''}'); 197 | end; 198 | 199 | procedure TGetSessionCommand.Execute(AOwner: TForm); 200 | begin 201 | try 202 | ResponseJSON(Sessions.GetSessionStatus(self.Params[1])); 203 | except on e: Exception do 204 | Error(404); 205 | end; 206 | end; 207 | 208 | procedure TGetSessionsCommand.Execute(AOwner: TForm); 209 | begin 210 | // No longer correct, needs to be a json array 211 | ResponseJSON(Sessions.GetSessionStatus(self.Params[1])); 212 | end; 213 | 214 | class function TGetSessionsCommand.GetCommand: String; 215 | begin 216 | result := 'GET'; 217 | end; 218 | 219 | class function TGetSessionsCommand.GetRoute: String; 220 | begin 221 | result := '/sessions'; 222 | end; 223 | 224 | class function TGetSessionCommand.GetCommand: String; 225 | begin 226 | result := 'GET'; 227 | end; 228 | 229 | class function TGetSessionCommand.GetRoute: String; 230 | begin 231 | result := '/session/(.*)'; 232 | end; 233 | 234 | class function TGetElementCommand.GetCommand: String; 235 | begin 236 | result := 'GET'; 237 | end; 238 | 239 | class function TGetElementCommand.GetRoute: String; 240 | begin 241 | result := '/session/(.*)/element'; 242 | end; 243 | 244 | 245 | procedure TUnimplementedCommand.Execute(AOwner: TForm); 246 | begin 247 | Error(501); 248 | end; 249 | 250 | procedure TGetTitleCommand.Execute(AOwner: TForm); 251 | var 252 | caption : String; 253 | begin 254 | // Here we are assuming it is a form 255 | caption := AOwner.Caption; // Never gets a caption for some reason 256 | ResponseJSON(caption); 257 | end; 258 | 259 | class function TGetTitleCommand.GetCommand: String; 260 | begin 261 | result := 'GET'; 262 | end; 263 | 264 | class function TGetTitleCommand.GetRoute: String; 265 | begin 266 | result := '/session/(.*)/title'; 267 | end; 268 | 269 | procedure TGetWindowCommand.Execute(AOwner: TForm); 270 | var 271 | handle : HWND; 272 | begin 273 | try 274 | handle := AOwner.Handle; 275 | ResponseJSON(intToStr(handle)); 276 | except on e: Exception do 277 | Sessions.ErrorResponse ('7', 'no such element', 'An element could not be located on the page using the given search parameteres'); 278 | end; 279 | end; 280 | 281 | class function TSessionTimeoutsCommand.GetCommand: String; 282 | begin 283 | result := 'POST'; 284 | end; 285 | 286 | class function TSessionTimeoutsCommand.GetRoute: String; 287 | begin 288 | result := '/session/(.*)/timeouts'; 289 | end; 290 | 291 | class function TPostImplicitWaitCommand.GetCommand: String; 292 | begin 293 | result := 'POST'; 294 | end; 295 | 296 | class function TPostImplicitWaitCommand.GetRoute: String; 297 | begin 298 | result := '/session/(.*)/timeouts/implicit_wait'; 299 | end; 300 | 301 | class function TGetWindowCommand.GetCommand: String; 302 | begin 303 | result := 'GET'; 304 | end; 305 | 306 | class function TGetWindowCommand.GetRoute: String; 307 | begin 308 | result := '/session/(.*)/window'; 309 | end; 310 | 311 | initialization 312 | Sessions := TSessions.Create; 313 | 314 | finalization 315 | Sessions.Free; 316 | 317 | end. 318 | -------------------------------------------------------------------------------- /DelphiWebDriver.dpk: -------------------------------------------------------------------------------- 1 | package DelphiWebDriver; 2 | 3 | {$R *.res} 4 | {$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} 5 | {$ALIGN 8} 6 | {$ASSERTIONS ON} 7 | {$BOOLEVAL OFF} 8 | {$DEBUGINFO OFF} 9 | {$EXTENDEDSYNTAX ON} 10 | {$IMPORTEDDATA ON} 11 | {$IOCHECKS ON} 12 | {$LOCALSYMBOLS ON} 13 | {$LONGSTRINGS ON} 14 | {$OPENSTRINGS ON} 15 | {$OPTIMIZATION OFF} 16 | {$OVERFLOWCHECKS OFF} 17 | {$RANGECHECKS OFF} 18 | {$REFERENCEINFO ON} 19 | {$SAFEDIVIDE OFF} 20 | {$STACKFRAMES ON} 21 | {$TYPEDADDRESS OFF} 22 | {$VARSTRINGCHECKS ON} 23 | {$WRITEABLECONST OFF} 24 | {$MINENUMSIZE 1} 25 | {$IMAGEBASE $400000} 26 | {$DEFINE DEBUG} 27 | {$ENDIF IMPLICITBUILDING} 28 | {$RUNONLY} 29 | {$IMPLICITBUILD ON} 30 | 31 | requires 32 | IndyCore, 33 | IndyProtocols, 34 | rtl, 35 | vcl; 36 | 37 | contains 38 | CommandRegistry in 'CommandRegistry.pas', 39 | Commands.ClickElement in 'Commands\Commands.ClickElement.pas', 40 | Commands.GetRect in 'Commands\Commands.GetRect.pas', 41 | Commands.GetText in 'Commands\Commands.GetText.pas', 42 | Commands in 'Commands\Commands.pas', 43 | Commands.PostElement in 'Commands\Commands.PostElement.pas', 44 | Commands.PostElementElements in 'Commands\Commands.PostElementElements.pas', 45 | Commands.PostElements in 'Commands\Commands.PostElements.pas', 46 | HttpServerCommand in 'HttpServerCommand.pas', 47 | JsonAttributeSource in 'JsonAttributeSource.pas', 48 | ResourceProcessing in 'ResourceProcessing.pas', 49 | RestServer in 'RestServer.pas', 50 | Session in 'Session.pas', 51 | Sessions in 'Sessions.pas', 52 | Utils in 'Utils.pas', 53 | Commands.CreateSession in 'Commands\Commands.CreateSession.pas', 54 | Commands.PostExecute in 'Commands\Commands.PostExecute.pas', 55 | Commands.GetEnabled in 'Commands\Commands.GetEnabled.pas', 56 | Commands.PostValue in 'Commands\Commands.PostValue.pas', 57 | Commands.DeleteSession in 'Commands\Commands.DeleteSession.pas', 58 | Commands.GetWindowHandle in 'Commands\Commands.GetWindowHandle.pas', 59 | Commands.PostClear in 'Commands\Commands.PostClear.pas', 60 | Commands.GetElementValue in 'Commands\Commands.GetElementValue.pas'; 61 | 62 | end. 63 | -------------------------------------------------------------------------------- /DelphiWebDriver.dproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {F1C536C2-DA14-4E2A-BDD0-697C5D1D1DEA} 4 | DelphiWebDriver.dpk 5 | 18.2 6 | VCL 7 | True 8 | Debug 9 | Win32 10 | 1 11 | Package 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | true 28 | Cfg_1 29 | true 30 | true 31 | 32 | 33 | true 34 | Base 35 | true 36 | 37 | 38 | System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) 39 | true 40 | All 41 | DelphiWebDriver 42 | true 43 | true 44 | .\$(Platform)\$(Config) 45 | .\$(Platform)\$(Config) 46 | false 47 | false 48 | false 49 | false 50 | false 51 | 52 | 53 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 54 | 1033 55 | true 56 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= 57 | 58 | 59 | DEBUG;$(DCC_Define) 60 | true 61 | false 62 | true 63 | true 64 | true 65 | 66 | 67 | e:\Users\Mark\Documents\GitHub\DelphiWebDriver\TestHost\Win32\Debug\TestHost.exe 68 | 1033 69 | true 70 | false 71 | 72 | 73 | false 74 | RELEASE;$(DCC_Define) 75 | 0 76 | 0 77 | 78 | 79 | 80 | MainSource 81 | 82 | 83 | 84 | 85 | 86 | 87 | 88 | 89 | 90 | 91 | 92 | 93 | 94 | 95 | 96 | 97 | 98 | 99 | 100 | 101 | 102 | 103 | 104 | 105 | 106 | 107 | 108 | 109 | 110 | Cfg_2 111 | Base 112 | 113 | 114 | Base 115 | 116 | 117 | Cfg_1 118 | Base 119 | 120 | 121 | 122 | Delphi.Personality.12 123 | Package 124 | 125 | 126 | 127 | DelphiWebDriver.dpk 128 | 129 | 130 | 131 | True 132 | 133 | 134 | 12 135 | 136 | 137 | 138 | 139 | -------------------------------------------------------------------------------- /DelphiWebDriver.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mmarquee/DelphiWebDriver/312fcb62fdc86af8364af4465c5ecaad1aa2acb4/DelphiWebDriver.res -------------------------------------------------------------------------------- /HttpServerCommand.pas: -------------------------------------------------------------------------------- 1 | unit HttpServerCommand; 2 | 3 | interface 4 | 5 | uses 6 | vcl.forms, 7 | IdContext, IdCustomHTTPServer, 8 | CommandRegistry, 9 | System.SysUtils, classes; 10 | 11 | type 12 | TOnLogMessage = procedure (const msg: String) of Object; 13 | 14 | type 15 | THttpServerCommand = class(TComponent) 16 | strict private 17 | FOnLogMessage: TOnLogMessage; 18 | FCommands: THttpServerCommandRegister; 19 | private 20 | function FindCommand(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo): boolean; 21 | procedure SendError(ACmd: TRESTCommandREG;AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo; E: Exception); 22 | procedure LogMessage(const msg: String); 23 | public 24 | constructor Create(AOwner: TComponent); override; 25 | destructor Destroy; override; 26 | procedure CommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); 27 | property Commands: THttpServerCommandRegister read FCommands; 28 | property OnLogMessage: TOnLogMessage read FOnLogMessage write FOnLogMessage; 29 | end; 30 | 31 | implementation 32 | 33 | { THttpServerCommand } 34 | 35 | procedure THttpServerCommand.LogMessage(const msg: String); 36 | begin 37 | if assigned(FOnLogMessage) then 38 | OnLogMessage(msg); 39 | end; 40 | 41 | function THttpServerCommand.FindCommand(AContext: TIdContext; 42 | ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo): boolean; 43 | var 44 | cmdReg: TRESTCommandREG; 45 | cmd: TRESTCommand; 46 | Params: TStringList; 47 | begin 48 | Params:= TStringList.Create; 49 | try 50 | cmdReg:= FCommands.FindCommand(ARequestInfo.Command,ARequestInfo.URI, Params); 51 | if cmdReg=nil then exit(false); 52 | 53 | try 54 | cmd := cmdReg.FCommand.create; 55 | try 56 | cmd.Start(cmdReg, AContext, ARequestInfo, AResponseInfo, Params); 57 | LogMessage(cmd.StreamContents); 58 | cmd.Execute(self.Owner as TForm); // Again with the TForm 59 | finally 60 | cmd.Free; 61 | end; 62 | except 63 | on e:Exception do 64 | begin 65 | SendError(cmdReg, AContext, ARequestInfo, AResponseInfo, e); 66 | end; 67 | end; 68 | result:= true; 69 | finally 70 | params.Free; 71 | end; 72 | end; 73 | 74 | procedure THttpServerCommand.SendError(ACmd: TRESTCommandREG; 75 | AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; 76 | AResponseInfo: TIdHTTPResponseInfo; E: Exception); 77 | begin 78 | AResponseInfo.ResponseNo := 404; 79 | end; 80 | 81 | procedure THttpServerCommand.CommandGet(AContext: TIdContext; 82 | ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); 83 | begin 84 | if not FindCommand(AContext,ARequestInfo,AResponseInfo) then 85 | AResponseInfo.ResponseNo := 404; 86 | end; 87 | 88 | constructor THttpServerCommand.Create(AOwner: TComponent); 89 | begin 90 | inherited Create(AOwner); 91 | FCommands:= THttpServerCommandRegister.Create(self); 92 | end; 93 | 94 | destructor THttpServerCommand.Destroy; 95 | begin 96 | FCommands.Free; 97 | inherited; 98 | end; 99 | 100 | end. 101 | -------------------------------------------------------------------------------- /JsonAttributeSource.pas: -------------------------------------------------------------------------------- 1 | unit JsonAttributeSource; 2 | 3 | interface 4 | 5 | type 6 | JsonAttribute = class(TCustomAttribute) 7 | private 8 | FName: String; 9 | public 10 | constructor Create(const AName: String); 11 | property Name: String read FName; 12 | end; 13 | 14 | implementation 15 | 16 | 17 | constructor JsonAttribute.Create(const AName: String); 18 | begin 19 | FName := AName; 20 | end; 21 | 22 | end. 23 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Apache License 2 | Version 2.0, January 2004 3 | http://www.apache.org/licenses/ 4 | 5 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 6 | 7 | 1. Definitions. 8 | 9 | "License" shall mean the terms and conditions for use, reproduction, 10 | and distribution as defined by Sections 1 through 9 of this document. 11 | 12 | "Licensor" shall mean the copyright owner or entity authorized by 13 | the copyright owner that is granting the License. 14 | 15 | "Legal Entity" shall mean the union of the acting entity and all 16 | other entities that control, are controlled by, or are under common 17 | control with that entity. For the purposes of this definition, 18 | "control" means (i) the power, direct or indirect, to cause the 19 | direction or management of such entity, whether by contract or 20 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 21 | outstanding shares, or (iii) beneficial ownership of such entity. 22 | 23 | "You" (or "Your") shall mean an individual or Legal Entity 24 | exercising permissions granted by this License. 25 | 26 | "Source" form shall mean the preferred form for making modifications, 27 | including but not limited to software source code, documentation 28 | source, and configuration files. 29 | 30 | "Object" form shall mean any form resulting from mechanical 31 | transformation or translation of a Source form, including but 32 | not limited to compiled object code, generated documentation, 33 | and conversions to other media types. 34 | 35 | "Work" shall mean the work of authorship, whether in Source or 36 | Object form, made available under the License, as indicated by a 37 | copyright notice that is included in or attached to the work 38 | (an example is provided in the Appendix below). 39 | 40 | "Derivative Works" shall mean any work, whether in Source or Object 41 | form, that is based on (or derived from) the Work and for which the 42 | editorial revisions, annotations, elaborations, or other modifications 43 | represent, as a whole, an original work of authorship. For the purposes 44 | of this License, Derivative Works shall not include works that remain 45 | separable from, or merely link (or bind by name) to the interfaces of, 46 | the Work and Derivative Works thereof. 47 | 48 | "Contribution" shall mean any work of authorship, including 49 | the original version of the Work and any modifications or additions 50 | to that Work or Derivative Works thereof, that is intentionally 51 | submitted to Licensor for inclusion in the Work by the copyright owner 52 | or by an individual or Legal Entity authorized to submit on behalf of 53 | the copyright owner. For the purposes of this definition, "submitted" 54 | means any form of electronic, verbal, or written communication sent 55 | to the Licensor or its representatives, including but not limited to 56 | communication on electronic mailing lists, source code control systems, 57 | and issue tracking systems that are managed by, or on behalf of, the 58 | Licensor for the purpose of discussing and improving the Work, but 59 | excluding communication that is conspicuously marked or otherwise 60 | designated in writing by the copyright owner as "Not a Contribution." 61 | 62 | "Contributor" shall mean Licensor and any individual or Legal Entity 63 | on behalf of whom a Contribution has been received by Licensor and 64 | subsequently incorporated within the Work. 65 | 66 | 2. Grant of Copyright License. Subject to the terms and conditions of 67 | this License, each Contributor hereby grants to You a perpetual, 68 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 69 | copyright license to reproduce, prepare Derivative Works of, 70 | publicly display, publicly perform, sublicense, and distribute the 71 | Work and such Derivative Works in Source or Object form. 72 | 73 | 3. Grant of Patent License. Subject to the terms and conditions of 74 | this License, each Contributor hereby grants to You a perpetual, 75 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 76 | (except as stated in this section) patent license to make, have made, 77 | use, offer to sell, sell, import, and otherwise transfer the Work, 78 | where such license applies only to those patent claims licensable 79 | by such Contributor that are necessarily infringed by their 80 | Contribution(s) alone or by combination of their Contribution(s) 81 | with the Work to which such Contribution(s) was submitted. If You 82 | institute patent litigation against any entity (including a 83 | cross-claim or counterclaim in a lawsuit) alleging that the Work 84 | or a Contribution incorporated within the Work constitutes direct 85 | or contributory patent infringement, then any patent licenses 86 | granted to You under this License for that Work shall terminate 87 | as of the date such litigation is filed. 88 | 89 | 4. Redistribution. You may reproduce and distribute copies of the 90 | Work or Derivative Works thereof in any medium, with or without 91 | modifications, and in Source or Object form, provided that You 92 | meet the following conditions: 93 | 94 | (a) You must give any other recipients of the Work or 95 | Derivative Works a copy of this License; and 96 | 97 | (b) You must cause any modified files to carry prominent notices 98 | stating that You changed the files; and 99 | 100 | (c) You must retain, in the Source form of any Derivative Works 101 | that You distribute, all copyright, patent, trademark, and 102 | attribution notices from the Source form of the Work, 103 | excluding those notices that do not pertain to any part of 104 | the Derivative Works; and 105 | 106 | (d) If the Work includes a "NOTICE" text file as part of its 107 | distribution, then any Derivative Works that You distribute must 108 | include a readable copy of the attribution notices contained 109 | within such NOTICE file, excluding those notices that do not 110 | pertain to any part of the Derivative Works, in at least one 111 | of the following places: within a NOTICE text file distributed 112 | as part of the Derivative Works; within the Source form or 113 | documentation, if provided along with the Derivative Works; or, 114 | within a display generated by the Derivative Works, if and 115 | wherever such third-party notices normally appear. The contents 116 | of the NOTICE file are for informational purposes only and 117 | do not modify the License. You may add Your own attribution 118 | notices within Derivative Works that You distribute, alongside 119 | or as an addendum to the NOTICE text from the Work, provided 120 | that such additional attribution notices cannot be construed 121 | as modifying the License. 122 | 123 | You may add Your own copyright statement to Your modifications and 124 | may provide additional or different license terms and conditions 125 | for use, reproduction, or distribution of Your modifications, or 126 | for any such Derivative Works as a whole, provided Your use, 127 | reproduction, and distribution of the Work otherwise complies with 128 | the conditions stated in this License. 129 | 130 | 5. Submission of Contributions. Unless You explicitly state otherwise, 131 | any Contribution intentionally submitted for inclusion in the Work 132 | by You to the Licensor shall be under the terms and conditions of 133 | this License, without any additional terms or conditions. 134 | Notwithstanding the above, nothing herein shall supersede or modify 135 | the terms of any separate license agreement you may have executed 136 | with Licensor regarding such Contributions. 137 | 138 | 6. Trademarks. This License does not grant permission to use the trade 139 | names, trademarks, service marks, or product names of the Licensor, 140 | except as required for reasonable and customary use in describing the 141 | origin of the Work and reproducing the content of the NOTICE file. 142 | 143 | 7. Disclaimer of Warranty. Unless required by applicable law or 144 | agreed to in writing, Licensor provides the Work (and each 145 | Contributor provides its Contributions) on an "AS IS" BASIS, 146 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 147 | implied, including, without limitation, any warranties or conditions 148 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 149 | PARTICULAR PURPOSE. You are solely responsible for determining the 150 | appropriateness of using or redistributing the Work and assume any 151 | risks associated with Your exercise of permissions under this License. 152 | 153 | 8. Limitation of Liability. In no event and under no legal theory, 154 | whether in tort (including negligence), contract, or otherwise, 155 | unless required by applicable law (such as deliberate and grossly 156 | negligent acts) or agreed to in writing, shall any Contributor be 157 | liable to You for damages, including any direct, indirect, special, 158 | incidental, or consequential damages of any character arising as a 159 | result of this License or out of the use or inability to use the 160 | Work (including but not limited to damages for loss of goodwill, 161 | work stoppage, computer failure or malfunction, or any and all 162 | other commercial damages or losses), even if such Contributor 163 | has been advised of the possibility of such damages. 164 | 165 | 9. Accepting Warranty or Additional Liability. While redistributing 166 | the Work or Derivative Works thereof, You may choose to offer, 167 | and charge a fee for, acceptance of support, warranty, indemnity, 168 | or other liability obligations and/or rights consistent with this 169 | License. However, in accepting such obligations, You may act only 170 | on Your own behalf and on Your sole responsibility, not on behalf 171 | of any other Contributor, and only if You agree to indemnify, 172 | defend, and hold each Contributor harmless for any liability 173 | incurred by, or claims asserted against, such Contributor by reason 174 | of your accepting any such warranty or additional liability. 175 | 176 | END OF TERMS AND CONDITIONS 177 | 178 | APPENDIX: How to apply the Apache License to your work. 179 | 180 | To apply the Apache License to your work, attach the following 181 | boilerplate notice, with the fields enclosed by brackets "{}" 182 | replaced with your own identifying information. (Don't include 183 | the brackets!) The text should be enclosed in the appropriate 184 | comment syntax for the file format. We also recommend that a 185 | file or class name and description of purpose be included on the 186 | same "printed page" as the copyright notice for easier 187 | identification within third-party archives. 188 | 189 | Copyright {yyyy} {name of copyright owner} 190 | 191 | Licensed under the Apache License, Version 2.0 (the "License"); 192 | you may not use this file except in compliance with the License. 193 | You may obtain a copy of the License at 194 | 195 | http://www.apache.org/licenses/LICENSE-2.0 196 | 197 | Unless required by applicable law or agreed to in writing, software 198 | distributed under the License is distributed on an "AS IS" BASIS, 199 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 200 | See the License for the specific language governing permissions and 201 | limitations under the License. 202 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # DelphiWebDriver 2 | An attempt at building a Delphi implementation of the [W3C WebDriver](https://www.w3.org/TR/webdriver), so it can be embedded in a Delphi project 3 | 4 | Essentially a proof of concept / futile excerise. 5 | 6 | ## Currently Supported APIs 7 | 8 | | HTTP | Path | Status | 9 | | --- | --- | --- | 10 | | GET | /status | Functional | 11 | | POST | /session | Functional | 12 | | GET | /session/:sessionId | Functional | 13 | | GET | /session/:sessionId/title | In Progress | 14 | | GET | /session/:sessionId/element/:id | In Progress | 15 | | POST | /session/:sessionId/elements | Initial | 16 | | POST | /session/:sessionId/element | Initial | 17 | | GET | /session/:sessionId/screenshot | Initial | 18 | | POST | /session/:sessionId/element/:id/click | In Progress | 19 | | POST | /session/:sessionId/timeouts/implicit_wait | In Progress | 20 | | POST | /session/:sessionId/timeouts | In Progress | 21 | | GET | /sessions | In Progress | 22 | | DELETE | /session/:sessionId | Functional | 23 | | POST | /session/:sessionId/back | Not implemented | 24 | | POST | /session/:sessionId/forward | Not implemented | 25 | | GET | /session/:sessionId/source | Not implemented | 26 | | POST | /session/:sessionId/url | Not implemented | 27 | | POST | /session/:sessionId/appium/app/launch | Not implemented? | 28 | | POST | /session/:sessionId/appium/app/close | Not implemented? | 29 | | GET | /session/:sessionId/window | In Progress | 30 | | POST | /session/:sessionId/element/:id/value | In Progress | 31 | | GET | /session/:sessionId/element/:id/enabled | In Progress | 32 | | GET | /session/:sessionId/element/:id/rect | In Progress | 33 | 34 | NOTES: 35 | * Functional here means it has been at least partially implemented in both a host and a test client 36 | * Not Implemented commands are those that are usually to do with navigation, etc. in a browser 37 | 38 | ## To been implemented - not an exhaustive list yet 39 | 40 | | HTTP | Path | 41 | | --- | --- | 42 | | GET | /sessions | 43 | | POST | /session/:sessionId/buttondown | 44 | | POST | /session/:sessionId/buttonup | 45 | | POST | /session/:sessionId/click | 46 | | POST | /session/:sessionId/doubleclick | 47 | | POST | /session/:sessionId/element/active | 48 | | GET | /session/:sessionId/element/:id/attribute/:name | 49 | | POST | /session/:sessionId/element/:id/clear | 50 | | POST | /session/:sessionId/element/:id/click | 51 | | GET | /session/:sessionId/element/:id/displayed | 52 | | GET | /session/:sessionId/element/:id/element | 53 | | GET | /session/:sessionId/element/:id/elements | 54 | | GET | /session/:sessionId/element/:id/enabled | 55 | | GET | /session/:sessionId/element/:id/equals | 56 | | GET | /session/:sessionId/element/:id/location | 57 | | GET | /session/:sessionId/element/:id/location_in_view | 58 | | GET | /session/:sessionId/element/:id/name | 59 | | GET | /session/:sessionId/element/:id/screenshot | 60 | | GET | /session/:sessionId/element/:id/selected | 61 | | GET | /session/:sessionId/element/:id/size | 62 | | GET | /session/:sessionId/element/:id/text | 63 | | GET | /session/:sessionId/element/:id/rect | 64 | | POST | /session/:sessionId/element/:id/value | 65 | | POST | /session/:sessionId/keys | 66 | | GET | /session/:sessionId/location | 67 | | POST | /session/:sessionId/moveto | 68 | | GET | /session/:sessionId/orientation | 69 | | GET | /session/:sessionId/screenshot | 70 | | GET | /session/:sessionId/title | 71 | | POST | /session/:sessionId/touch/click | 72 | | POST | /session/:sessionId/touch/doubleclick | 73 | | POST | /session/:sessionId/touch/longclick | 74 | | POST | /session/:sessionId/touch/flick | 75 | | POST | /session/:sessionId/touch/scroll | 76 | | DELETE | /session/:sessionId/window | 77 | | POST | /session/:sessionId/window | 78 | | GET | /session/:sessionId/window/handles | 79 | | POST | /session/:sessionId/window/maximize | 80 | | POST | /session/:sessionId/window/size | 81 | | GET | /session/:sessionId/window/size | 82 | | POST | /session/:sessionId/window/:windowHandle/size | 83 | | GET | /session/:sessionId/window/:windowHandle/size | 84 | | POST | /session/:sessionId/window/:windowHandle/position | 85 | | GET | /session/:sessionId/window/:windowHandle/position | 86 | | POST | /session/:sessionId/window/:windowHandle/maximize | 87 | | GET | /session/:sessionId/window_handle | 88 | | GET | /session/:sessionId/window_handles | 89 | 90 | -------------------------------------------------------------------------------- /ResourceProcessing.pas: -------------------------------------------------------------------------------- 1 | unit ResourceProcessing; 2 | 3 | interface 4 | 5 | function GetModuleVersion: String; 6 | function GetAppRevision: String; 7 | 8 | implementation 9 | 10 | uses 11 | System.Types, 12 | System.SysUtils, 13 | System.StrUtils, 14 | System.Classes, 15 | Winapi.Windows; 16 | 17 | // via http://stackoverflow.com/questions/10854958/how-to-get-version-of-running-executable 18 | function GetFullModuleVersion(Instance: THandle; out iMajor, iMinor, iRelease, iBuild: Integer): Boolean; 19 | var 20 | fileInformation: PVSFIXEDFILEINFO; 21 | verlen: Cardinal; 22 | rs: TResourceStream; 23 | m: TMemoryStream; 24 | begin 25 | if Instance = 0 then 26 | Instance := HInstance; 27 | 28 | FindResource(Instance, MAKEINTRESOURCE(100), RT_VERSION); 29 | 30 | m := TMemoryStream.Create; 31 | try 32 | rs := TResourceStream.CreateFromID(Instance, 1, RT_VERSION); 33 | try 34 | m.CopyFrom(rs, rs.Size); 35 | finally 36 | rs.Free; 37 | end; 38 | 39 | m.Position:=0; 40 | if not VerQueryValue(m.Memory, '\', (*var*)Pointer(fileInformation), (*var*)verlen) then 41 | begin 42 | iMajor := 0; 43 | iMinor := 0; 44 | iRelease := 0; 45 | iBuild := 0; 46 | Exit(false); 47 | end; 48 | 49 | iMajor := fileInformation.dwFileVersionMS shr 16; 50 | iMinor := fileInformation.dwFileVersionMS and $FFFF; 51 | iRelease := fileInformation.dwFileVersionLS shr 16; 52 | iBuild := fileInformation.dwFileVersionLS and $FFFF; 53 | finally 54 | m.Free; 55 | end; 56 | 57 | Result := True; 58 | end; 59 | 60 | function GetModuleVersion: String; 61 | var 62 | minor, major, release, build : integer; 63 | begin 64 | GetFullModuleVersion (0, major, minor, release, build); 65 | 66 | result := Format('%d.%d', [major, minor]); 67 | end; 68 | 69 | function GetAppRevision: String; 70 | var 71 | minor, major, release, build : integer; 72 | begin 73 | GetFullModuleVersion (0, major, minor, release, build); 74 | 75 | result := Format('%d.%d', [release, build]); 76 | end; 77 | 78 | end. 79 | -------------------------------------------------------------------------------- /RestServer.pas: -------------------------------------------------------------------------------- 1 | unit RestServer; 2 | 3 | interface 4 | 5 | uses 6 | Vcl.Forms, 7 | HttpServerCommand, 8 | IdHTTPServer, IdContext, IdHeaderList, IdCustomHTTPServer, 9 | classes, 10 | IdUri, 11 | System.SysUtils; 12 | 13 | type 14 | TRestServer = Class 15 | strict private 16 | FOwner: TComponent; 17 | FCommand: THttpServerCommand; 18 | FHttpServer : TIdHTTPServer; 19 | FOnLogMessage: TOnLogMessage; 20 | private 21 | procedure OnCommandGet(AContext: TIdContext; 22 | ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); 23 | 24 | //procedure OnCommandOther(ACommand, AData, AVersion, Thread); 25 | 26 | procedure CreatePostStream(AContext: TIdContext; AHeaders: TIdHeaderList; 27 | var VPostStream: TStream); 28 | procedure LogMessage(const msg: String); 29 | public 30 | constructor Create(AOwner: TComponent); 31 | procedure Start(port: word); 32 | property OnLogMessage: TOnLogMessage read FOnLogMessage write FOnLogMessage; 33 | end; 34 | 35 | implementation 36 | 37 | uses 38 | Commands.GetWindowHandle, 39 | Commands.DeleteSession, 40 | Commands.PostElementElements, 41 | Commands.PostExecute, 42 | Commands.GetElementValue, 43 | Commands.PostClear, 44 | Commands.GetText, 45 | Commands.ClickElement, 46 | Commands.GetRect, 47 | Commands.PostElements, 48 | Commands.PostElement, 49 | Commands.CreateSession, 50 | Commands.GetEnabled, 51 | Commands.PostValue, 52 | System.JSON.Types, 53 | System.JSON.Writers, 54 | System.JSON.Builders, 55 | Commands; 56 | 57 | { TRestServer } 58 | 59 | constructor TRestServer.Create(AOwner: TComponent); 60 | begin 61 | inherited Create; 62 | 63 | FOwner := AOwner; 64 | 65 | FCommand:= THttpServerCommand.Create(AOwner); 66 | 67 | FCommand.Commands.Register(TGetElementValueCommand); 68 | 69 | FCommand.Commands.Register(TGetEnabledCommand); 70 | FCommand.Commands.Register(TGetRectCommand); 71 | FCommand.Commands.Register(TGetTextCommand); 72 | // FCommand.Commands.Register(TGetElementCommand); 73 | //FCommand.Commands.Register(TGetScreenshotCommand); 74 | FCommand.Commands.Register(TGetWindowhandleCommand); 75 | FCommand.Commands.Register(TGetWindowCommand); 76 | FCommand.Commands.Register(TGetTitleCommand); 77 | FCommand.Commands.Register(TGetSessionCommand); 78 | FCommand.Commands.Register(TGetSessionsCommand); 79 | FCommand.Commands.Register(TStatusCommand); 80 | FCommand.Commands.Register(TPostValueCommand); 81 | FCommand.Commands.Register(TPostClearCommand); 82 | FCommand.Commands.Register(TClickElementCommand); 83 | FCommand.Commands.Register(TPostElementElementsCommand); 84 | 85 | // Avoiding mismatch with pattern above 86 | FCommand.Commands.Register(TPostElementsCommand); 87 | FCommand.Commands.Register(TPostElementCommand); 88 | FCommand.Commands.Register(TPostExecuteCommand); 89 | FCommand.Commands.Register(TPostImplicitWaitCommand); 90 | FCommand.Commands.Register(TSessionTimeoutsCommand); 91 | FCommand.Commands.Register(TCreateSessionCommand); 92 | FCommand.Commands.Register(TDeleteSessionCommand); 93 | 94 | FCommand.OnLogMessage := FOnLogMessage; 95 | 96 | FHttpServer := TIdHTTPServer.Create(AOwner); 97 | end; 98 | 99 | 100 | procedure TRestServer.CreatePostStream(AContext: TIdContext; 101 | AHeaders: TIdHeaderList; var VPostStream: TStream); 102 | begin 103 | VPostStream := TStringStream.Create; 104 | end; 105 | 106 | procedure TRestServer.LogMessage(const msg: String); 107 | begin 108 | if assigned(FOnLogMessage) then 109 | OnLogMessage(msg); 110 | end; 111 | 112 | procedure TRestServer.OnCommandGet(AContext: TIdContext; 113 | ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); 114 | var 115 | cmd: String; 116 | 117 | begin 118 | cmd := ARequestInfo.Command; 119 | 120 | LogMessage('==================================================='); 121 | LogMessage(ARequestInfo.Command + ' ' + ARequestInfo.uri + ' ' + ARequestInfo.Version); 122 | LogMessage('Accept-Encoding: ' + ARequestInfo.AcceptEncoding); 123 | LogMessage('Connection: ' + ARequestInfo.Connection); 124 | LogMessage('Content-Length: ' + Inttostr(ARequestInfo.ContentLength)); 125 | LogMessage('Content-Type: ' + ARequestInfo.ContentType); 126 | LogMessage('Host: ' + ARequestInfo.Host); 127 | LogMessage(ARequestInfo.UserAgent); 128 | 129 | LogMessage(ARequestInfo.Params.CommaText); 130 | 131 | FCommand.CommandGet(AContext, ARequestInfo, AResponseInfo); 132 | 133 | LogMessage(''); 134 | LogMessage('Response: ' + IntToStr(AResponseInfo.ResponseNo)); 135 | // LogMessage('Content-Length:' + Inttostr(AResponseInfo.ContentLength)); 136 | LogMessage('Content-Type: ' + AResponseInfo.ContentType); 137 | LogMessage(AResponseInfo.ContentText); 138 | end; 139 | 140 | procedure TRestServer.Start(port: word); 141 | begin 142 | FHttpServer.DefaultPort := port; 143 | FHttpServer.OnCommandGet := OnCommandGet; 144 | FHttpServer.OnCommandOther := OnCommandGet; 145 | FHttpServer.OnCreatePostStream := CreatePostStream; 146 | FHttpServer.Active := True; 147 | end; 148 | 149 | end. 150 | -------------------------------------------------------------------------------- /Server.dpr: -------------------------------------------------------------------------------- 1 | program Server; 2 | 3 | uses 4 | Vcl.Forms, 5 | Unit1 in 'Unit1.pas' {Form1}, 6 | RestServer in 'RestServer.pas', 7 | CommandRegistry in 'CommandRegistry.pas', 8 | Commands in 'Commands.pas', 9 | Session in 'Session.pas', 10 | HttpServerCommand in 'HttpServerCommand.pas', 11 | ResourceProcessing in 'ResourceProcessing.pas', 12 | Sessions in 'Sessions.pas', 13 | JsonAttributeSource in 'JsonAttributeSource.pas', 14 | Commands.PostElement in 'Commands.PostElement.pas', 15 | Commands.PostElements in 'Commands.PostElements.pas', 16 | Commands.ClickElement in 'Commands.ClickElement.pas', 17 | Utils in 'Utils.pas', 18 | Commands.PostElementElementsCommand in 'Commands.PostElementElementsCommand.pas', 19 | Commands.GetText in 'Commands.GetText.pas', 20 | Commands.GetRect in 'Commands.GetRect.pas'; 21 | 22 | {$R *.res} 23 | 24 | begin 25 | Application.Initialize; 26 | Application.MainFormOnTaskbar := True; 27 | Application.CreateForm(TForm1, Form1); 28 | Application.Run; 29 | end. 30 | -------------------------------------------------------------------------------- /Server.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mmarquee/DelphiWebDriver/312fcb62fdc86af8364af4465c5ecaad1aa2acb4/Server.res -------------------------------------------------------------------------------- /ServerAndClient.groupproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {F0632DB7-C065-419A-AD41-FF66399F1522} 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | Default.Personality.12 18 | 19 | 20 | 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 | -------------------------------------------------------------------------------- /Session.pas: -------------------------------------------------------------------------------- 1 | unit Session; 2 | 3 | interface 4 | 5 | uses 6 | JsonAttributeSource, 7 | System.Classes; 8 | 9 | type 10 | { Will use attributes later, maybe } 11 | TStatus = class 12 | public 13 | [JsonAttribute('sessionId')] 14 | Guid: String; 15 | [JsonAttribute('args')] 16 | Args: String; 17 | [JsonAttribute('app')] 18 | App: String; 19 | [JsonAttribute('platform')] 20 | Platform: String; 21 | 22 | function ToJsonString: String; 23 | end; 24 | 25 | type 26 | TSession = class 27 | private 28 | FStatus: TStatus; 29 | FTimeouts: Integer; 30 | 31 | function GetUid: String; 32 | procedure SetUid(val: String); 33 | 34 | public 35 | function GetSessionDetails: String; 36 | function GetSession: String; 37 | 38 | property Uid: String read GetUid write SetUid; 39 | property Timeouts: Integer write FTimeouts; 40 | 41 | constructor Create(const request: String); 42 | end; 43 | 44 | implementation 45 | 46 | uses 47 | ResourceProcessing, 48 | System.JSON, 49 | System.Types, 50 | System.SysUtils, 51 | System.StrUtils, 52 | System.JSON.Types, 53 | System.JSON.Writers, 54 | System.JSON.Builders; 55 | 56 | { TSession } 57 | 58 | constructor TSession.Create; 59 | var 60 | jsonObj : TJSONObject; 61 | requestObj : TJSONValue; 62 | guid: TGuid; 63 | value: String; 64 | 65 | begin 66 | FStatus:= TStatus.Create; 67 | 68 | if CreateGUID(Guid) <> 0 then 69 | raise Exception.Create('Unable to generate GUID') 70 | else 71 | begin 72 | // Decode the incoming JSON and see what we have 73 | jsonObj := TJSONObject.ParseJSONValue(TEncoding.ASCII.GetBytes(request),0) as TJSONObject; 74 | try 75 | requestObj := jsonObj.Get('desiredCapabilities').JsonValue; 76 | 77 | (requestObj as TJsonObject).TryGetValue('args', FStatus.Args); 78 | (requestObj as TJsonObject).TryGetValue('app', FStatus.App); 79 | (requestObj as TJsonObject).TryGetValue('platformName', FStatus.Platform); 80 | 81 | value := Guid.ToString; 82 | delete(value,length(value),1); 83 | delete(value,1,1); 84 | 85 | FStatus.Guid := value; 86 | 87 | finally 88 | jsonObj.Free; 89 | end; 90 | end; 91 | end; 92 | 93 | function TSession.GetSession: String; 94 | begin 95 | result := GetSessionDetails; 96 | end; 97 | 98 | function TSession.GetSessionDetails: String; 99 | begin 100 | result := FStatus.ToJsonString; 101 | end; 102 | 103 | function TSession.GetUid: String; 104 | begin 105 | result := FStatus.Guid; 106 | end; 107 | 108 | procedure TSession.SetUid(val: String); 109 | begin 110 | FStatus.Guid := val; 111 | end; 112 | 113 | function TStatus.ToJsonString: String; 114 | var 115 | Builder: TJSONObjectBuilder; 116 | Writer: TJsonTextWriter; 117 | StringWriter: TStringWriter; 118 | StringBuilder: TStringBuilder; 119 | 120 | begin 121 | StringBuilder := TStringBuilder.Create; 122 | StringWriter := TStringWriter.Create(StringBuilder); 123 | Writer := TJsonTextWriter.Create(StringWriter); 124 | Writer.Formatting := TJsonFormatting.Indented; 125 | Builder := TJSONObjectBuilder.Create(Writer); 126 | 127 | Builder 128 | .BeginObject() 129 | .Add('sessionId', self.Guid) 130 | .Add('status', 0) 131 | .BeginObject('value') 132 | .Add('app', self.App) 133 | .Add('args', self.Args) 134 | .Add('platformName', self.Platform) 135 | .EndObject 136 | .EndObject; 137 | 138 | result := StringBuilder.ToString; 139 | end; 140 | 141 | end. 142 | -------------------------------------------------------------------------------- /Sessions.pas: -------------------------------------------------------------------------------- 1 | unit Sessions; 2 | 3 | interface 4 | 5 | uses 6 | generics.collections, 7 | Session; 8 | 9 | Type 10 | TSessions = class 11 | strict private 12 | FSessions: TObjectList; 13 | public 14 | constructor Create; 15 | destructor Destroy; override; 16 | 17 | function GetSession(const sessionId: String): TSession; 18 | function GetSessionStatus(const sessionId: String): String; 19 | procedure DeleteSession(const sessionId: String); 20 | procedure Add(session: TSession); 21 | function SetSessionTimeouts(const sessionId: String; ms: integer): String; 22 | function SetSessionImplicitTimeouts(const sessionId: String; ms: integer): String; 23 | function Count: Integer; 24 | function GetStatus: String; 25 | 26 | function OKResponse(const sessionId: String): String; 27 | function ErrorResponse(const sessionId, code, msg: String): String; 28 | 29 | function FindElement(const sessionId: String): String; 30 | end; 31 | 32 | implementation 33 | 34 | uses 35 | System.StrUtils, 36 | System.JSON.Types, 37 | System.Classes, 38 | System.JSON.Writers, 39 | System.JSON.Builders, 40 | System.SysUtils, 41 | ResourceProcessing; 42 | 43 | { TSessions } 44 | 45 | constructor TSessions.Create; 46 | begin 47 | inherited; 48 | FSessions:= TObjectList.create; 49 | end; 50 | 51 | destructor TSessions.Destroy; 52 | begin 53 | FSessions.Free; 54 | inherited; 55 | end; 56 | 57 | function TSessions.GetSession(const sessionId: String): TSession; 58 | var 59 | i : integer; 60 | 61 | begin 62 | // Probably a better way of doing this! 63 | result := nil; 64 | 65 | for i := 0 to FSessions.Count -1 do 66 | begin 67 | if FSessions[i].Uid = sessionId then 68 | begin 69 | result := FSessions[i]; 70 | break; 71 | end; 72 | end; 73 | 74 | if result = nil then 75 | raise Exception.create('Cannot find session'); 76 | end; 77 | 78 | function TSessions.SetSessionImplicitTimeouts(const sessionId: String; ms: integer): String; 79 | var 80 | i : integer; 81 | found : boolean; 82 | 83 | begin 84 | found := false; 85 | 86 | // Probably a better way of doing this! 87 | for i := 0 to FSessions.Count -1 do 88 | begin 89 | if FSessions[i].Uid = sessionId then 90 | begin 91 | // Dodgy 92 | found := true; 93 | FSessions[i].Timeouts := ms; 94 | break; 95 | end; 96 | end; 97 | 98 | if not found then 99 | raise Exception.create('Cannot find session'); 100 | 101 | result := self.OKResponse(sessionId); 102 | end; 103 | 104 | function TSessions.SetSessionTimeouts(const sessionId: String; ms: integer): String; 105 | var 106 | i : integer; 107 | found : boolean; 108 | 109 | begin 110 | found := false; 111 | 112 | // Probably a better way of doing this! 113 | for i := 0 to FSessions.Count -1 do 114 | begin 115 | if FSessions[i].Uid = sessionId then 116 | begin 117 | // Dodgy 118 | found := true; 119 | FSessions[i].Timeouts := ms; 120 | break; 121 | end; 122 | end; 123 | 124 | if not found then 125 | raise Exception.create('Cannot find session'); 126 | 127 | result := self.OKResponse(sessionId); 128 | end; 129 | 130 | function TSessions.ErrorResponse(const sessionId, code, msg: String): String; 131 | var 132 | Builder: TJSONObjectBuilder; 133 | Writer: TJsonTextWriter; 134 | StringWriter: TStringWriter; 135 | StringBuilder: TStringBuilder; 136 | 137 | begin 138 | // Construct reply 139 | StringBuilder := TStringBuilder.Create; 140 | StringWriter := TStringWriter.Create(StringBuilder); 141 | Writer := TJsonTextWriter.Create(StringWriter); 142 | Writer.Formatting := TJsonFormatting.Indented; 143 | Builder := TJSONObjectBuilder.Create(Writer); 144 | 145 | Builder 146 | .BeginObject() 147 | .Add('sessionId', sessionId) 148 | .Add('status', code) 149 | .BeginObject('value') 150 | .Add('error', code) 151 | .Add('message', code) 152 | .EndObject 153 | .EndObject; 154 | 155 | result := StringBuilder.ToString; 156 | end; 157 | 158 | function TSessions.OKResponse(const sessionId: String): String; 159 | var 160 | Builder: TJSONObjectBuilder; 161 | Writer: TJsonTextWriter; 162 | StringWriter: TStringWriter; 163 | StringBuilder: TStringBuilder; 164 | 165 | begin 166 | // Construct reply 167 | StringBuilder := TStringBuilder.Create; 168 | StringWriter := TStringWriter.Create(StringBuilder); 169 | Writer := TJsonTextWriter.Create(StringWriter); 170 | Writer.Formatting := TJsonFormatting.Indented; 171 | Builder := TJSONObjectBuilder.Create(Writer); 172 | 173 | Builder 174 | .BeginObject() 175 | .Add('sessionId', sessionId) 176 | .Add('status', 0) 177 | .EndObject; 178 | 179 | result := StringBuilder.ToString; 180 | end; 181 | 182 | function TSessions.GetSessionStatus(const sessionId: String) : String; 183 | begin 184 | result := self.GetStatus; 185 | end; 186 | 187 | function TSessions.Count: Integer; 188 | begin 189 | result := FSessions.Count; 190 | end; 191 | 192 | procedure TSessions.Add(session: TSession); 193 | begin 194 | FSessions.Add(session); 195 | end; 196 | 197 | procedure TSessions.DeleteSession(const sessionId: String); 198 | var 199 | i : integer; 200 | found : boolean; 201 | begin 202 | found := false; 203 | 204 | // Probably a better way of doing this! 205 | for i := 0 to FSessions.Count -1 do 206 | begin 207 | if FSessions[i].Uid = sessionId then 208 | begin 209 | // Dodgy 210 | found := true; 211 | FSessions.Delete(i); 212 | break; 213 | end; 214 | end; 215 | 216 | if not found then 217 | raise Exception.create('Cannot find session'); 218 | end; 219 | 220 | function OSArchitectureToString(arch: TOSVersion.TArchitecture): String; 221 | begin 222 | case arch of 223 | arIntelX86: result := 'Intel X86'; 224 | arIntelX64: result := 'Intel X64'; 225 | arArm64: result := 'ARM 64'; 226 | arArm32: result := 'ARM 32'; 227 | else 228 | result := 'Unknown'; 229 | end; 230 | end; 231 | 232 | function TSessions.FindElement(const sessionId: String): String; 233 | begin 234 | result := 'N/A'; 235 | //comp := (self.Reg.FHost.FindComponent(self.Params[2])); 236 | end; 237 | 238 | function TSessions.GetStatus: String; 239 | var 240 | Builder: TJSONObjectBuilder; 241 | Writer: TJsonTextWriter; 242 | StringWriter: TStringWriter; 243 | StringBuilder: TStringBuilder; 244 | 245 | begin 246 | StringBuilder := TStringBuilder.Create; 247 | StringWriter := TStringWriter.Create(StringBuilder); 248 | Writer := TJsonTextWriter.Create(StringWriter); 249 | Writer.Formatting := TJsonFormatting.Indented; 250 | Builder := TJSONObjectBuilder.Create(Writer); 251 | 252 | Builder 253 | .BeginObject 254 | .BeginObject('build') 255 | .Add('version', GetModuleVersion) 256 | .Add('revision', GetAppRevision) 257 | .Add('time', 2.1) 258 | .EndObject 259 | .BeginObject('os') 260 | .Add('arch', OSArchitectureToString(TOSVersion.Architecture)) 261 | .Add('name', TOSVersion.Name) 262 | .Add('version', IntToStr(TOSVersion.Major) + '.' + IntToStr(TOSVersion.Minor)) 263 | .EndObject 264 | .EndObject; 265 | 266 | result := StringBuilder.ToString; 267 | end; 268 | 269 | end. 270 | -------------------------------------------------------------------------------- /TestClient/TestClient.dpr: -------------------------------------------------------------------------------- 1 | program TestClient; 2 | 3 | uses 4 | Vcl.Forms, 5 | Unit3 in 'Unit3.pas' {Form3}; 6 | 7 | {$R *.res} 8 | 9 | begin 10 | Application.Initialize; 11 | Application.MainFormOnTaskbar := True; 12 | Application.CreateForm(TForm3, Form3); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /TestClient/TestClient.dproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {AD8B89D5-8BC4-42CC-AFE0-A4E9E8A176AA} 4 | 18.2 5 | VCL 6 | TestClient.dpr 7 | True 8 | Debug 9 | Win32 10 | 1 11 | Application 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | true 28 | Cfg_1 29 | true 30 | true 31 | 32 | 33 | true 34 | Base 35 | true 36 | 37 | 38 | true 39 | Cfg_2 40 | true 41 | true 42 | 43 | 44 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png 45 | TestClient 46 | $(BDS)\bin\delphi_PROJECTICON.ico 47 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png 48 | System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) 49 | .\$(Platform)\$(Config) 50 | .\$(Platform)\$(Config) 51 | false 52 | false 53 | false 54 | false 55 | false 56 | 57 | 58 | $(BDS)\bin\default_app.manifest 59 | true 60 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 61 | Debug 62 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= 63 | 1033 64 | DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;vcl;IndyIPServer;vclactnband;advchartd320;vclFireDAC;IndySystem;NMWrappers320;tethering;svnui;dsnapcon;FireDACADSDriver;madExcept_;FireDACMSAccDriver;fmxFireDAC;vclimg;madBasic_;TeeDB;FireDAC;AutomatedControls;vcltouch;vcldb;bindcompfmx;svn;FireDACSqliteDriver;FireDACPgDriver;inetdb;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;FireDACIBDriver;fmx;fmxdae;xmlrtl;soapmidas;frx24;fmxobj;vclwinx;Tee;rtl;madDisAsm_;DbxClientDriver;DocGen320;frxTee24;CustomIPTransport;vcldsnap;dbexpress;IndyCore;VersionInfo320;vclx;bindcomp;appanalytics;dsnap;FireDACCommon;IndyIPClient;Package1;bindcompvcl;RESTBackendComponents;frxe24;TeeUI;VCLRESTComponents;soapserver;dbxcds;VclSmp;adortl;vclie;bindengine;DBXMySQLDriver;CloudService;dsnapxml;FireDACMySQLDriver;dbrtl;IndyProtocols;inetdbxpress;frxDB24;FireDACCommonODBC;FireDACCommonDriver;XACompPackage320;inet;fmxase;$(DCC_UsePackage) 65 | 66 | 67 | DEBUG;$(DCC_Define) 68 | true 69 | false 70 | true 71 | true 72 | true 73 | 74 | 75 | true 76 | true 77 | false 78 | 79 | 80 | false 81 | RELEASE;$(DCC_Define) 82 | 0 83 | 0 84 | 85 | 86 | true 87 | true 88 | 89 | 90 | 91 | MainSource 92 | 93 | 94 |
Form3
95 | dfm 96 | 97 | 98 | Cfg_2 99 | Base 100 | 101 | 102 | Base 103 | 104 | 105 | Cfg_1 106 | Base 107 | 108 | 109 | 110 | Delphi.Personality.12 111 | Application 112 | 113 | 114 | 115 | TestClient.dpr 116 | 117 | 118 | 119 | 120 | 121 | TestClient.exe 122 | true 123 | 124 | 125 | 126 | 127 | 1 128 | 129 | 130 | 1 131 | 132 | 133 | 134 | 135 | Contents\Resources 136 | 1 137 | 138 | 139 | 140 | 141 | classes 142 | 1 143 | 144 | 145 | 146 | 147 | Contents\MacOS 148 | 0 149 | 150 | 151 | 1 152 | 153 | 154 | Contents\MacOS 155 | 1 156 | 157 | 158 | 159 | 160 | 1 161 | 162 | 163 | 1 164 | 165 | 166 | 1 167 | 168 | 169 | 170 | 171 | res\drawable-xxhdpi 172 | 1 173 | 174 | 175 | 176 | 177 | library\lib\mips 178 | 1 179 | 180 | 181 | 182 | 183 | 1 184 | 185 | 186 | 1 187 | 188 | 189 | 0 190 | 191 | 192 | 1 193 | 194 | 195 | Contents\MacOS 196 | 1 197 | 198 | 199 | library\lib\armeabi-v7a 200 | 1 201 | 202 | 203 | 1 204 | 205 | 206 | 207 | 208 | 0 209 | 210 | 211 | Contents\MacOS 212 | 1 213 | .framework 214 | 215 | 216 | 217 | 218 | 1 219 | 220 | 221 | 1 222 | 223 | 224 | 225 | 226 | 1 227 | 228 | 229 | 1 230 | 231 | 232 | 1 233 | 234 | 235 | 236 | 237 | 1 238 | 239 | 240 | 1 241 | 242 | 243 | 1 244 | 245 | 246 | 247 | 248 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 249 | 1 250 | 251 | 252 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 253 | 1 254 | 255 | 256 | 257 | 258 | 1 259 | 260 | 261 | 1 262 | 263 | 264 | 1 265 | 266 | 267 | 268 | 269 | 1 270 | 271 | 272 | 1 273 | 274 | 275 | 1 276 | 277 | 278 | 279 | 280 | library\lib\armeabi 281 | 1 282 | 283 | 284 | 285 | 286 | 0 287 | 288 | 289 | 1 290 | 291 | 292 | Contents\MacOS 293 | 1 294 | 295 | 296 | 297 | 298 | 1 299 | 300 | 301 | 1 302 | 303 | 304 | 1 305 | 306 | 307 | 308 | 309 | res\drawable-normal 310 | 1 311 | 312 | 313 | 314 | 315 | res\drawable-xhdpi 316 | 1 317 | 318 | 319 | 320 | 321 | res\drawable-large 322 | 1 323 | 324 | 325 | 326 | 327 | 1 328 | 329 | 330 | 1 331 | 332 | 333 | 1 334 | 335 | 336 | 337 | 338 | Assets 339 | 1 340 | 341 | 342 | Assets 343 | 1 344 | 345 | 346 | 347 | 348 | ..\ 349 | 1 350 | 351 | 352 | ..\ 353 | 1 354 | 355 | 356 | 357 | 358 | res\drawable-hdpi 359 | 1 360 | 361 | 362 | 363 | 364 | library\lib\armeabi-v7a 365 | 1 366 | 367 | 368 | 369 | 370 | Contents 371 | 1 372 | 373 | 374 | 375 | 376 | ..\ 377 | 1 378 | 379 | 380 | 381 | 382 | Assets 383 | 1 384 | 385 | 386 | Assets 387 | 1 388 | 389 | 390 | 391 | 392 | 1 393 | 394 | 395 | 1 396 | 397 | 398 | 1 399 | 400 | 401 | 402 | 403 | res\values 404 | 1 405 | 406 | 407 | 408 | 409 | res\drawable-small 410 | 1 411 | 412 | 413 | 414 | 415 | res\drawable 416 | 1 417 | 418 | 419 | 420 | 421 | 1 422 | 423 | 424 | 1 425 | 426 | 427 | 1 428 | 429 | 430 | 431 | 432 | 1 433 | 434 | 435 | 436 | 437 | res\drawable 438 | 1 439 | 440 | 441 | 442 | 443 | 0 444 | 445 | 446 | 0 447 | 448 | 449 | Contents\Resources\StartUp\ 450 | 0 451 | 452 | 453 | 0 454 | 455 | 456 | 0 457 | 458 | 459 | 0 460 | 461 | 462 | 463 | 464 | library\lib\armeabi-v7a 465 | 1 466 | 467 | 468 | 469 | 470 | 0 471 | .bpl 472 | 473 | 474 | 1 475 | .dylib 476 | 477 | 478 | Contents\MacOS 479 | 1 480 | .dylib 481 | 482 | 483 | 1 484 | .dylib 485 | 486 | 487 | 1 488 | .dylib 489 | 490 | 491 | 492 | 493 | res\drawable-mdpi 494 | 1 495 | 496 | 497 | 498 | 499 | res\drawable-xlarge 500 | 1 501 | 502 | 503 | 504 | 505 | res\drawable-ldpi 506 | 1 507 | 508 | 509 | 510 | 511 | 0 512 | .dll;.bpl 513 | 514 | 515 | 1 516 | .dylib 517 | 518 | 519 | Contents\MacOS 520 | 1 521 | .dylib 522 | 523 | 524 | 1 525 | .dylib 526 | 527 | 528 | 1 529 | .dylib 530 | 531 | 532 | 533 | 534 | 535 | 536 | 537 | 538 | 539 | 540 | 541 | 542 | True 543 | 544 | 545 | 12 546 | 547 | 548 | 549 | 550 | 551 | -------------------------------------------------------------------------------- /TestClient/TestClient.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mmarquee/DelphiWebDriver/312fcb62fdc86af8364af4465c5ecaad1aa2acb4/TestClient/TestClient.res -------------------------------------------------------------------------------- /TestClient/Unit3.dfm: -------------------------------------------------------------------------------- 1 | object Form3: TForm3 2 | Left = 0 3 | Top = 0 4 | Caption = 'Form3' 5 | ClientHeight = 639 6 | ClientWidth = 909 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 | DesignSize = ( 15 | 909 16 | 639) 17 | PixelsPerInch = 96 18 | TextHeight = 13 19 | object ListBox1: TListBox 20 | Left = 8 21 | Top = 8 22 | Width = 893 23 | Height = 341 24 | Anchors = [akLeft, akTop, akRight] 25 | ItemHeight = 13 26 | TabOrder = 0 27 | end 28 | object btnStartSession: TButton 29 | Left = 8 30 | Top = 355 31 | Width = 75 32 | Height = 25 33 | Caption = 'Start Session' 34 | TabOrder = 1 35 | OnClick = btnStartSessionClick 36 | end 37 | object Button1: TButton 38 | Left = 8 39 | Top = 386 40 | Width = 75 41 | Height = 25 42 | Caption = 'Status' 43 | TabOrder = 2 44 | OnClick = Button1Click 45 | end 46 | object Button2: TButton 47 | Left = 89 48 | Top = 355 49 | Width = 75 50 | Height = 25 51 | Caption = 'Timeout' 52 | TabOrder = 3 53 | OnClick = Button2Click 54 | end 55 | object StaticText1: TStaticText 56 | Left = 176 57 | Top = 355 58 | Width = 616 59 | Height = 25 60 | Anchors = [akLeft, akTop, akRight] 61 | AutoSize = False 62 | TabOrder = 4 63 | end 64 | object Button3: TButton 65 | Left = 89 66 | Top = 386 67 | Width = 75 68 | Height = 25 69 | Caption = 'Async' 70 | TabOrder = 5 71 | OnClick = Button3Click 72 | end 73 | object Button4: TButton 74 | Left = 170 75 | Top = 386 76 | Width = 75 77 | Height = 25 78 | Caption = 'Get Element' 79 | TabOrder = 6 80 | OnClick = Button4Click 81 | end 82 | object Button5: TButton 83 | Left = 251 84 | Top = 386 85 | Width = 75 86 | Height = 25 87 | Caption = 'Get Session' 88 | TabOrder = 7 89 | OnClick = Button5Click 90 | end 91 | object Button6: TButton 92 | Left = 332 93 | Top = 386 94 | Width = 75 95 | Height = 25 96 | Caption = 'Get Sessions' 97 | TabOrder = 8 98 | OnClick = Button6Click 99 | end 100 | object Button7: TButton 101 | Left = 413 102 | Top = 386 103 | Width = 75 104 | Height = 25 105 | Caption = 'Delete Session' 106 | TabOrder = 9 107 | OnClick = DeleteClick 108 | end 109 | object Button8: TButton 110 | Left = 544 111 | Top = 384 112 | Width = 75 113 | Height = 25 114 | Caption = 'Error' 115 | TabOrder = 10 116 | OnClick = Button8Click 117 | end 118 | object Button9: TButton 119 | Left = 8 120 | Top = 456 121 | Width = 75 122 | Height = 25 123 | Caption = 'Click OK' 124 | TabOrder = 11 125 | OnClick = Button9Click 126 | end 127 | object Button10: TButton 128 | Left = 8 129 | Top = 487 130 | Width = 75 131 | Height = 25 132 | Caption = 'Click Cancel' 133 | TabOrder = 12 134 | OnClick = Button10Click 135 | end 136 | object Button11: TButton 137 | Left = 89 138 | Top = 456 139 | Width = 75 140 | Height = 25 141 | Caption = 'Click Error' 142 | TabOrder = 13 143 | OnClick = Button11Click 144 | end 145 | object Button12: TButton 146 | Left = 170 147 | Top = 456 148 | Width = 75 149 | Height = 25 150 | Caption = 'Title' 151 | TabOrder = 14 152 | OnClick = Button12Click 153 | end 154 | object Button13: TButton 155 | Left = 170 156 | Top = 487 157 | Width = 75 158 | Height = 25 159 | Caption = 'Text' 160 | TabOrder = 15 161 | OnClick = Button13Click 162 | end 163 | object Button14: TButton 164 | Left = 413 165 | Top = 417 166 | Width = 75 167 | Height = 25 168 | Caption = 'Delete Invalid' 169 | TabOrder = 16 170 | OnClick = Button14Click 171 | end 172 | object Button15: TButton 173 | Left = 251 174 | Top = 456 175 | Width = 75 176 | Height = 25 177 | Caption = 'Get Window' 178 | TabOrder = 17 179 | OnClick = Button15Click 180 | end 181 | object Button16: TButton 182 | Left = 170 183 | Top = 518 184 | Width = 75 185 | Height = 25 186 | Caption = 'Get Elemnt' 187 | TabOrder = 18 188 | OnClick = Button16Click 189 | end 190 | object Button17: TButton 191 | Left = 251 192 | Top = 518 193 | Width = 118 194 | Height = 25 195 | Caption = 'Get Elemnt By Text' 196 | TabOrder = 19 197 | OnClick = Button17Click 198 | end 199 | object Button18: TButton 200 | Left = 380 201 | Top = 518 202 | Width = 118 203 | Height = 25 204 | Caption = 'Get Elemnt By Name' 205 | TabOrder = 20 206 | OnClick = Button18Click 207 | end 208 | object Button19: TButton 209 | Left = 544 210 | Top = 430 211 | Width = 153 212 | Height = 25 213 | Caption = 'Elements By ClassName' 214 | TabOrder = 21 215 | OnClick = Button19Click 216 | end 217 | object Button20: TButton 218 | Left = 380 219 | Top = 549 220 | Width = 149 221 | Height = 25 222 | Caption = 'Get/Click Elemnt By Name' 223 | TabOrder = 22 224 | OnClick = Button20Click 225 | end 226 | object Button21: TButton 227 | Left = 544 228 | Top = 549 229 | Width = 153 230 | Height = 25 231 | Caption = 'Speedbuttons By ClassName' 232 | TabOrder = 23 233 | OnClick = Button21Click 234 | end 235 | object Button22: TButton 236 | Left = 544 237 | Top = 488 238 | Width = 153 239 | Height = 25 240 | Caption = 'Click Speedbutton' 241 | TabOrder = 24 242 | OnClick = Button22Click 243 | end 244 | object Button23: TButton 245 | Left = 128 246 | Top = 560 247 | Width = 117 248 | Height = 25 249 | Caption = 'Get Grid Items' 250 | TabOrder = 25 251 | OnClick = Button23Click 252 | end 253 | object Button24: TButton 254 | Left = 128 255 | Top = 591 256 | Width = 117 257 | Height = 25 258 | Caption = 'Get List Items' 259 | TabOrder = 26 260 | OnClick = Button24Click 261 | end 262 | object Button25: TButton 263 | Left = 251 264 | Top = 580 265 | Width = 117 266 | Height = 25 267 | Caption = 'Get List Item Text' 268 | TabOrder = 27 269 | OnClick = Button25Click 270 | end 271 | object Button26: TButton 272 | Left = 374 273 | Top = 580 274 | Width = 149 275 | Height = 25 276 | Caption = 'Get Grid Item Text' 277 | TabOrder = 28 278 | OnClick = Button26Click 279 | end 280 | object ComboBox1: TComboBox 281 | Left = 544 282 | Top = 461 283 | Width = 153 284 | Height = 21 285 | Style = csDropDownList 286 | TabOrder = 29 287 | Items.Strings = ( 288 | 'TButton' 289 | 'TEdit' 290 | 'TSpeedButton' 291 | 'TTabSheet' 292 | 'TAutomationStringGrid' 293 | 'TListBox' 294 | 'TComboBox' 295 | 'TAutomatedCombobox' 296 | 'TAutomatedEdit' 297 | 'TRadioButton' 298 | 'TPageControl' 299 | 'TCheckBox' 300 | 'TToolBar' 301 | 'TToolButton') 302 | end 303 | object ComboBox2: TComboBox 304 | Left = 544 305 | Top = 522 306 | Width = 153 307 | Height = 21 308 | Style = csDropDownList 309 | TabOrder = 30 310 | Items.Strings = ( 311 | '1' 312 | '2' 313 | '3') 314 | end 315 | object Button27: TButton 316 | Left = 544 317 | Top = 580 318 | Width = 149 319 | Height = 25 320 | Caption = 'Get TabItem Text' 321 | TabOrder = 31 322 | OnClick = Button27Click 323 | end 324 | object Button28: TButton 325 | Left = 374 326 | Top = 606 327 | Width = 149 328 | Height = 25 329 | Caption = 'Right-Click on Grid' 330 | TabOrder = 32 331 | OnClick = Button28Click 332 | end 333 | object ComboBox3: TComboBox 334 | Left = 544 335 | Top = 610 336 | Width = 153 337 | Height = 21 338 | Style = csDropDownList 339 | TabOrder = 33 340 | Items.Strings = ( 341 | '0' 342 | '1' 343 | '2') 344 | end 345 | object Button29: TButton 346 | Left = 728 347 | Top = 487 348 | Width = 121 349 | Height = 25 350 | Caption = 'Click ToolButon' 351 | TabOrder = 34 352 | OnClick = Button29Click 353 | end 354 | object ComboBox4: TComboBox 355 | Left = 728 356 | Top = 520 357 | Width = 121 358 | Height = 21 359 | Style = csDropDownList 360 | TabOrder = 35 361 | Items.Strings = ( 362 | '1' 363 | '2' 364 | '3' 365 | '4') 366 | end 367 | object Button30: TButton 368 | Left = 728 369 | Top = 549 370 | Width = 121 371 | Height = 25 372 | Caption = 'Right-Click on TB' 373 | TabOrder = 36 374 | OnClick = Button28Click 375 | end 376 | object Button31: TButton 377 | Left = 8 378 | Top = 522 379 | Width = 75 380 | Height = 25 381 | Caption = 'Set Text' 382 | TabOrder = 37 383 | OnClick = Button31Click 384 | end 385 | object Edit1: TEdit 386 | Left = 8 387 | Top = 551 388 | Width = 114 389 | Height = 21 390 | TabOrder = 38 391 | Text = 'This is a test' 392 | end 393 | end 394 | -------------------------------------------------------------------------------- /TestClient/Unit3.pas: -------------------------------------------------------------------------------- 1 | unit Unit3; 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; 8 | 9 | type 10 | TForm3 = class(TForm) 11 | ListBox1: TListBox; 12 | btnStartSession: TButton; 13 | Button1: TButton; 14 | Button2: TButton; 15 | StaticText1: TStaticText; 16 | Button3: TButton; 17 | Button4: TButton; 18 | Button5: TButton; 19 | Button6: TButton; 20 | Button7: TButton; 21 | Button8: TButton; 22 | Button9: TButton; 23 | Button10: TButton; 24 | Button11: TButton; 25 | Button12: TButton; 26 | Button13: TButton; 27 | Button14: TButton; 28 | Button15: TButton; 29 | Button16: TButton; 30 | Button17: TButton; 31 | Button18: TButton; 32 | Button19: TButton; 33 | Button20: TButton; 34 | Button21: TButton; 35 | Button22: TButton; 36 | Button23: TButton; 37 | Button24: TButton; 38 | Button25: TButton; 39 | Button26: TButton; 40 | ComboBox1: TComboBox; 41 | ComboBox2: TComboBox; 42 | Button27: TButton; 43 | Button28: TButton; 44 | ComboBox3: TComboBox; 45 | Button29: TButton; 46 | ComboBox4: TComboBox; 47 | Button30: TButton; 48 | Button31: TButton; 49 | Edit1: TEdit; 50 | procedure btnStartSessionClick(Sender: TObject); 51 | procedure Button1Click(Sender: TObject); 52 | procedure Button2Click(Sender: TObject); 53 | procedure Button3Click(Sender: TObject); 54 | procedure Button4Click(Sender: TObject); 55 | procedure Button5Click(Sender: TObject); 56 | procedure Button6Click(Sender: TObject); 57 | procedure Button7Click(Sender: TObject); 58 | procedure Button8Click(Sender: TObject); 59 | procedure Button9Click(Sender: TObject); 60 | procedure Button10Click(Sender: TObject); 61 | procedure Button11Click(Sender: TObject); 62 | procedure Button12Click(Sender: TObject); 63 | procedure Button13Click(Sender: TObject); 64 | procedure DeleteClick(Sender: TObject); 65 | procedure Button14Click(Sender: TObject); 66 | procedure Button15Click(Sender: TObject); 67 | procedure Button16Click(Sender: TObject); 68 | procedure Button17Click(Sender: TObject); 69 | procedure Button18Click(Sender: TObject); 70 | procedure Button19Click(Sender: TObject); 71 | procedure Button20Click(Sender: TObject); 72 | procedure Button21Click(Sender: TObject); 73 | procedure Button22Click(Sender: TObject); 74 | procedure Button23Click(Sender: TObject); 75 | procedure Button24Click(Sender: TObject); 76 | procedure Button25Click(Sender: TObject); 77 | procedure Button26Click(Sender: TObject); 78 | procedure Button27Click(Sender: TObject); 79 | procedure Button28Click(Sender: TObject); 80 | procedure Button29Click(Sender: TObject); 81 | procedure Button31Click(Sender: TObject); 82 | private 83 | { Private declarations } 84 | FSessionId: String; 85 | 86 | function Get(const resource: String): string; 87 | function Delete(const resource: String): string; 88 | function Post(const resource: String; const parameters: String = ''): string; 89 | function Sanitize(value: String): String; 90 | public 91 | { Public declarations } 92 | end; 93 | 94 | var 95 | Form3: TForm3; 96 | 97 | implementation 98 | 99 | uses 100 | IdHTTP, 101 | System.JSON, 102 | System.JSON.Types, 103 | System.JSON.Writers, 104 | System.JSON.Builders, 105 | System.StrUtils; 106 | 107 | {$R *.dfm} 108 | 109 | function TForm3.Sanitize(value: String): String; 110 | begin 111 | value := StringReplace(value,#$A,'',[rfReplaceAll]); 112 | value := StringReplace(value,#$D,'',[rfReplaceAll]); 113 | 114 | result := value; 115 | end; 116 | 117 | function TForm3.Post(const resource: String; const parameters: String = ''): string; 118 | var 119 | lHTTP: TIdHTTP; 120 | val : String; 121 | jsonToSend : TStringStream; 122 | begin 123 | lHTTP := TIdHTTP.Create(nil); 124 | lHTTP.Request.ContentType := 'application/json; charset=utf-8'; 125 | try 126 | val := Sanitize(parameters); 127 | jsonToSend := TStringStream.create(val, TEncoding.UTF8); 128 | try 129 | Result := lHTTP.Post('http://127.0.0.1:4723/' + resource, jsonToSend); 130 | finally 131 | jsonToSend.Free; 132 | end; 133 | finally 134 | lHTTP.Free; 135 | end; 136 | end; 137 | 138 | function TForm3.Delete(const resource: String): string; 139 | var 140 | lHTTP: TIdHTTP; 141 | begin 142 | lHTTP := TIdHTTP.Create(nil); 143 | try 144 | Result := lHTTP.Delete('http://127.0.0.1:4723/' + resource); 145 | finally 146 | lHTTP.Free; 147 | end; 148 | end; 149 | 150 | function TForm3.Get(const resource: String): string; 151 | var 152 | lHTTP: TIdHTTP; 153 | begin 154 | lHTTP := TIdHTTP.Create(nil); 155 | try 156 | Result := lHTTP.Get('http://127.0.0.1:4723/' + resource); 157 | finally 158 | lHTTP.Free; 159 | end; 160 | end; 161 | 162 | procedure TForm3.btnStartSessionClick(Sender: TObject); 163 | var 164 | LJSONValue: TJSONValue; 165 | Builder: TJSONObjectBuilder; 166 | Writer: TJsonTextWriter; 167 | StringWriter: TStringWriter; 168 | StringBuilder: TStringBuilder; 169 | Parameters: String; 170 | result: String; 171 | 172 | begin 173 | FSessionId := ''; 174 | 175 | StringBuilder := TStringBuilder.Create; 176 | StringWriter := TStringWriter.Create(StringBuilder); 177 | Writer := TJsonTextWriter.Create(StringWriter); 178 | Writer.Formatting := TJsonFormatting.Indented; 179 | Builder := TJSONObjectBuilder.Create(Writer); 180 | 181 | Builder 182 | .BeginObject 183 | .BeginObject('desiredCapabilities') 184 | .Add('platformName', 'iOS') 185 | .Add('app', 'c:\ProgramData\JHC\F63\Qual\Automation\DealServer2.exe') 186 | .Add('args', '4099') 187 | .EndObject 188 | .EndObject; 189 | 190 | Parameters := StringBuilder.ToString; 191 | 192 | result := Post('session', parameters); 193 | 194 | listBox1.Items.add(result); 195 | 196 | // Decode the JSon 197 | LJSONValue := TJSONObject.ParseJSONValue(TEncoding.UTF8.GetBytes(result),0); 198 | FSessionID := LJSONValue.GetValue('sessionId'); 199 | 200 | StaticText1.Caption := FSessionId; 201 | end; 202 | 203 | procedure TForm3.Button10Click(Sender: TObject); 204 | var 205 | result : String; 206 | begin 207 | result := post('session/' + self.FSessionId + '/element/Button2/click', ''); 208 | end; 209 | 210 | procedure TForm3.Button11Click(Sender: TObject); 211 | var 212 | result : String; 213 | begin 214 | result := post('session/' + self.FSessionId + '/element/ButtonNotThere/click', ''); 215 | listBox1.Items.add(result); 216 | end; 217 | 218 | procedure TForm3.Button12Click(Sender: TObject); 219 | var 220 | result : String; 221 | begin 222 | result := Get('session/' + self.FSessionId + '/title'); 223 | listBox1.Items.add(result); 224 | end; 225 | 226 | procedure TForm3.Button13Click(Sender: TObject); 227 | var 228 | result : String; 229 | begin 230 | result := get('session/' + self.FSessionId + '/element/AutomatedEdit1/text'); 231 | listBox1.Items.add(result); 232 | end; 233 | 234 | procedure TForm3.Button14Click(Sender: TObject); 235 | var 236 | result : String; 237 | begin 238 | result := Delete('session/ieueihflkjflkjfhe76rj'); 239 | listBox1.Items.add(result); 240 | end; 241 | 242 | procedure TForm3.Button15Click(Sender: TObject); 243 | var 244 | result : String; 245 | begin 246 | result := Get('session/' + self.FSessionId + '/window'); 247 | listBox1.Items.add(result); 248 | end; 249 | 250 | procedure TForm3.Button16Click(Sender: TObject); 251 | var 252 | result : String; 253 | Builder: TJSONObjectBuilder; 254 | Writer: TJsonTextWriter; 255 | StringWriter: TStringWriter; 256 | StringBuilder: TStringBuilder; 257 | Parameters: String; 258 | 259 | begin 260 | StringBuilder := TStringBuilder.Create; 261 | StringWriter := TStringWriter.Create(StringBuilder); 262 | Writer := TJsonTextWriter.Create(StringWriter); 263 | Writer.Formatting := TJsonFormatting.Indented; 264 | Builder := TJSONObjectBuilder.Create(Writer); 265 | 266 | Builder 267 | .BeginObject 268 | .Add('using', 'name') 269 | .Add('value', 'This is Form1 - The Hosting Form') 270 | .EndObject; 271 | 272 | Parameters := StringBuilder.ToString; 273 | 274 | result := post('session/' + self.FSessionId + '/element', parameters); 275 | listBox1.Items.add(result); 276 | end; 277 | 278 | procedure TForm3.Button17Click(Sender: TObject); 279 | var 280 | result : String; 281 | Builder: TJSONObjectBuilder; 282 | Writer: TJsonTextWriter; 283 | StringWriter: TStringWriter; 284 | StringBuilder: TStringBuilder; 285 | Parameters: String; 286 | 287 | begin 288 | StringBuilder := TStringBuilder.Create; 289 | StringWriter := TStringWriter.Create(StringBuilder); 290 | Writer := TJsonTextWriter.Create(StringWriter); 291 | Writer.Formatting := TJsonFormatting.Indented; 292 | Builder := TJSONObjectBuilder.Create(Writer); 293 | 294 | Builder 295 | .BeginObject 296 | .Add('using', 'link text') 297 | .Add('value', 'Get Title') 298 | .EndObject; 299 | 300 | Parameters := StringBuilder.ToString; 301 | 302 | result := post('session/' + self.FSessionId + '/element', parameters); 303 | listBox1.Items.add(result); 304 | end; 305 | 306 | procedure TForm3.Button18Click(Sender: TObject); 307 | var 308 | result : String; 309 | Builder: TJSONObjectBuilder; 310 | Writer: TJsonTextWriter; 311 | StringWriter: TStringWriter; 312 | StringBuilder: TStringBuilder; 313 | Parameters: String; 314 | 315 | begin 316 | StringBuilder := TStringBuilder.Create; 317 | StringWriter := TStringWriter.Create(StringBuilder); 318 | Writer := TJsonTextWriter.Create(StringWriter); 319 | Writer.Formatting := TJsonFormatting.Indented; 320 | Builder := TJSONObjectBuilder.Create(Writer); 321 | 322 | Builder 323 | .BeginObject 324 | .Add('using', 'name') 325 | .Add('value', 'Button3') 326 | .EndObject; 327 | 328 | Parameters := StringBuilder.ToString; 329 | 330 | result := post('session/' + self.FSessionId + '/element', parameters); 331 | listBox1.Items.add(result); 332 | end; 333 | 334 | procedure TForm3.Button19Click(Sender: TObject); 335 | var 336 | result : String; 337 | Builder: TJSONObjectBuilder; 338 | Writer: TJsonTextWriter; 339 | StringWriter: TStringWriter; 340 | StringBuilder: TStringBuilder; 341 | Parameters: String; 342 | 343 | begin 344 | StringBuilder := TStringBuilder.Create; 345 | StringWriter := TStringWriter.Create(StringBuilder); 346 | Writer := TJsonTextWriter.Create(StringWriter); 347 | Writer.Formatting := TJsonFormatting.Indented; 348 | Builder := TJSONObjectBuilder.Create(Writer); 349 | 350 | Builder 351 | .BeginObject 352 | .Add('using', 'class name') 353 | .Add('value', ComboBox1.Text) 354 | .EndObject; 355 | 356 | Parameters := StringBuilder.ToString; 357 | 358 | result := post('session/' + self.FSessionId + '/elements', parameters); 359 | listBox1.Items.add(result); 360 | end; 361 | 362 | procedure TForm3.Button1Click(Sender: TObject); 363 | var 364 | result : String; 365 | begin 366 | result := Get('status'); 367 | listBox1.Items.add(result); 368 | end; 369 | 370 | procedure TForm3.Button20Click(Sender: TObject); 371 | var 372 | result : String; 373 | Builder: TJSONObjectBuilder; 374 | Writer: TJsonTextWriter; 375 | StringWriter: TStringWriter; 376 | StringBuilder: TStringBuilder; 377 | Parameters: String; 378 | handle: String; 379 | jsonObj: TJSONObject; 380 | jsonPair: TJsonObject; 381 | req: String; 382 | 383 | begin 384 | StringBuilder := TStringBuilder.Create; 385 | StringWriter := TStringWriter.Create(StringBuilder); 386 | Writer := TJsonTextWriter.Create(StringWriter); 387 | Writer.Formatting := TJsonFormatting.Indented; 388 | Builder := TJSONObjectBuilder.Create(Writer); 389 | 390 | Builder 391 | .BeginObject 392 | .Add('using', 'name') 393 | .Add('value', 'Button3') 394 | .EndObject; 395 | 396 | Parameters := StringBuilder.ToString; 397 | 398 | result := post('session/' + self.FSessionId + '/element', parameters); 399 | listBox1.Items.add(result); 400 | 401 | // Decode it and get the handle 402 | jsonObj := TJSONObject.ParseJSONValue(TEncoding.ASCII.GetBytes(result),0) as TJSONObject; 403 | try 404 | (jsonObj as TJsonObject).TryGetValue('value', jsonPair); 405 | (jsonPair as TJsonObject).TryGetValue('ELEMENT', handle); 406 | finally 407 | jsonObj.Free; 408 | end; 409 | 410 | req := 'session/' + self.FSessionId + '/element/' + handle + '/click'; 411 | 412 | result := post('session/' + self.FSessionId + '/element/' + handle + '/click'); 413 | 414 | listBox1.Items.Add(result); 415 | end; 416 | 417 | procedure TForm3.Button21Click(Sender: TObject); 418 | var 419 | result : String; 420 | Builder: TJSONObjectBuilder; 421 | Writer: TJsonTextWriter; 422 | StringWriter: TStringWriter; 423 | StringBuilder: TStringBuilder; 424 | Parameters: String; 425 | 426 | begin 427 | StringBuilder := TStringBuilder.Create; 428 | StringWriter := TStringWriter.Create(StringBuilder); 429 | Writer := TJsonTextWriter.Create(StringWriter); 430 | Writer.Formatting := TJsonFormatting.Indented; 431 | Builder := TJSONObjectBuilder.Create(Writer); 432 | 433 | Builder 434 | .BeginObject 435 | .Add('using', 'class name') 436 | .Add('value', 'TSpeedButton') 437 | .EndObject; 438 | 439 | Parameters := StringBuilder.ToString; 440 | 441 | result := post('session/' + self.FSessionId + '/elements', parameters); 442 | listBox1.Items.add(result); 443 | end; 444 | 445 | procedure TForm3.Button22Click(Sender: TObject); 446 | var 447 | result : String; 448 | Builder: TJSONObjectBuilder; 449 | Writer: TJsonTextWriter; 450 | StringWriter: TStringWriter; 451 | StringBuilder: TStringBuilder; 452 | Parameters: String; 453 | jsonObj: TJSONObject; 454 | jsonPair: TJsonObject; 455 | req: String; 456 | handle: String; 457 | 458 | begin 459 | StringBuilder := TStringBuilder.Create; 460 | StringWriter := TStringWriter.Create(StringBuilder); 461 | Writer := TJsonTextWriter.Create(StringWriter); 462 | Writer.Formatting := TJsonFormatting.Indented; 463 | Builder := TJSONObjectBuilder.Create(Writer); 464 | 465 | Builder 466 | .BeginObject 467 | .Add('using', 'name') 468 | .Add('value', 'SpeedButton' + COmbobox2.Text) 469 | .EndObject; 470 | 471 | Parameters := StringBuilder.ToString; 472 | 473 | result := post('session/' + self.FSessionId + '/element', parameters); 474 | listBox1.Items.add(result); 475 | 476 | // Decode it and get the handle 477 | jsonObj := TJSONObject.ParseJSONValue(TEncoding.ASCII.GetBytes(result),0) as TJSONObject; 478 | try 479 | (jsonObj as TJsonObject).TryGetValue('value', jsonPair); 480 | (jsonPair as TJsonObject).TryGetValue('ELEMENT', handle); 481 | finally 482 | jsonObj.Free; 483 | end; 484 | 485 | req := 'session/' + self.FSessionId + '/element/' + handle + '/click'; 486 | 487 | result := post(req); 488 | 489 | listBox1.Items.Add(result); 490 | end; 491 | 492 | procedure TForm3.Button23Click(Sender: TObject); 493 | var 494 | result : String; 495 | Builder: TJSONObjectBuilder; 496 | Writer: TJsonTextWriter; 497 | StringWriter: TStringWriter; 498 | StringBuilder: TStringBuilder; 499 | jsonObj: TJSONObject; 500 | jsonPair: TJsonObject; 501 | req: String; 502 | handle: String; 503 | 504 | begin 505 | StringBuilder := TStringBuilder.Create; 506 | StringWriter := TStringWriter.Create(StringBuilder); 507 | Writer := TJsonTextWriter.Create(StringWriter); 508 | Writer.Formatting := TJsonFormatting.Indented; 509 | Builder := TJSONObjectBuilder.Create(Writer); 510 | 511 | Builder 512 | .BeginObject 513 | .Add('using', 'name') 514 | .Add('value', 'AutomationStringGrid1') 515 | .EndObject; 516 | 517 | result := post('session/' + self.FSessionId + '/element', StringBuilder.ToString); 518 | listBox1.Items.add(result); 519 | 520 | // Decode it and get the handle 521 | jsonObj := TJSONObject.ParseJSONValue(TEncoding.ASCII.GetBytes(result),0) as TJSONObject; 522 | try 523 | (jsonObj as TJsonObject).TryGetValue('value', jsonPair); 524 | (jsonPair as TJsonObject).TryGetValue('ELEMENT', handle); 525 | finally 526 | jsonObj.Free; 527 | end; 528 | 529 | req := 'session/' + self.FSessionId + '/element/' + handle + '/elements'; 530 | 531 | StringBuilder := TStringBuilder.Create; 532 | StringWriter := TStringWriter.Create(StringBuilder); 533 | Writer := TJsonTextWriter.Create(StringWriter); 534 | Writer.Formatting := TJsonFormatting.Indented; 535 | Builder := TJSONObjectBuilder.Create(Writer); 536 | 537 | 538 | // Header / HeaderItem / Text 539 | // DataItem / Text 540 | 541 | Builder 542 | .BeginObject 543 | .Add('using', 'class name') 544 | .Add('value', 'DataItem') 545 | .EndObject; 546 | 547 | result := post('session/' + self.FSessionId + '/element/' + handle + '/elements', StringBuilder.ToString); 548 | 549 | listBox1.Items.Add(result); 550 | end; 551 | 552 | procedure TForm3.Button24Click(Sender: TObject); 553 | var 554 | result : String; 555 | Builder: TJSONObjectBuilder; 556 | Writer: TJsonTextWriter; 557 | StringWriter: TStringWriter; 558 | StringBuilder: TStringBuilder; 559 | jsonObj: TJSONObject; 560 | jsonPair: TJsonObject; 561 | req: String; 562 | handle: String; 563 | 564 | begin 565 | StringBuilder := TStringBuilder.Create; 566 | StringWriter := TStringWriter.Create(StringBuilder); 567 | Writer := TJsonTextWriter.Create(StringWriter); 568 | Writer.Formatting := TJsonFormatting.Indented; 569 | Builder := TJSONObjectBuilder.Create(Writer); 570 | 571 | Builder 572 | .BeginObject 573 | .Add('using', 'name') 574 | .Add('value', 'ListBox1') 575 | .EndObject; 576 | 577 | result := post('session/' + self.FSessionId + '/element', StringBuilder.ToString); 578 | listBox1.Items.add(result); 579 | 580 | // Decode it and get the handle 581 | jsonObj := TJSONObject.ParseJSONValue(TEncoding.ASCII.GetBytes(result),0) as TJSONObject; 582 | try 583 | (jsonObj as TJsonObject).TryGetValue('value', jsonPair); 584 | (jsonPair as TJsonObject).TryGetValue('ELEMENT', handle); 585 | finally 586 | jsonObj.Free; 587 | end; 588 | 589 | req := 'session/' + self.FSessionId + '/element/' + handle + '/elements'; 590 | 591 | StringBuilder := TStringBuilder.Create; 592 | StringWriter := TStringWriter.Create(StringBuilder); 593 | Writer := TJsonTextWriter.Create(StringWriter); 594 | Writer.Formatting := TJsonFormatting.Indented; 595 | Builder := TJSONObjectBuilder.Create(Writer); 596 | 597 | 598 | // Header / HeaderItem / Text 599 | // DataItem / Text 600 | 601 | Builder 602 | .BeginObject 603 | .Add('using', 'class name') 604 | .Add('value', 'DataItem') 605 | .EndObject; 606 | 607 | result := post('session/' + self.FSessionId + '/element/' + handle + '/elements', StringBuilder.ToString); 608 | 609 | listBox1.Items.Add(result); 610 | end; 611 | 612 | procedure TForm3.Button25Click(Sender: TObject); 613 | var 614 | result : String; 615 | 616 | begin 617 | result := get('session/' + self.FSessionId + '/element/ListBox1.0/text'); 618 | 619 | listBox1.Items.Add(result); 620 | end; 621 | 622 | procedure TForm3.Button26Click(Sender: TObject); 623 | var 624 | result : String; 625 | 626 | begin 627 | result := get('session/' + self.FSessionId + '/element/AutomationStringGrid1.1.1/text'); 628 | listBox1.Items.Add(result); 629 | end; 630 | 631 | procedure TForm3.Button27Click(Sender: TObject); 632 | var 633 | result : String; 634 | 635 | begin 636 | result := get('session/' + self.FSessionId + '/element/PageControl1.' + Combobox3.text + '/text'); 637 | listBox1.Items.Add(result); 638 | end; 639 | 640 | procedure TForm3.Button28Click(Sender: TObject); 641 | var 642 | result : String; 643 | Builder: TJSONObjectBuilder; 644 | Writer: TJsonTextWriter; 645 | StringWriter: TStringWriter; 646 | StringBuilder: TStringBuilder; 647 | Parameters: String; 648 | 649 | begin 650 | StringBuilder := TStringBuilder.Create; 651 | StringWriter := TStringWriter.Create(StringBuilder); 652 | Writer := TJsonTextWriter.Create(StringWriter); 653 | Writer.Formatting := TJsonFormatting.Indented; 654 | Builder := TJSONObjectBuilder.Create(Writer); 655 | 656 | Builder 657 | .BeginObject 658 | .Add('script', 'right click') 659 | .BeginObject('args') 660 | .Add('first', 'ToolButton5') 661 | .EndObject 662 | .EndObject; 663 | 664 | Parameters := StringBuilder.ToString; 665 | 666 | result := post('session/' + self.FSessionId + '/execute', parameters); 667 | listBox1.Items.Add(result); 668 | end; 669 | 670 | procedure TForm3.Button29Click(Sender: TObject); 671 | var 672 | result : String; 673 | Builder: TJSONObjectBuilder; 674 | Writer: TJsonTextWriter; 675 | StringWriter: TStringWriter; 676 | StringBuilder: TStringBuilder; 677 | Parameters: String; 678 | jsonObj: TJSONObject; 679 | jsonPair: TJsonObject; 680 | req: String; 681 | handle: String; 682 | 683 | begin 684 | StringBuilder := TStringBuilder.Create; 685 | StringWriter := TStringWriter.Create(StringBuilder); 686 | Writer := TJsonTextWriter.Create(StringWriter); 687 | Writer.Formatting := TJsonFormatting.Indented; 688 | Builder := TJSONObjectBuilder.Create(Writer); 689 | 690 | StringBuilder := TStringBuilder.Create; 691 | StringWriter := TStringWriter.Create(StringBuilder); 692 | Writer := TJsonTextWriter.Create(StringWriter); 693 | Writer.Formatting := TJsonFormatting.Indented; 694 | Builder := TJSONObjectBuilder.Create(Writer); 695 | 696 | Builder 697 | .BeginObject 698 | .Add('using', 'name') 699 | .Add('value', 'ToolButton' + Combobox4.Text) 700 | .EndObject; 701 | 702 | Parameters := StringBuilder.ToString; 703 | 704 | result := post('session/' + self.FSessionId + '/element', parameters); 705 | listBox1.Items.add(result); 706 | 707 | // Decode it and get the handle 708 | jsonObj := TJSONObject.ParseJSONValue(TEncoding.ASCII.GetBytes(result),0) as TJSONObject; 709 | try 710 | (jsonObj as TJsonObject).TryGetValue('value', jsonPair); 711 | (jsonPair as TJsonObject).TryGetValue('ELEMENT', handle); 712 | finally 713 | jsonObj.Free; 714 | end; 715 | 716 | req := 'session/' + self.FSessionId + '/element/' + handle + '/click'; 717 | 718 | result := post('session/' + self.FSessionId + '/element/' + handle + '/click'); 719 | 720 | listBox1.Items.Add(result); 721 | end; 722 | 723 | procedure TForm3.Button2Click(Sender: TObject); 724 | var 725 | result : String; 726 | Builder: TJSONObjectBuilder; 727 | Writer: TJsonTextWriter; 728 | StringWriter: TStringWriter; 729 | StringBuilder: TStringBuilder; 730 | Parameters: String; 731 | 732 | begin 733 | StringBuilder := TStringBuilder.Create; 734 | StringWriter := TStringWriter.Create(StringBuilder); 735 | Writer := TJsonTextWriter.Create(StringWriter); 736 | Writer.Formatting := TJsonFormatting.Indented; 737 | Builder := TJSONObjectBuilder.Create(Writer); 738 | 739 | Builder 740 | .BeginObject 741 | .Add('type', 'implicit') 742 | .Add('ms', '200') 743 | .EndObject; 744 | 745 | Parameters := StringBuilder.ToString; 746 | 747 | result := post('session/' + self.FSessionId + '/timeouts', parameters); 748 | listBox1.Items.add(result); 749 | end; 750 | 751 | procedure TForm3.Button31Click(Sender: TObject); 752 | var 753 | result : String; 754 | Builder: TJSONObjectBuilder; 755 | Writer: TJsonTextWriter; 756 | StringWriter: TStringWriter; 757 | StringBuilder: TStringBuilder; 758 | jsonObj: TJSONObject; 759 | jsonPair: TJsonObject; 760 | req: String; 761 | handle: String; 762 | 763 | begin 764 | StringBuilder := TStringBuilder.Create; 765 | StringWriter := TStringWriter.Create(StringBuilder); 766 | Writer := TJsonTextWriter.Create(StringWriter); 767 | Writer.Formatting := TJsonFormatting.Indented; 768 | Builder := TJSONObjectBuilder.Create(Writer); 769 | 770 | // First get the handle of the control 771 | Builder 772 | .BeginObject 773 | .Add('using', 'name') 774 | .Add('value', 'Edit1') 775 | .EndObject; 776 | 777 | result := post('session/' + self.FSessionId + '/element', StringBuilder.ToString); 778 | listBox1.Items.add(result); 779 | 780 | // Decode it and get the handle 781 | jsonObj := TJSONObject.ParseJSONValue(TEncoding.ASCII.GetBytes(result),0) as TJSONObject; 782 | try 783 | (jsonObj as TJsonObject).TryGetValue('value', jsonPair); 784 | (jsonPair as TJsonObject).TryGetValue('ELEMENT', handle); 785 | finally 786 | jsonObj.Free; 787 | end; 788 | 789 | req := 'session/' + self.FSessionId + '/element/' + handle + '/value'; 790 | 791 | StringBuilder := TStringBuilder.Create; 792 | StringWriter := TStringWriter.Create(StringBuilder); 793 | Writer := TJsonTextWriter.Create(StringWriter); 794 | Writer.Formatting := TJsonFormatting.Indented; 795 | Builder := TJSONObjectBuilder.Create(Writer); 796 | 797 | Builder 798 | .BeginObject 799 | .Add('value', Edit1.text) 800 | .EndObject; 801 | 802 | result := post(req, StringBuilder.ToString); 803 | listBox1.Items.add(result); 804 | end; 805 | 806 | procedure TForm3.Button3Click(Sender: TObject); 807 | var 808 | result : String; 809 | begin 810 | result := post('session/' + self.FSessionId + '/timeouts/implicit_wait', ''); 811 | listBox1.Items.add(result); 812 | end; 813 | 814 | procedure TForm3.Button4Click(Sender: TObject); 815 | var 816 | result : String; 817 | Builder: TJSONObjectBuilder; 818 | Writer: TJsonTextWriter; 819 | StringWriter: TStringWriter; 820 | StringBuilder: TStringBuilder; 821 | 822 | begin 823 | StringBuilder := TStringBuilder.Create; 824 | StringWriter := TStringWriter.Create(StringBuilder); 825 | Writer := TJsonTextWriter.Create(StringWriter); 826 | Writer.Formatting := TJsonFormatting.Indented; 827 | Builder := TJSONObjectBuilder.Create(Writer); 828 | 829 | Builder 830 | .BeginObject 831 | .Add('using', 'name') 832 | .Add('value', 'Button1') 833 | .EndObject; 834 | 835 | result := post('session/' + self.FSessionId + '/element', StringBuilder.ToString); 836 | listBox1.Items.add(result); 837 | end; 838 | 839 | procedure TForm3.Button5Click(Sender: TObject); 840 | var 841 | result : String; 842 | begin 843 | // For example 844 | result := get('session/' + self.FSessionId); 845 | listBox1.Items.add(result); 846 | end; 847 | 848 | procedure TForm3.Button6Click(Sender: TObject); 849 | var 850 | result : String; 851 | begin 852 | result := get('sessions'); 853 | listBox1.Items.add(result); 854 | end; 855 | 856 | procedure TForm3.Button7Click(Sender: TObject); 857 | var 858 | result : String; 859 | begin 860 | result := get('session/' + self.FSessionId + '/window_handle'); 861 | listBox1.Items.add(result); 862 | end; 863 | 864 | procedure TForm3.Button8Click(Sender: TObject); 865 | var 866 | result : String; 867 | begin 868 | result := get('error/' + self.FSessionId + '/window_handle'); 869 | listBox1.Items.add(result); 870 | end; 871 | 872 | procedure TForm3.Button9Click(Sender: TObject); 873 | var 874 | result : String; 875 | begin 876 | result := post('session/' + self.FSessionId + '/element/Button1/click', ''); 877 | listBox1.Items.add(result); 878 | end; 879 | 880 | procedure TForm3.DeleteClick(Sender: TObject); 881 | var 882 | result : String; 883 | begin 884 | result := Delete('session/' + self.FSessionId); 885 | listBox1.Items.add(result); 886 | end; 887 | 888 | end. 889 | -------------------------------------------------------------------------------- /TestHost/HostMain.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { DelphiUIAutomation } 4 | { } 5 | { Copyright 2015 JHC Systems Limited } 6 | { } 7 | {***************************************************************************} 8 | { } 9 | { Licensed under the Apache License, Version 2.0 (the "License"); } 10 | { you may not use this file except in compliance with the License. } 11 | { You may obtain a copy of the License at } 12 | { } 13 | { http://www.apache.org/licenses/LICENSE-2.0 } 14 | { } 15 | { Unless required by applicable law or agreed to in writing, software } 16 | { distributed under the License is distributed on an "AS IS" BASIS, } 17 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 18 | { See the License for the specific language governing permissions and } 19 | { limitations under the License. } 20 | { } 21 | {***************************************************************************} 22 | unit HostMain; 23 | 24 | interface 25 | 26 | uses 27 | RestServer, 28 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 29 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls, Vcl.Menus, 30 | Vcl.Grids, Vcl.Mask, 31 | Vcl.ToolWin, Vcl.ExtCtrls, Vcl.ImgList, System.ImageList, 32 | Vcl.Buttons; 33 | 34 | type 35 | TForm1 = class(TForm) 36 | Edit2: TEdit; 37 | Button1: TButton; 38 | Button2: TButton; 39 | PageControl1: TPageControl; 40 | TabSheet1: TTabSheet; 41 | TabSheet2: TTabSheet; 42 | TabSheet3: TTabSheet; 43 | Edit3: TEdit; 44 | Edit4: TEdit; 45 | Edit5: TEdit; 46 | CheckBox1: TCheckBox; 47 | CheckBox2: TCheckBox; 48 | RadioButton1: TRadioButton; 49 | RadioButton2: TRadioButton; 50 | RadioButton3: TRadioButton; 51 | StatusBar1: TStatusBar; 52 | ComboBox1: TComboBox; 53 | MainMenu1: TMainMenu; 54 | File1: TMenuItem; 55 | Hel1: TMenuItem; 56 | Exit1: TMenuItem; 57 | About1: TMenuItem; 58 | PopupMenu1: TPopupMenu; 59 | PopupMenu2: TMenuItem; 60 | AutomatedEdit1: TEdit; 61 | AutomatedCombobox1: TCombobox; 62 | AutomatedCombobox2: TCombobox; 63 | AutomationStringGrid1: TStringGrid; 64 | AutomatedMaskEdit1: TMaskEdit; 65 | RichEdit1: TRichEdit; 66 | TreeView1: TTreeView; 67 | PopupMenu3: TPopupMenu; 68 | Popup11: TMenuItem; 69 | Popup21: TMenuItem; 70 | Edit1: TEdit; 71 | ListBox1: TListBox; 72 | LinkLabel1: TLinkLabel; 73 | Panel6: TPanel; 74 | Panel7: TPanel; 75 | ToolBar1: TToolBar; 76 | ToolButton3: TToolButton; 77 | ToolButton1: TToolButton; 78 | ToolButton2: TToolButton; 79 | ToolButton4: TToolButton; 80 | Panel8: TPanel; 81 | ToolBar2: TToolBar; 82 | ToolButton5: TToolButton; 83 | ToolButton6: TToolButton; 84 | ToolButton7: TToolButton; 85 | ToolButton8: TToolButton; 86 | ImageList1: TImageList; 87 | AutomatedStaticText1: TStaticText; 88 | ListBox2: TListBox; 89 | SpeedButton1: TSpeedButton; 90 | SpeedButton2: TSpeedButton; 91 | SpeedButton3: TSpeedButton; 92 | Button3: TButton; 93 | PopupMenu4: TPopupMenu; 94 | Menu11: TMenuItem; 95 | Menu21: TMenuItem; 96 | Menu31: TMenuItem; 97 | procedure Button2Click(Sender: TObject); 98 | procedure Button1Click(Sender: TObject); 99 | procedure Exit1Click(Sender: TObject); 100 | procedure PopupMenu2Click(Sender: TObject); 101 | procedure FormCreate(Sender: TObject); 102 | procedure ToolButton1Click(Sender: TObject); 103 | procedure ToolButton5Click(Sender: TObject); 104 | procedure ToolButton7Click(Sender: TObject); 105 | procedure LinkLabel1Click(Sender: TObject); 106 | procedure FormDestroy(Sender: TObject); 107 | procedure Button3Click(Sender: TObject); 108 | procedure SpeedButton1Click(Sender: TObject); 109 | procedure SpeedButton2Click(Sender: TObject); 110 | procedure SpeedButton3Click(Sender: TObject); 111 | procedure ToolButton2Click(Sender: TObject); 112 | procedure ToolButton4Click(Sender: TObject); 113 | private 114 | { Private declarations } 115 | FRestServer : TRestServer; 116 | procedure CreateServer(port: word); 117 | procedure DestroyServer; 118 | procedure LogMessage(const msg: String); 119 | public 120 | { Public declarations } 121 | end; 122 | 123 | var 124 | Form1: TForm1; 125 | 126 | implementation 127 | 128 | {$R *.dfm} 129 | 130 | procedure TForm1.Button1Click(Sender: TObject); 131 | begin 132 | ShowMessage (edit1.Text + ' | ' + edit2.Text); 133 | end; 134 | 135 | procedure TForm1.Button2Click(Sender: TObject); 136 | begin 137 | ShowMessage ('Cancelled'); 138 | end; 139 | 140 | procedure TForm1.Button3Click(Sender: TObject); 141 | begin 142 | ShowMessage(self.caption); 143 | end; 144 | 145 | procedure TForm1.Exit1Click(Sender: TObject); 146 | begin 147 | ShowMessage('Oh well done'); 148 | end; 149 | 150 | procedure TForm1.FormCreate(Sender: TObject); 151 | begin 152 | createServer(4723); 153 | 154 | AutomationStringGrid1.Cells[0,0] := 'Title 1'; 155 | AutomationStringGrid1.Cells[1,0] := 'Title 2'; 156 | AutomationStringGrid1.Cells[2,0] := 'Title 3'; 157 | AutomationStringGrid1.Cells[3,0] := 'Title 4'; 158 | AutomationStringGrid1.Cells[4,0] := 'Title 5'; 159 | 160 | AutomationStringGrid1.Cells[0,1] := 'Row 1, Col 0'; 161 | AutomationStringGrid1.Cells[1,1] := 'Row 1, Col 1'; 162 | AutomationStringGrid1.Cells[2,1] := 'Row 1, Col 2'; 163 | AutomationStringGrid1.Cells[3,1] := 'Row 1, Col 3'; 164 | AutomationStringGrid1.Cells[4,1] := 'Row 1, Col 4'; 165 | 166 | AutomationStringGrid1.Cells[0,3] := 'Row 3, Col 0'; 167 | AutomationStringGrid1.Cells[1,3] := 'Row 3, Col 1'; 168 | AutomationStringGrid1.Cells[2,3] := 'Row 3, Col 2'; 169 | AutomationStringGrid1.Cells[3,3] := 'Row 3, Col 3'; 170 | AutomationStringGrid1.Cells[4,3] := 'Row 3, Col 4'; 171 | 172 | end; 173 | 174 | procedure TForm1.FormDestroy(Sender: TObject); 175 | begin 176 | FRestServer.Free; 177 | end; 178 | 179 | procedure TForm1.LinkLabel1Click(Sender: TObject); 180 | begin 181 | ShowMessage ('LinkLabel1Click'); 182 | end; 183 | 184 | procedure TForm1.PopupMenu2Click(Sender: TObject); 185 | begin 186 | ShowMessage ('Popup menu clicked'); 187 | end; 188 | 189 | procedure TForm1.SpeedButton1Click(Sender: TObject); 190 | begin 191 | ShowMessage('SpeedButton1Click'); 192 | end; 193 | 194 | procedure TForm1.SpeedButton2Click(Sender: TObject); 195 | begin 196 | ShowMessage('SpeedButton2Click'); 197 | end; 198 | 199 | procedure TForm1.SpeedButton3Click(Sender: TObject); 200 | begin 201 | ShowMessage('SpeedButton3Click'); 202 | end; 203 | 204 | procedure TForm1.ToolButton1Click(Sender: TObject); 205 | begin 206 | ShowMessage ('ToolButton1Click'); 207 | end; 208 | 209 | procedure TForm1.ToolButton2Click(Sender: TObject); 210 | begin 211 | ShowMessage ('ToolButton2Click'); 212 | end; 213 | 214 | procedure TForm1.ToolButton4Click(Sender: TObject); 215 | begin 216 | ShowMessage ('ToolButton4Click'); 217 | end; 218 | 219 | procedure TForm1.ToolButton5Click(Sender: TObject); 220 | begin 221 | ShowMessage ('ToolButton5Click'); 222 | end; 223 | 224 | procedure TForm1.ToolButton7Click(Sender: TObject); 225 | begin 226 | ShowMessage ('ToolButton7Click'); 227 | end; 228 | 229 | procedure TForm1.CreateServer(port: word); 230 | begin 231 | FRestServer := TRestServer.Create(self); 232 | FRestServer.OnLogMessage := LogMessage; 233 | 234 | FRestServer.Start(port); 235 | end; 236 | 237 | procedure TForm1.DestroyServer; 238 | begin 239 | FRestServer.Free; 240 | end; 241 | 242 | procedure TForm1.LogMessage(const msg: String); 243 | begin 244 | ListBox2.Items.Add(msg); 245 | end; 246 | 247 | end. 248 | -------------------------------------------------------------------------------- /TestHost/TestHost.dpr: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { DelphiUIAutomation } 4 | { } 5 | { Copyright 2015-16 JHC Systems Limited } 6 | { } 7 | {***************************************************************************} 8 | { } 9 | { Licensed under the Apache License, Version 2.0 (the "License"); } 10 | { you may not use this file except in compliance with the License. } 11 | { You may obtain a copy of the License at } 12 | { } 13 | { http://www.apache.org/licenses/LICENSE-2.0 } 14 | { } 15 | { Unless required by applicable law or agreed to in writing, software } 16 | { distributed under the License is distributed on an "AS IS" BASIS, } 17 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 18 | { See the License for the specific language governing permissions and } 19 | { limitations under the License. } 20 | { } 21 | {***************************************************************************} 22 | program TestHost; 23 | 24 | uses 25 | Vcl.Forms, 26 | HostMain in 'HostMain.pas' {Form1}, 27 | CommandRegistry in '..\CommandRegistry.pas', 28 | HttpServerCommand in '..\HttpServerCommand.pas', 29 | JsonAttributeSource in '..\JsonAttributeSource.pas', 30 | ResourceProcessing in '..\ResourceProcessing.pas', 31 | RestServer in '..\RestServer.pas', 32 | Session in '..\Session.pas', 33 | Sessions in '..\Sessions.pas', 34 | Utils in '..\Utils.pas', 35 | Commands.ClickElement in '..\Commands\Commands.ClickElement.pas', 36 | Commands.CreateSession in '..\Commands\Commands.CreateSession.pas', 37 | Commands.GetRect in '..\Commands\Commands.GetRect.pas', 38 | Commands.GetText in '..\Commands\Commands.GetText.pas', 39 | Commands in '..\Commands\Commands.pas', 40 | Commands.PostElement in '..\Commands\Commands.PostElement.pas', 41 | Commands.PostElementElements in '..\Commands\Commands.PostElementElements.pas', 42 | Commands.PostElements in '..\Commands\Commands.PostElements.pas', 43 | Commands.PostExecute in '..\Commands\Commands.PostExecute.pas', 44 | Commands.GetEnabled in '..\Commands\Commands.GetEnabled.pas', 45 | Commands.PostValue in '..\Commands\Commands.PostValue.pas', 46 | Commands.DeleteSession in '..\Commands\Commands.DeleteSession.pas', 47 | Commands.GetWindowHandle in '..\Commands\Commands.GetWindowHandle.pas', 48 | Commands.PostClear in '..\Commands\Commands.PostClear.pas', 49 | Commands.GetElementValue in '..\Commands\Commands.GetElementValue.pas'; 50 | 51 | {$R *.res} 52 | 53 | begin 54 | Application.Initialize; 55 | Application.MainFormOnTaskbar := True; 56 | Application.CreateForm(TForm1, Form1); 57 | Application.Run; 58 | end. 59 | -------------------------------------------------------------------------------- /TestHost/TestHost.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mmarquee/DelphiWebDriver/312fcb62fdc86af8364af4465c5ecaad1aa2acb4/TestHost/TestHost.res -------------------------------------------------------------------------------- /Unit1.dfm: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 0 3 | Top = 0 4 | Caption = 'Form1' 5 | ClientHeight = 299 6 | ClientWidth = 635 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 Button1: TButton 17 | Left = 8 18 | Top = 266 19 | Width = 75 20 | Height = 25 21 | Caption = 'Start' 22 | TabOrder = 0 23 | OnClick = Button1Click 24 | end 25 | object ListBox1: TListBox 26 | Left = 8 27 | Top = 8 28 | Width = 619 29 | Height = 252 30 | ItemHeight = 13 31 | TabOrder = 1 32 | end 33 | object Button2: TButton 34 | Left = 89 35 | Top = 266 36 | Width = 75 37 | Height = 25 38 | Caption = 'Stop' 39 | Enabled = False 40 | TabOrder = 2 41 | OnClick = Button2Click 42 | end 43 | end 44 | -------------------------------------------------------------------------------- /Unit1.pas: -------------------------------------------------------------------------------- 1 | unit Unit1; 2 | 3 | interface 4 | 5 | uses 6 | RestServer, 7 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 8 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls; 9 | 10 | type 11 | TForm1 = class(TForm) 12 | Button1: TButton; 13 | ListBox1: TListBox; 14 | Button2: TButton; 15 | procedure Button1Click(Sender: TObject); 16 | procedure Button2Click(Sender: TObject); 17 | private 18 | { Private declarations } 19 | FRestServer : TRestServer; 20 | procedure createServer(port: word); 21 | procedure destroyServer; 22 | procedure LogMessage(const msg: String); 23 | public 24 | { Public declarations } 25 | end; 26 | 27 | var 28 | Form1: TForm1; 29 | 30 | implementation 31 | 32 | {$R *.dfm} 33 | 34 | procedure TForm1.LogMessage(const msg: String); 35 | begin 36 | listbox1.Items.Add(msg); 37 | end; 38 | 39 | procedure TForm1.Button1Click(Sender: TObject); 40 | begin 41 | createServer(4723); 42 | 43 | Button1.enabled := false; 44 | Button2.enabled := true; 45 | 46 | end; 47 | 48 | procedure TForm1.Button2Click(Sender: TObject); 49 | begin 50 | destroyServer; 51 | 52 | listbox1.Items.Add('Stopping server'); 53 | 54 | Button1.enabled := true; 55 | Button2.enabled := false; 56 | end; 57 | 58 | procedure TForm1.createServer(port: word); 59 | begin 60 | listbox1.Items.Add('Starting server on port ' + IntToStr(port)); 61 | FRestServer := TRestServer.Create(self); 62 | FRestServer.OnLogMessage := LogMessage; 63 | FRestServer.Start(port); 64 | end; 65 | 66 | procedure TForm1.destroyServer; 67 | begin 68 | FRestServer.Free; 69 | end; 70 | 71 | end. 72 | -------------------------------------------------------------------------------- /Utils.pas: -------------------------------------------------------------------------------- 1 | unit Utils; 2 | 3 | interface 4 | 5 | function isNumber(const s: String): boolean; 6 | 7 | implementation 8 | 9 | function isNumber(const s: String): boolean; 10 | var 11 | iValue, iCode: Integer; 12 | begin 13 | val(s, iValue, iCode); 14 | result := (iCode = 0) 15 | end; 16 | 17 | end. 18 | --------------------------------------------------------------------------------