├── .github └── FUNDING.yml ├── .gitignore ├── .gitmodules ├── CODE_OF_CONDUCT.md ├── CleanInplace.bat ├── CloudAPI.Attributes.pas ├── CloudAPI.Authenticator.Basic.pas ├── CloudAPI.Client.Base.pas ├── CloudAPI.Client.pas ├── CloudAPI.Converter.BasicTypes.pas ├── CloudAPI.Core.Constants.pas ├── CloudAPI.Core.RequestBuilder.pas ├── CloudAPI.Exceptions.pas ├── CloudAPI.Ext.MethodLimits.pas ├── CloudAPI.IAuthenticator.pas ├── CloudAPI.Json.Converters.pas ├── CloudAPI.LongPolling.pas ├── CloudAPI.MethodLimits.pas ├── CloudAPI.Parameter.pas ├── CloudAPI.Request.Body.pas ├── CloudAPI.Request.New.pas ├── CloudAPI.Request.pas ├── CloudAPI.RequestArgument.pas ├── CloudAPI.Response.Printer.pas ├── CloudAPI.Response.pas ├── CloudAPI.Types.pas ├── CloudAPI.dpk ├── CloudAPI.dproj ├── CloudAPIProject.groupproj ├── ISSUE_TEMPLATE.md ├── LICENSE.txt ├── Logo ├── I_stand_with_Ukraine_banner.png ├── I_stand_with_Ukraine_banner.psd ├── ca-CloudAPI-Delphi-512.png ├── ca-CloudAPI-Delphi-512.psd ├── ca-CloudAPI-Delphi-Ukraine-512.png ├── ca-CloudAPI-Delphi-Ukraine-512.psd ├── ca-CloudEmoji-Delphi-512.png ├── ca-CloudEmoji-Delphi-512.xcf ├── ca-RECT-CloudEmoji-Delphi-128.png ├── ca-RECT-CloudEmoji-Delphi-128.xcf ├── ca-RECT-CloudEmoji-Delphi-512.png ├── ca-RECT-CloudEmoji-Delphi-512.xcf ├── repository-open-graph-template.png ├── repository-open-graph-template.psd └── style.TXT ├── README.md └── Tests ├── CloudApiTest.dpr ├── CloudApiTest.dproj ├── Intergrated ├── HttpBinTest.Types.pas ├── HttpBinTest.pas └── pipedreamTest.pas └── UntiTests ├── RequestArgumentTest.Types.pas ├── RequestArgumentTest.pas └── RequestLimitManagerTest.pas /.github/FUNDING.yml: -------------------------------------------------------------------------------- 1 | # These are supported funding model platforms 2 | custom: ["https://send.monobank.ua/jar/6GXM5eR2UX"] 3 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Uncomment these types if you want even more clean repository. But be careful. 2 | # It can make harm to an existing project source. Read explanations below. 3 | # 4 | # Resource files are binaries containing manifest, project icon and version info. 5 | # They can not be viewed as text or compared by diff-tools. Consider replacing them with .rc files. 6 | #*.res 7 | # 8 | # Type library file (binary). In old Delphi versions it should be stored. 9 | # Since Delphi 2009 it is produced from .ridl file and can safely be ignored. 10 | #*.tlb 11 | # 12 | # Diagram Portfolio file. Used by the diagram editor up to Delphi 7. 13 | # Uncomment this if you are not using diagrams or use newer Delphi version. 14 | #*.ddp 15 | # 16 | # Visual LiveBindings file. Added in Delphi XE2. 17 | # Uncomment this if you are not using LiveBindings Designer. 18 | #*.vlb 19 | # 20 | # Deployment Manager configuration file for your project. Added in Delphi XE2. 21 | # Uncomment this if it is not mobile development and you do not use remote debug feature. 22 | #*.deployproj 23 | # 24 | # C++ object files produced when C/C++ Output file generation is configured. 25 | # Uncomment this if you are not using external objects (zlib library for example). 26 | #*.obj 27 | # 28 | 29 | # Delphi compiler-generated binaries (safe to delete) 30 | *.exe 31 | *.dll 32 | *.bpl 33 | *.bpi 34 | *.dcp 35 | *.so 36 | *.apk 37 | *.drc 38 | *.map 39 | *.dres 40 | *.rsm 41 | *.tds 42 | *.dcu 43 | *.lib 44 | *.a 45 | *.o 46 | *.ocx 47 | 48 | # Delphi autogenerated files (duplicated info) 49 | *.cfg 50 | *.hpp 51 | *Resource.rc 52 | 53 | # Delphi local files (user-specific info) 54 | *.local 55 | *.identcache 56 | *.projdata 57 | *.tvsconfig 58 | *.dsk 59 | 60 | # Delphi history and backups 61 | __history/ 62 | __recovery/ 63 | *.~* 64 | 65 | # Castalia statistics file (since XE7 Castalia is distributed with Delphi) 66 | *.stat 67 | 68 | # Boss dependency manager vendor folder https://github.com/HashLoad/boss 69 | modules/ 70 | bin/config.ini 71 | bin/dunitx-results.xml 72 | -------------------------------------------------------------------------------- /.gitmodules: -------------------------------------------------------------------------------- 1 | [submodule "DUnitX"] 2 | path = DUnitX 3 | url = https://github.com/VSoftTechnologies/DUnitX.git 4 | [submodule "FastMM5"] 5 | path = FastMM5 6 | url = https://github.com/pleriche/FastMM5.git 7 | -------------------------------------------------------------------------------- /CODE_OF_CONDUCT.md: -------------------------------------------------------------------------------- 1 | # Contributor Covenant Code of Conduct 2 | 3 | ## Our Pledge 4 | 5 | In the interest of fostering an open and welcoming environment, we as contributors and maintainers pledge to making participation in our project and our community a harassment-free experience for everyone, regardless of age, body size, disability, ethnicity, gender identity and expression, level of experience, nationality, personal appearance, race, religion, or sexual identity and orientation. 6 | 7 | ## Our Standards 8 | 9 | Examples of behavior that contributes to creating a positive environment include: 10 | 11 | * Using welcoming and inclusive language 12 | * Being respectful of differing viewpoints and experiences 13 | * Gracefully accepting constructive criticism 14 | * Focusing on what is best for the community 15 | * Showing empathy towards other community members 16 | 17 | Examples of unacceptable behavior by participants include: 18 | 19 | * The use of sexualized language or imagery and unwelcome sexual attention or advances 20 | * Trolling, insulting/derogatory comments, and personal or political attacks 21 | * Public or private harassment 22 | * Publishing others' private information, such as a physical or electronic address, without explicit permission 23 | * Other conduct which could reasonably be considered inappropriate in a professional setting 24 | 25 | ## Our Responsibilities 26 | 27 | Project maintainers are responsible for clarifying the standards of acceptable behavior and are expected to take appropriate and fair corrective action in response to any instances of unacceptable behavior. 28 | 29 | Project maintainers have the right and responsibility to remove, edit, or reject comments, commits, code, wiki edits, issues, and other contributions that are not aligned to this Code of Conduct, or to ban temporarily or permanently any contributor for other behaviors that they deem inappropriate, threatening, offensive, or harmful. 30 | 31 | ## Scope 32 | 33 | This Code of Conduct applies both within project spaces and in public spaces when an individual is representing the project or its community. Examples of representing a project or community include using an official project e-mail address, posting via an official social media account, or acting as an appointed representative at an online or offline event. Representation of a project may be further defined and clarified by project maintainers. 34 | 35 | ## Enforcement 36 | 37 | Instances of abusive, harassing, or otherwise unacceptable behavior may be reported by contacting the project team at maks4a@gmail.com. The project team will review and investigate all complaints, and will respond in a way that it deems appropriate to the circumstances. The project team is obligated to maintain confidentiality with regard to the reporter of an incident. Further details of specific enforcement policies may be posted separately. 38 | 39 | Project maintainers who do not follow or enforce the Code of Conduct in good faith may face temporary or permanent repercussions as determined by other members of the project's leadership. 40 | 41 | ## Attribution 42 | 43 | This Code of Conduct is adapted from the [Contributor Covenant][homepage], version 1.4, available at [http://contributor-covenant.org/version/1/4][version] 44 | 45 | [homepage]: http://contributor-covenant.org 46 | [version]: http://contributor-covenant.org/version/1/4/ 47 | -------------------------------------------------------------------------------- /CleanInplace.bat: -------------------------------------------------------------------------------- 1 | @ECHO OFF 2 | 3 | ECHO Cleaning... 4 | 5 | del /S %1*.str%2%3%4 6 | del /S %1*.rsm%2%3%4 7 | del /S %1*.lib%2%3%4 8 | del /S %1*.err%2%3%4 9 | del /S %1*.tds%2%3%4 10 | del /S %1*.hpp%2%3%4 11 | del /S %1*.obj%2%3%4 12 | del /S %1*.tds%2%3%4 13 | rem del /S %1*.map%2%3%4 14 | del /S %1*.drc%2%3%4 15 | del /S %1*.#*%2%3%4 16 | del /S %1*.csm%2%3%4 17 | del /S %1*.bpi%2%3%4 18 | del /S %1*.lib%2%3%4 19 | del /S %1*.ilc%2%3%4 20 | del /S %1*.ild%2%3%4 21 | del /S %1*.ilf%2%3%4 22 | del /S %1*.ils%2%3%4 23 | del /S %1*.cgi%2%3%4 24 | del /S %1*.drc%2%3%4 25 | del /S %1*.$*%2%3%4 26 | del /S %1*.dcu%2%3%4 27 | del /S %1*.bak%2%3%4 28 | del /S %1*.gid%2%3%4 29 | del /S %1*.fts%2%3%4 30 | del /S %1*.~*%2%3%4 31 | del /S %1*.dsk%2%3%4 32 | del /S %1*.ddp%2%3%4 33 | del /S %1*.bkm%2%3%4 34 | del /S %1*_orig_?.*%2%3%4 35 | del /S %1*.ressrc%2%3%4 36 | del /S %1*.cesettings%2%3%4 37 | del /S %1*.stat%2%3%4 38 | del /S %1*.identcache%2%3%4 39 | del /S %1*.local%2%3%4 40 | 41 | for /r . %%a in (__history\) do @if exist "%%a" rd /s /q "%%a" 42 | for /r . %%a in (__recovery\) do @if exist "%%a" rd /s /q "%%a" 43 | -------------------------------------------------------------------------------- /CloudAPI.Attributes.pas: -------------------------------------------------------------------------------- 1 | unit CloudAPI.Attributes; 2 | 3 | interface 4 | 5 | uses 6 | CloudAPI.Types; 7 | 8 | type 9 | TcaCustomAttribute = class(TCustomAttribute); 10 | 11 | caNameAttribute = class(TcaCustomAttribute) 12 | private 13 | FName: string; 14 | public 15 | constructor Create(const AName: string); 16 | property Name: string read FName write FName; 17 | end; 18 | 19 | caMethodAttribute = class(TcaCustomAttribute) 20 | private 21 | FMethod: TcaMethod; 22 | public 23 | constructor Create(const AMethod: TcaMethod); 24 | property Method: TcaMethod read FMethod write FMethod; 25 | end; 26 | 27 | caDefaultValueAttribute = class(TcaCustomAttribute) 28 | public 29 | function ToString: string; override; abstract; 30 | end; 31 | 32 | caDefaultValueAttribute = class(caDefaultValueAttribute) 33 | private 34 | FDefaultValue: T; 35 | public 36 | constructor Create(const ADefaultValue: T); 37 | property DefaultValue: T read FDefaultValue write FDefaultValue; 38 | end; 39 | 40 | caDefaultValueStringAttribute = class(caDefaultValueAttribute) 41 | public 42 | function ToString: string; override; 43 | end; 44 | 45 | caDefaultValueIntAttribute = class(caDefaultValueAttribute) 46 | public 47 | function ToString: string; override; 48 | end; 49 | 50 | caDefaultValueInt64Attribute = class(caDefaultValueAttribute) 51 | public 52 | function ToString: string; override; 53 | end; 54 | 55 | caDefaultValueSingleAttribute = class(caDefaultValueAttribute) 56 | public 57 | function ToString: string; override; 58 | end; 59 | 60 | caDefaultValueBooleanAttribute = class(caDefaultValueAttribute) 61 | public 62 | function ToString: string; override; 63 | end; 64 | 65 | caIsRequairedAttribute = class(TcaCustomAttribute) 66 | private 67 | FIsRequired: Boolean; 68 | public 69 | constructor Create(const AIsRequired: Boolean); overload; 70 | constructor Create; overload; 71 | property IsRequired: Boolean read FIsRequired write FIsRequired; 72 | end; 73 | 74 | caParameterTypeAttribute = class(TcaCustomAttribute) 75 | private 76 | FParameterType: TcaParameterType; 77 | public 78 | constructor Create(const AParameterType: TcaParameterType); 79 | property ParameterType: TcaParameterType read FParameterType write FParameterType; 80 | end; 81 | 82 | caLimitedMethodAttribute = class(TcaCustomAttribute) 83 | private 84 | FLimit: Int64; 85 | FIsGlobal: Boolean; 86 | public 87 | constructor Create(const ALimit: Int64; AIsGlobal: Boolean); 88 | property Limit: Int64 read FLimit write FLimit; 89 | property IsGlobal: Boolean read FIsGlobal write FIsGlobal; 90 | end; 91 | 92 | implementation 93 | 94 | uses 95 | System.SysUtils; 96 | 97 | { caNameAttribute } 98 | constructor caNameAttribute.Create(const AName: string); 99 | begin 100 | FName := AName; 101 | end; 102 | 103 | { caDefaultValueAttribute } 104 | constructor caDefaultValueAttribute.Create(const ADefaultValue: T); 105 | begin 106 | inherited Create(); 107 | FDefaultValue := ADefaultValue; 108 | end; 109 | 110 | { caDefaultValueStringAttribute } 111 | 112 | function caDefaultValueStringAttribute.ToString: string; 113 | begin 114 | Result := FDefaultValue; 115 | end; 116 | 117 | { caDefaultValueInt64Attribute } 118 | 119 | function caDefaultValueInt64Attribute.ToString: string; 120 | begin 121 | Result := FDefaultValue.ToString; 122 | end; 123 | 124 | { caIsRequairedAttribute } 125 | constructor caIsRequairedAttribute.Create; 126 | begin 127 | FIsRequired := True; 128 | end; 129 | 130 | constructor caIsRequairedAttribute.Create(const AIsRequired: Boolean); 131 | begin 132 | FIsRequired := AIsRequired; 133 | end; 134 | 135 | { caParameterTypeAttribute } 136 | 137 | constructor caParameterTypeAttribute.Create(const AParameterType: TcaParameterType); 138 | begin 139 | FParameterType := AParameterType; 140 | end; 141 | 142 | { caDefaultValueBooleanAttribute } 143 | 144 | function caDefaultValueBooleanAttribute.ToString: string; 145 | begin 146 | Result := FDefaultValue.ToString(TUseBoolStrs.True); 147 | end; 148 | 149 | { caMethodAttribute } 150 | 151 | constructor caMethodAttribute.Create(const AMethod: TcaMethod); 152 | begin 153 | FMethod := AMethod; 154 | end; 155 | 156 | { caLimitedMethodAttribute } 157 | 158 | constructor caLimitedMethodAttribute.Create(const ALimit: Int64; AIsGlobal: Boolean); 159 | begin 160 | FLimit := ALimit; 161 | FIsGlobal := AIsGlobal; 162 | end; 163 | 164 | { caDefaultValueSingleAttribute } 165 | 166 | function caDefaultValueSingleAttribute.ToString: string; 167 | begin 168 | Result := FDefaultValue.ToString; 169 | end; 170 | 171 | { caDefaultValueIntAttribute } 172 | 173 | function caDefaultValueIntAttribute.ToString: string; 174 | begin 175 | Result := FDefaultValue.ToString; 176 | end; 177 | 178 | end. 179 | -------------------------------------------------------------------------------- /CloudAPI.Authenticator.Basic.pas: -------------------------------------------------------------------------------- 1 | unit CloudAPI.Authenticator.Basic; 2 | 3 | interface 4 | 5 | uses 6 | CloudAPI.IAuthenticator, 7 | CloudAPI.Request; 8 | 9 | type 10 | TBasicAuthenticator = class(TInterfacedObject, IAuthenticator) 11 | private 12 | FPassword: string; 13 | FUser: string; 14 | public 15 | constructor Create(const AUser, APassword: string); 16 | procedure Authenticate(ARequest: IcaRequest); 17 | property Password: string read FPassword write FPassword; 18 | property User: string read FUser write FUser; 19 | end; 20 | 21 | implementation 22 | 23 | uses 24 | CloudAPI.Types, 25 | CloudAPI.Parameter, 26 | System.NetEncoding, 27 | System.Net.URLClient; 28 | { TBasicAuthenticator } 29 | 30 | procedure TBasicAuthenticator.Authenticate(ARequest: IcaRequest); 31 | var 32 | LParam: TcaParameter; 33 | begin 34 | LParam.Name := 'Authorization'; 35 | LParam.Value := 'Basic ' + TNetEncoding.Base64.Encode(User + ':' + Password); 36 | LParam.DefaultValue := ''; 37 | LParam.ParameterType := TcaParameterType.HttpHeader; 38 | LParam.IsRequired := True; 39 | ARequest.AddParam(LParam); 40 | end; 41 | 42 | constructor TBasicAuthenticator.Create(const AUser, APassword: string); 43 | begin 44 | FUser := AUser; 45 | FPassword := APassword; 46 | end; 47 | 48 | end. 49 | -------------------------------------------------------------------------------- /CloudAPI.Client.Base.pas: -------------------------------------------------------------------------------- 1 | unit CloudAPI.Client.Base; 2 | 3 | interface 4 | 5 | uses 6 | CloudAPI.Exceptions, 7 | CloudAPI.Ext.MethodLimits, 8 | CloudAPI.IAuthenticator, 9 | CloudAPI.Parameter, 10 | CloudAPI.Request, 11 | CloudAPI.Response, 12 | CloudAPI.Response.Printer, 13 | System.Classes, 14 | System.Generics.Collections, 15 | System.JSON.Serializers, 16 | System.Net.HttpClient, 17 | System.Net.Mime, 18 | System.Net.URLClient, 19 | System.SysUtils; 20 | 21 | type 22 | TCloudApiClientBase = class(TPersistent) 23 | public const 24 | LIB_VERSION = '4.3.0'; 25 | private 26 | FAuthenticator: IAuthenticator; 27 | FBaseUrl: string; 28 | FHttpClient: THTTPClient; 29 | FVersion: string; 30 | FDefaultParams: TList; 31 | FRequestLimitManager: TcaRequestLimitManager; 32 | FResponseStream: TStream; 33 | FSerializer: TJsonSerializer; 34 | fExceptionManager: TcaExceptionManager; 35 | FResponsePrinter: TcaResponsePrinter; 36 | FOnExcecuteCallback: TProc; 37 | function GetAuthenticator: IAuthenticator; 38 | function GetBaseUrl: string; 39 | procedure SetAuthenticator(const Value: IAuthenticator); 40 | procedure SetBaseUrl(const Value: string); 41 | protected 42 | procedure AuthenticateIfNeeded(ARequest: IcaRequest); 43 | function GetSerializer: TJsonSerializer; 44 | function TryInternalExcecute(ARequest: IcaRequest; var AResp: IcaResponseBase): Boolean; 45 | procedure WriteLimitInfo(ARequest: IcaRequest); 46 | procedure DoOnLimit(const ATimeLimit: Int64); 47 | procedure DoOnExcecute(AcaResponse: IcaResponseBase); 48 | public 49 | constructor Create; overload; 50 | constructor Create(const ABaseUrl: string); overload; 51 | destructor Destroy; override; 52 | public 53 | procedure Assign(Source: TPersistent); override; 54 | property Authenticator: IAuthenticator read GetAuthenticator write SetAuthenticator; 55 | property BaseUrl: string read GetBaseUrl write SetBaseUrl; 56 | property DefaultParams: TList read FDefaultParams; 57 | property HttpClient: THTTPClient read FHttpClient; 58 | property RequestLimitManager: TcaRequestLimitManager read FRequestLimitManager write FRequestLimitManager; 59 | property ResponseStream: TStream read FResponseStream write FResponseStream; 60 | property Version: string read FVersion; 61 | property Serializer: TJsonSerializer read FSerializer; 62 | property ExceptionManager: TcaExceptionManager read fExceptionManager write fExceptionManager; 63 | property ResponsePrinter: TcaResponsePrinter read FResponsePrinter write FResponsePrinter; 64 | property OnExcecuteCallback: TProc read FOnExcecuteCallback write FOnExcecuteCallback; 65 | end; 66 | 67 | implementation 68 | 69 | uses 70 | CloudAPI.Core.RequestBuilder, 71 | CloudAPI.Types, 72 | System.Rtti; 73 | { TCloudApiClientBase } 74 | 75 | procedure TCloudApiClientBase.Assign(Source: TPersistent); 76 | begin 77 | if Source is TCloudApiClientBase then 78 | begin 79 | FAuthenticator := TCloudApiClientBase(Source).Authenticator; 80 | FOnExcecuteCallback := TCloudApiClientBase(Source).FOnExcecuteCallback; 81 | end 82 | else 83 | inherited Assign(Source); 84 | end; 85 | 86 | procedure TCloudApiClientBase.AuthenticateIfNeeded(ARequest: IcaRequest); 87 | begin 88 | if Assigned(FAuthenticator) then 89 | FAuthenticator.Authenticate(ARequest); 90 | end; 91 | 92 | constructor TCloudApiClientBase.Create; 93 | begin 94 | FHttpClient := THTTPClient.Create; 95 | FHttpClient.AllowCookies := True; 96 | FHttpClient.AutomaticDecompression := [THTTPCompressionMethod.Any]; 97 | FSerializer := TJsonSerializer.Create; 98 | FHttpClient.UserAgent := 'CloudAPI for Delphi v.' + LIB_VERSION; 99 | FHttpClient.ResponseTimeout := 5000; 100 | FDefaultParams := TList.Create; 101 | FRequestLimitManager := TcaRequestLimitManager.Create; 102 | FResponseStream := nil; 103 | fExceptionManager := TcaExceptionManager.Current; 104 | FResponsePrinter := TcaResponsePrinter.Create(); 105 | end; 106 | 107 | constructor TCloudApiClientBase.Create(const ABaseUrl: string); 108 | begin 109 | self.Create; 110 | FBaseUrl := ABaseUrl; 111 | end; 112 | 113 | destructor TCloudApiClientBase.Destroy; 114 | begin 115 | FSerializer.Free; 116 | FRequestLimitManager.Free; 117 | FDefaultParams.Free; 118 | FHttpClient.Free; 119 | // fExceptionManager.Free; 120 | FResponsePrinter.Free; 121 | inherited; 122 | end; 123 | 124 | procedure TCloudApiClientBase.DoOnExcecute(AcaResponse: IcaResponseBase); 125 | begin 126 | if Assigned(OnExcecuteCallback) then 127 | OnExcecuteCallback(AcaResponse); 128 | end; 129 | 130 | procedure TCloudApiClientBase.DoOnLimit(const ATimeLimit: Int64); 131 | begin 132 | if ATimeLimit > 0 then 133 | if Assigned(FRequestLimitManager.OnLimit) then 134 | FRequestLimitManager.OnLimit(ATimeLimit); 135 | end; 136 | 137 | function TCloudApiClientBase.TryInternalExcecute(ARequest: IcaRequest; var AResp: IcaResponseBase): Boolean; 138 | var 139 | I: Integer; 140 | lHttpRequest: IHTTPRequest; 141 | lHttpResponse: IHTTPResponse; 142 | lException: ECloudApiException; 143 | begin 144 | lException := nil; 145 | if not Assigned(ARequest) then 146 | ARequest := TcaRequest.Create; 147 | AuthenticateIfNeeded(ARequest); 148 | for I := 0 to FDefaultParams.Count - 1 do 149 | ARequest.AddParam(FDefaultParams[I]); 150 | 151 | lHttpRequest := TRequestBuilder.Build(self, ARequest); 152 | WriteLimitInfo(ARequest); 153 | ARequest.StartAt := Now; 154 | try 155 | lHttpResponse := FHttpClient.Execute(lHttpRequest, FResponseStream, lHttpRequest.Headers); 156 | Result := True; 157 | except 158 | on E: Exception do 159 | begin 160 | lException := ECloudApiException.Create(E.ClassName, E.ToString); 161 | ExceptionManager.Alert(lException); 162 | lHttpResponse := nil; 163 | Result := False; 164 | end; 165 | end; 166 | AResp := TcaResponseBase.Create(ARequest, lHttpRequest, lHttpResponse, lException); 167 | FResponsePrinter.ParseResponse(AResp as TcaResponseBase); 168 | DoOnExcecute(AResp); 169 | end; 170 | 171 | function TCloudApiClientBase.GetAuthenticator: IAuthenticator; 172 | begin 173 | Result := FAuthenticator; 174 | end; 175 | 176 | function TCloudApiClientBase.GetBaseUrl: string; 177 | begin 178 | Result := FBaseUrl; 179 | end; 180 | 181 | function TCloudApiClientBase.GetSerializer: TJsonSerializer; 182 | begin 183 | Result := FSerializer; 184 | end; 185 | 186 | procedure TCloudApiClientBase.SetAuthenticator(const Value: IAuthenticator); 187 | begin 188 | FAuthenticator := Value; 189 | end; 190 | 191 | procedure TCloudApiClientBase.SetBaseUrl(const Value: string); 192 | begin 193 | FBaseUrl := Value; 194 | end; 195 | 196 | procedure TCloudApiClientBase.WriteLimitInfo(ARequest: IcaRequest); 197 | var 198 | LTotalWait: Int64; 199 | begin 200 | LTotalWait := FRequestLimitManager.LocalWait(ARequest.LimitInfo.Name); 201 | DoOnLimit(LTotalWait); 202 | FRequestLimitManager.Add(ARequest.LimitInfo.Limit, ARequest.LimitInfo.Name, ARequest.LimitInfo.IsGlobal); 203 | end; 204 | 205 | end. 206 | -------------------------------------------------------------------------------- /CloudAPI.Client.pas: -------------------------------------------------------------------------------- 1 | unit CloudAPI.Client; 2 | 3 | interface 4 | 5 | uses 6 | CloudAPI.Client.Base, 7 | CloudAPI.Response, 8 | CloudAPI.Request, 9 | CloudAPI.Types, 10 | System.Classes, 11 | System.SysUtils; 12 | 13 | type 14 | TCloudApiClient = class(TCloudApiClientBase) 15 | public 16 | function Download(const AUrl, AFileName: string; ARequest: IcaRequest = nil): IcaResponseBase; overload; 17 | function Download(const AUrl: string; AStream: TStream; ARequest: IcaRequest = nil): IcaResponseBase; overload; 18 | function Execute(ARequest: IcaRequest): IcaResponseBase; overload; 19 | function Execute(ARequest: IcaRequest): IcaResponse; overload; 20 | function TryExecute(ARequest: IcaRequest; var AResp: IcaResponseBase): Boolean; overload; 21 | function TryExecute(ARequest: IcaRequest; var AResp: IcaResponse): Boolean; overload; 22 | function GroupExecute(ARequests: TArray): TArray; overload; 23 | function GroupExecute(ARequests: TArray): TArray>; overload; 24 | // Async 25 | procedure TryExecuteAsync(ARequest: IcaRequest; AResponse: TProc); overload; 26 | procedure TryExecuteAsync(ARequest: IcaRequest; AOnResponse: TProc < IcaResponse < T >> ); overload; 27 | end; 28 | 29 | implementation 30 | 31 | uses 32 | CloudAPI.Exceptions; 33 | 34 | { TCloudApiClient } 35 | 36 | function TCloudApiClient.Download(const AUrl, AFileName: string; ARequest: IcaRequest = nil): IcaResponseBase; 37 | var 38 | lFileStream: TFileStream; 39 | begin 40 | lFileStream := TFileStream.Create(AFileName, fmCreate); 41 | try 42 | Result := Download(AUrl, lFileStream, ARequest); 43 | finally 44 | lFileStream.Free; 45 | end; 46 | end; 47 | 48 | function TCloudApiClient.Download(const AUrl: string; AStream: TStream; ARequest: IcaRequest = nil): IcaResponseBase; 49 | var 50 | lOriginalStream: TStream; 51 | lOriginalUrl: string; 52 | begin 53 | lOriginalStream := ResponseStream; 54 | lOriginalUrl := BaseUrl; 55 | ResponseStream := AStream; 56 | try 57 | BaseUrl := AUrl; 58 | TryInternalExcecute(ARequest, Result); 59 | finally 60 | ResponseStream := lOriginalStream; 61 | BaseUrl := lOriginalUrl; 62 | end; 63 | end; 64 | 65 | function TCloudApiClient.Execute(ARequest: IcaRequest): IcaResponseBase; 66 | begin 67 | if not TryInternalExcecute(ARequest, Result) then 68 | raise Result.Exception; 69 | end; 70 | 71 | function TCloudApiClient.Execute(ARequest: IcaRequest): IcaResponse; 72 | var 73 | LResult: IcaResponseBase; 74 | begin 75 | LResult := Execute(ARequest); 76 | Result := TcaResponse.Create(ARequest, LResult.HttpRequest, LResult.HttpResponse, GetSerializer, 77 | LResult.Exception); 78 | end; 79 | 80 | function TCloudApiClient.GroupExecute(ARequests: TArray): TArray; 81 | var 82 | I: Integer; 83 | begin 84 | SetLength(Result, Length(ARequests)); 85 | for I := Low(ARequests) to High(ARequests) do 86 | Result[I] := Execute(ARequests[I]); 87 | end; 88 | 89 | function TCloudApiClient.GroupExecute(ARequests: TArray): TArray>; 90 | var 91 | I: Integer; 92 | begin 93 | SetLength(Result, Length(ARequests)); 94 | for I := Low(ARequests) to High(ARequests) do 95 | Result[I] := Execute(ARequests[I]); 96 | end; 97 | 98 | function TCloudApiClient.TryExecute(ARequest: IcaRequest; var AResp: IcaResponseBase): Boolean; 99 | begin 100 | Result := TryInternalExcecute(ARequest, AResp); 101 | end; 102 | 103 | function TCloudApiClient.TryExecute(ARequest: IcaRequest; var AResp: IcaResponse): Boolean; 104 | var 105 | LResult: IcaResponseBase; 106 | begin 107 | if TryExecute(ARequest, LResult) then 108 | AResp := TcaResponse.Create(ARequest, LResult.HttpRequest, LResult.HttpResponse, GetSerializer, 109 | LResult.Exception); 110 | Result := AResp <> nil; 111 | end; 112 | 113 | procedure TCloudApiClient.TryExecuteAsync(ARequest: IcaRequest; AResponse: TProc); 114 | var 115 | LThread: TThread; 116 | begin 117 | LThread := TThread.CreateAnonymousThread( 118 | procedure 119 | var 120 | LResult: Boolean; 121 | LResponse: IcaResponseBase; 122 | begin 123 | LResult := TryExecute(ARequest, LResponse); 124 | if IsConsole then 125 | begin 126 | if Assigned(AResponse) then 127 | AResponse(LResult, LResponse); 128 | end 129 | else 130 | begin 131 | TThread.Synchronize(nil, 132 | procedure 133 | begin 134 | if Assigned(AResponse) then 135 | AResponse(LResult, LResponse); 136 | end); 137 | end; 138 | end); 139 | 140 | LThread.FreeOnTerminate := True; 141 | LThread.Start; 142 | 143 | end; 144 | 145 | procedure TCloudApiClient.TryExecuteAsync(ARequest: IcaRequest; AOnResponse: TProc < IcaResponse < T >> ); 146 | begin 147 | TryExecuteAsync(ARequest, 148 | procedure(AResult: Boolean; AResponse: IcaResponseBase) 149 | var 150 | LResponse: IcaResponse; 151 | begin 152 | if Assigned(AOnResponse) then 153 | begin 154 | LResponse := TcaResponse.Create(ARequest, AResponse.HttpRequest, AResponse.HttpResponse, GetSerializer, 155 | AResponse.Exception); 156 | AOnResponse(LResponse); 157 | end; 158 | end); 159 | end; 160 | 161 | end. 162 | -------------------------------------------------------------------------------- /CloudAPI.Converter.BasicTypes.pas: -------------------------------------------------------------------------------- 1 | unit CloudAPI.Converter.BasicTypes; 2 | 3 | interface 4 | 5 | uses 6 | CloudAPI.RequestArgument; 7 | 8 | type 9 | TcaBasicConverters = class 10 | private 11 | class procedure StringConverter(AConverterManager: TcaRequestArgument); 12 | class procedure IntegerConverter(AConverterManager: TcaRequestArgument); 13 | class procedure Int64Converter(AConverterManager: TcaRequestArgument); 14 | class procedure SingleConverter(AConverterManager: TcaRequestArgument); 15 | class procedure BooleanConverter(AConverterManager: TcaRequestArgument); 16 | class procedure TDateTimeConverter(AConverterManager: TcaRequestArgument); 17 | public 18 | class procedure BasicConverter(AConverterManager: TcaRequestArgument); 19 | end; 20 | 21 | implementation 22 | 23 | uses 24 | System.DateUtils, 25 | System.JSON.Serializers, 26 | System.SysUtils, 27 | System.Rtti; 28 | 29 | { TcaBasicConverters } 30 | 31 | class procedure TcaBasicConverters.BasicConverter(AConverterManager: TcaRequestArgument); 32 | begin 33 | StringConverter(AConverterManager); 34 | AConverterManager.RegisterToJson>; 35 | IntegerConverter(AConverterManager); 36 | Int64Converter(AConverterManager); 37 | BooleanConverter(AConverterManager); 38 | SingleConverter(AConverterManager); 39 | TDateTimeConverter(AConverterManager); 40 | end; 41 | 42 | class procedure TcaBasicConverters.BooleanConverter(AConverterManager: TcaRequestArgument); 43 | begin 44 | AConverterManager.RegisterConverter( 45 | function(AValue: TValue): string 46 | begin 47 | Result := AValue.AsBoolean.ToString(TUseBoolStrs.True); 48 | end); 49 | end; 50 | 51 | class procedure TcaBasicConverters.Int64Converter(AConverterManager: TcaRequestArgument); 52 | begin 53 | AConverterManager.RegisterConverter( 54 | function(AValue: TValue): string 55 | begin 56 | Result := AValue.AsInt64.ToString; 57 | end); 58 | end; 59 | 60 | class procedure TcaBasicConverters.IntegerConverter(AConverterManager: TcaRequestArgument); 61 | begin 62 | AConverterManager.RegisterConverter( 63 | function(AValue: TValue): string 64 | begin 65 | Result := AValue.AsInteger.ToString; 66 | end); 67 | end; 68 | 69 | class procedure TcaBasicConverters.SingleConverter(AConverterManager: TcaRequestArgument); 70 | begin 71 | AConverterManager.RegisterConverter( 72 | function(AValue: TValue): string 73 | var 74 | FS: TFormatSettings; 75 | begin 76 | FS := TFormatSettings.Invariant; 77 | Result := AValue.AsExtended.ToString(TFloatFormat.ffGeneral, 8, 6, FS); 78 | end); 79 | end; 80 | 81 | class procedure TcaBasicConverters.StringConverter(AConverterManager: TcaRequestArgument); 82 | begin 83 | AConverterManager.RegisterConverter( 84 | function(AValue: TValue): string 85 | begin 86 | Result := AValue.AsString; 87 | end); 88 | end; 89 | 90 | class procedure TcaBasicConverters.TDateTimeConverter(AConverterManager: TcaRequestArgument); 91 | begin 92 | AConverterManager.RegisterConverter( 93 | function(AValue: TValue): string 94 | var 95 | LValue: TDateTime; 96 | begin 97 | LValue := AValue.AsType; 98 | Result := DateTimeToUnix(LValue).ToString; 99 | end); 100 | end; 101 | 102 | end. 103 | -------------------------------------------------------------------------------- /CloudAPI.Core.Constants.pas: -------------------------------------------------------------------------------- 1 | unit CloudAPI.Core.Constants; 2 | 3 | interface 4 | 5 | type 6 | TcaConstException = class 7 | public const 8 | PARAMETER_REQIRED = 'Parameter "{Parameter.Name}" is requaired in method "{Method}"!'; 9 | RAISED_AT_FORMAT = 'hh:mm:ss.zzz'; 10 | EXCEPTION_MSG_FORMAT = '({RaisedAt}) [{Code}] {Message}'; 11 | end; 12 | 13 | implementation 14 | 15 | end. 16 | -------------------------------------------------------------------------------- /CloudAPI.Core.RequestBuilder.pas: -------------------------------------------------------------------------------- 1 | unit CloudAPI.Core.RequestBuilder; 2 | 3 | interface 4 | 5 | uses 6 | CloudAPI.Client.Base, 7 | System.Net.HttpClient, 8 | CloudAPI.Request, 9 | System.Net.Mime, 10 | System.Net.URLClient, 11 | System.Classes, 12 | System.SysUtils, 13 | CloudAPI.Types; 14 | 15 | type 16 | TRequestBuilder = class 17 | private 18 | FClient: TCloudApiClientBase; 19 | FRequest: IHTTPRequest; 20 | FcaRequest: IcaRequest; 21 | FFormData: TMultipartFormData; 22 | FRequestBody: TStringList; 23 | FUrl: TURI; 24 | FUrlString: string; 25 | protected 26 | procedure BuildHttpHeaders; 27 | procedure BuildCookies; 28 | procedure BuildQueryParameters; 29 | class function BuildUrlSegments(const AUrl: string; ARequest: IcaRequest): TURI; 30 | procedure BuildGetOrPosts; 31 | procedure BuildFiles; 32 | procedure BuildFormData; 33 | procedure BuildRequestBody; 34 | function DoBuild: IHTTPRequest; 35 | class procedure CreateFormFromStrings(const ASource: TStrings; const AEncoding: TEncoding; 36 | const AHeaders: TNetHeaders; var ASourceStream: TStream; var ASourceHeaders: TNetHeaders); 37 | public 38 | constructor Create(AClient: TCloudApiClientBase; ARequest: IcaRequest); 39 | function Build: IHTTPRequest; overload; 40 | class function Build(AClient: TCloudApiClientBase; ARequest: IcaRequest): IHTTPRequest; overload; 41 | destructor Destroy; override; 42 | property UrlString: string read FUrlString; 43 | end; 44 | 45 | implementation 46 | 47 | uses 48 | CloudAPI.Parameter, 49 | System.NetEncoding, 50 | System.Rtti; 51 | 52 | { TRequestBuilder } 53 | 54 | function TRequestBuilder.DoBuild: IHTTPRequest; 55 | var 56 | LMethodString: string; 57 | begin 58 | LMethodString := TRttiEnumerationType.GetName(FcaRequest.Method); 59 | if FcaRequest.Resource.IsEmpty then 60 | FUrl := BuildUrlSegments(FClient.BaseUrl, FcaRequest) 61 | else if FClient.BaseUrl.IsEmpty then 62 | FUrl := BuildUrlSegments(FcaRequest.Resource, FcaRequest) 63 | else 64 | FUrl := BuildUrlSegments(FClient.BaseUrl + '/' + FcaRequest.Resource, FcaRequest); 65 | 66 | BuildGetOrPosts; 67 | BuildQueryParameters; 68 | FRequest := FClient.HttpClient.GetRequest(LMethodString, FUrl); 69 | BuildFiles; 70 | 71 | BuildCookies; 72 | if FcaRequest.IsMultipartFormData then 73 | BuildFormData 74 | else 75 | BuildRequestBody; 76 | BuildHttpHeaders; 77 | FUrlString := FUrl.ToString; 78 | Result := FRequest; 79 | end; 80 | 81 | class function TRequestBuilder.Build(AClient: TCloudApiClientBase; ARequest: IcaRequest): IHTTPRequest; 82 | var 83 | MyClass: TRequestBuilder; 84 | begin 85 | MyClass := TRequestBuilder.Create(AClient, ARequest); 86 | try 87 | Result := MyClass.DoBuild; 88 | finally 89 | MyClass.Free; 90 | end; 91 | end; 92 | 93 | procedure TRequestBuilder.BuildCookies; 94 | var 95 | LParam: TcaParameter; 96 | LCookie: TCookie; 97 | begin 98 | for LParam in FcaRequest.Cookies do 99 | begin 100 | { TODO -oMaxim Sysoev -cGeneral : Протестировать куки } 101 | LCookie.Name := LParam.Name; 102 | LCookie.Value := LParam.ValueAsString; 103 | FClient.HttpClient.CookieManager.AddServerCookie(LCookie, FRequest.URL); 104 | end; 105 | end; 106 | 107 | procedure TRequestBuilder.BuildFiles; 108 | var 109 | LFile: TcaFileToSend; 110 | begin 111 | for LFile in FcaRequest.Files do 112 | case LFile.&Type of 113 | TcaFileToSendType.File: 114 | FFormData.AddFile(LFile.Name, LFile.FilePath); 115 | TcaFileToSendType.Stream: 116 | FFormData.AddStream(LFile.Name, LFile.Content, LFile.FilePath); 117 | end; 118 | end; 119 | 120 | procedure TRequestBuilder.BuildFormData; 121 | begin 122 | FFormData.Stream.Position := 0; 123 | FRequest.SourceStream := FFormData.Stream; 124 | FRequest.AddHeader('Content-Type', FFormData.MimeTypeHeader); 125 | end; 126 | 127 | procedure TRequestBuilder.BuildGetOrPosts; 128 | var 129 | LParam: TcaParameter; 130 | begin 131 | for LParam in FcaRequest.GetOrPosts do 132 | begin 133 | if FcaRequest.Method = TcaMethod.POST then 134 | begin 135 | if FcaRequest.IsMultipartFormData then 136 | begin 137 | FFormData.AddField(LParam.Name, LParam.ValueAsString); 138 | end 139 | else 140 | begin 141 | FRequestBody.Add(LParam.Name + '=' + LParam.ValueAsString) 142 | end; 143 | end 144 | else 145 | begin 146 | FUrl.AddParameter(LParam.Name, LParam.ValueAsString); 147 | end; 148 | end; 149 | end; 150 | 151 | procedure TRequestBuilder.BuildHttpHeaders; 152 | var 153 | LParam: TcaParameter; 154 | begin 155 | for LParam in FcaRequest.HttpHeaders do 156 | begin 157 | FRequest.HeaderValue[LParam.Name] := LParam.ValueAsString; 158 | end; 159 | end; 160 | 161 | procedure TRequestBuilder.BuildQueryParameters; 162 | var 163 | LParam: TcaParameter; 164 | begin 165 | for LParam in FcaRequest.QueryParameters do 166 | begin 167 | FUrl.AddParameter(LParam.Name, LParam.ValueAsString); 168 | end; 169 | end; 170 | 171 | procedure TRequestBuilder.BuildRequestBody; 172 | var 173 | LSourceHeaders: TNetHeaders; 174 | LSourceStream: TStream; 175 | I: Integer; 176 | begin 177 | LSourceHeaders := []; 178 | CreateFormFromStrings(FRequestBody, TEncoding.UTF8, FRequest.Headers, LSourceStream, LSourceHeaders); 179 | for I := Low(LSourceHeaders) to High(LSourceHeaders) do 180 | FcaRequest.HttpHeaders.Add(TcaParameter.Create(LSourceHeaders[I].Name, LSourceHeaders[I].Value, '', 181 | TcaParameterType.HttpHeader, False)); 182 | FRequest.SourceStream := LSourceStream; 183 | end; 184 | 185 | class function TRequestBuilder.BuildUrlSegments(const AUrl: string; ARequest: IcaRequest): TURI; 186 | var 187 | LFullUrl: string; 188 | LParam: TcaParameter; 189 | begin 190 | LFullUrl := AUrl; 191 | for LParam in ARequest.UrlSegments do 192 | LFullUrl := LFullUrl.Replace('{' + LParam.Name + '}', LParam.ValueAsString); 193 | Result := TURI.Create(LFullUrl); 194 | end; 195 | 196 | constructor TRequestBuilder.Create(AClient: TCloudApiClientBase; ARequest: IcaRequest); 197 | begin 198 | FClient := AClient; 199 | FcaRequest := ARequest; 200 | if FcaRequest.IsMultipartFormData then 201 | FFormData := TMultipartFormData.Create 202 | else 203 | begin 204 | FRequestBody := TStringList.Create; 205 | FRequestBody.LineBreak := '&'; 206 | end; 207 | end; 208 | 209 | class procedure TRequestBuilder.CreateFormFromStrings(const ASource: TStrings; const AEncoding: TEncoding; 210 | const AHeaders: TNetHeaders; var ASourceStream: TStream; var ASourceHeaders: TNetHeaders); 211 | var 212 | lHttp: THTTPClient; 213 | begin 214 | lHttp := THTTPClient.Create; 215 | try 216 | lHttp.CreateFormFromStrings(ASource, AEncoding, AHeaders, ASourceStream, ASourceHeaders); 217 | finally 218 | lHttp.Free; 219 | end; 220 | end; 221 | 222 | destructor TRequestBuilder.Destroy; 223 | begin 224 | FRequestBody.Free; 225 | inherited Destroy; 226 | end; 227 | 228 | function TRequestBuilder.Build: IHTTPRequest; 229 | begin 230 | Result := DoBuild; 231 | end; 232 | 233 | end. 234 | -------------------------------------------------------------------------------- /CloudAPI.Exceptions.pas: -------------------------------------------------------------------------------- 1 | unit CloudAPI.Exceptions; 2 | 3 | interface 4 | 5 | uses 6 | CloudAPI.Parameter, 7 | System.SysUtils; 8 | 9 | type 10 | ECloudApiException = class(Exception) 11 | private 12 | FCodeInt: Integer; 13 | FCodeStr: string; 14 | FText: string; 15 | FRaisedAt: TDateTime; 16 | protected 17 | procedure BuildMsg; virtual; 18 | public 19 | constructor Create(const ACode, AText: string); overload; 20 | constructor Create(const ACode: Integer; const AText: string); overload; 21 | public 22 | property CodeInt: Integer read FCodeInt write FCodeInt; 23 | property CodeStr: string read FCodeStr write FCodeStr; 24 | property Text: string read FText write FText; 25 | property RaisedAt: TDateTime read FRaisedAt write FRaisedAt; 26 | end; 27 | 28 | ECloudApiRequairedParameterException = class(ECloudApiException) 29 | private 30 | FParameter: TcaParameter; 31 | FMethod: string; 32 | protected 33 | procedure BuildMsg; override; 34 | public 35 | constructor Create(const AMethod: string; AParameter: TcaParameter); 36 | end; 37 | 38 | TcaExceptionManager = class 39 | private 40 | class var FCurrent: TcaExceptionManager; 41 | private 42 | FOnAlert: TProc; 43 | FAlertEvent: Boolean; 44 | FAlertException: Boolean; 45 | protected 46 | procedure DoAlertEvent(AException: ECloudApiException); 47 | procedure DoAlertException(AException: ECloudApiException); 48 | public 49 | constructor Create; 50 | destructor Destroy; override; 51 | procedure Alert(AException: ECloudApiException); overload; 52 | procedure Alert(const ACode, AText: string); overload; 53 | procedure Alert(const ACode: Integer; const AText: string); overload; 54 | property AlertEvent: Boolean read FAlertEvent write FAlertEvent default True; 55 | property AlertException: Boolean read FAlertException write FAlertException default False; 56 | property OnAlert: TProc read FOnAlert write FOnAlert; 57 | public 58 | class constructor Create; 59 | class destructor Destroy; 60 | class function Current: TcaExceptionManager; 61 | end; 62 | 63 | implementation 64 | 65 | uses 66 | CloudAPI.Core.Constants; 67 | { ECloudApiRequairedParameterException } 68 | 69 | procedure ECloudApiRequairedParameterException.BuildMsg; 70 | begin 71 | inherited BuildMsg; 72 | Message := Message // 73 | .Replace('{Parameter.Name}', FParameter.Name) // 74 | .Replace('{Parameter.Value}', FParameter.ValueAsString) // 75 | .Replace('{Method}', FMethod) // 76 | ; 77 | end; 78 | 79 | constructor ECloudApiRequairedParameterException.Create(const AMethod: string; AParameter: TcaParameter); 80 | begin 81 | FParameter := AParameter; 82 | FMethod := AMethod; 83 | inherited Create('CloudAPI', TcaConstException.PARAMETER_REQIRED); 84 | end; 85 | 86 | { ECloudApiException } 87 | 88 | constructor ECloudApiException.Create(const ACode, AText: string); 89 | begin 90 | FCodeStr := ACode; 91 | TryStrToInt(ACode, FCodeInt); 92 | FText := AText; 93 | FRaisedAt := Now; 94 | inherited Create(Message); 95 | BuildMsg; 96 | end; 97 | 98 | procedure ECloudApiException.BuildMsg; 99 | var 100 | LRaisedAtStr: string; 101 | begin 102 | LRaisedAtStr := FormatDateTime(TcaConstException.RAISED_AT_FORMAT, FRaisedAt, TFormatSettings.Invariant); 103 | Message := TcaConstException.EXCEPTION_MSG_FORMAT // 104 | .Replace('{Code}', CodeStr) // 105 | .Replace('{RaisedAt}', LRaisedAtStr) // 106 | .Replace('{Message}', Text) // 107 | end; 108 | 109 | constructor ECloudApiException.Create(const ACode: Integer; const AText: string); 110 | begin 111 | self.Create(ACode.ToString, AText); 112 | end; 113 | 114 | { TcaExceptionManager } 115 | 116 | procedure TcaExceptionManager.Alert(AException: ECloudApiException); 117 | begin 118 | if AlertEvent then 119 | DoAlertEvent(AException); 120 | if AlertException then 121 | DoAlertException(AException); 122 | end; 123 | 124 | procedure TcaExceptionManager.Alert(const ACode: Integer; const AText: string); 125 | begin 126 | Alert(ECloudApiException.Create(ACode, AText)); 127 | end; 128 | 129 | procedure TcaExceptionManager.Alert(const ACode, AText: string); 130 | begin 131 | Alert(ECloudApiException.Create(ACode, AText)); 132 | end; 133 | 134 | class constructor TcaExceptionManager.Create; 135 | begin 136 | FCurrent := TcaExceptionManager.Create; 137 | end; 138 | 139 | constructor TcaExceptionManager.Create; 140 | begin 141 | FAlertEvent := True; 142 | FAlertException := False; 143 | end; 144 | 145 | class function TcaExceptionManager.Current: TcaExceptionManager; 146 | begin 147 | Result := FCurrent; 148 | end; 149 | 150 | destructor TcaExceptionManager.Destroy; 151 | begin 152 | inherited Destroy; 153 | end; 154 | 155 | class destructor TcaExceptionManager.Destroy; 156 | begin 157 | FreeAndNil(FCurrent); 158 | end; 159 | 160 | procedure TcaExceptionManager.DoAlertEvent(AException: ECloudApiException); 161 | begin 162 | if Assigned(OnAlert) then 163 | OnAlert(AException); 164 | end; 165 | 166 | procedure TcaExceptionManager.DoAlertException(AException: ECloudApiException); 167 | begin 168 | raise AException; 169 | end; 170 | 171 | end. 172 | -------------------------------------------------------------------------------- /CloudAPI.Ext.MethodLimits.pas: -------------------------------------------------------------------------------- 1 | unit CloudAPI.Ext.MethodLimits; 2 | 3 | interface 4 | 5 | uses 6 | CloudAPI.Types, 7 | System.Generics.Collections, 8 | System.SysUtils; 9 | 10 | type 11 | 12 | TcaRequestLimitList = class(TList); 13 | 14 | TcaRequestLimitManager = class 15 | private 16 | FGlobal: TcaRequestLimitList; 17 | FLocal: TcaRequestLimitList; 18 | FOnLimit: TProc; 19 | protected 20 | function CalculateWait(AList: TcaRequestLimitList; const AName: string = ''): Int64; 21 | public 22 | constructor Create; 23 | procedure Add(const ALimit: Int64; const AName: string; const AIsGlobal: Boolean); 24 | function GetGlobalLimits: TArray; 25 | function GetLocalLimits(const AName: string): TArray; 26 | function GetLimits(const AName: string): TArray; 27 | function GlobalWait: Int64; 28 | function LocalWait(const AName: string): Int64; 29 | destructor Destroy; override; 30 | property OnLimit: TProc read FOnLimit write FOnLimit; 31 | end; 32 | 33 | implementation 34 | 35 | { TcaRequestLimitManager } 36 | 37 | procedure TcaRequestLimitManager.Add(const ALimit: Int64; const AName: string; const AIsGlobal: Boolean); 38 | var 39 | LLimit: TcaRequestLimit; 40 | begin 41 | LLimit := TcaRequestLimit.Create(ALimit, AName, AIsGlobal); 42 | if AIsGlobal then 43 | FGlobal.Add(LLimit) 44 | else 45 | FLocal.Add(LLimit); 46 | end; 47 | 48 | function TcaRequestLimitManager.CalculateWait(AList: TcaRequestLimitList; const AName: string = ''): Int64; 49 | var 50 | I: Integer; 51 | begin 52 | Result := 0; 53 | for I := AList.Count - 1 downto 0 do 54 | begin 55 | if AList.Count = 0 then 56 | break; 57 | if AList[I].IsExpired then 58 | AList.Delete(I) 59 | else if AList[I].Name.Contains(AName) then 60 | Inc(Result, AList[I].ActualLimit); 61 | end; 62 | end; 63 | 64 | constructor TcaRequestLimitManager.Create; 65 | begin 66 | inherited Create; 67 | FGlobal := TcaRequestLimitList.Create; 68 | FLocal := TcaRequestLimitList.Create; 69 | end; 70 | 71 | destructor TcaRequestLimitManager.Destroy; 72 | begin 73 | FGlobal.Free; 74 | FLocal.Free; 75 | inherited Destroy; 76 | end; 77 | 78 | function TcaRequestLimitManager.GetGlobalLimits: TArray; 79 | begin 80 | CalculateWait(FGlobal, ''); 81 | Result := FGlobal.ToArray; 82 | end; 83 | 84 | function TcaRequestLimitManager.GetLimits(const AName: string): TArray; 85 | begin 86 | CalculateWait(FGlobal, ''); 87 | CalculateWait(FLocal, ''); 88 | Result := FLocal.ToArray; 89 | end; 90 | 91 | function TcaRequestLimitManager.GetLocalLimits(const AName: string): TArray; 92 | begin 93 | CalculateWait(FLocal, AName); 94 | Result := FLocal.ToArray; 95 | end; 96 | 97 | function TcaRequestLimitManager.GlobalWait: Int64; 98 | begin 99 | Result := CalculateWait(FGlobal); 100 | end; 101 | 102 | function TcaRequestLimitManager.LocalWait(const AName: string): Int64; 103 | begin 104 | Result := GlobalWait + CalculateWait(FLocal, AName); 105 | end; 106 | 107 | end. 108 | -------------------------------------------------------------------------------- /CloudAPI.IAuthenticator.pas: -------------------------------------------------------------------------------- 1 | unit CloudAPI.IAuthenticator; 2 | 3 | interface 4 | 5 | uses 6 | CloudAPI.Request; 7 | 8 | type 9 | IAuthenticator = interface 10 | ['{6B4BE99E-20F9-4BF1-8911-634F55ED8062}'] 11 | procedure Authenticate(ARequest: IcaRequest); 12 | end; 13 | 14 | implementation 15 | 16 | end. 17 | -------------------------------------------------------------------------------- /CloudAPI.Json.Converters.pas: -------------------------------------------------------------------------------- 1 | unit CloudAPI.Json.Converters; 2 | 3 | interface 4 | 5 | uses 6 | System.Json.Readers, 7 | System.Json.Serializers, 8 | System.Json.Writers, 9 | System.Rtti, 10 | System.TypInfo; 11 | 12 | type 13 | // --------------------------------------------------------------------- // 14 | // Converter for UnixTime 15 | // --------------------------------------------------------------------- // 16 | TJsonUnixTimeConverter = class(TJsonConverter) 17 | public 18 | procedure WriteJson(const AWriter: TJsonWriter; const AValue: TValue; const ASerializer: TJsonSerializer); override; 19 | function ReadJson(const AReader: TJsonReader; ATypeInf: PTypeInfo; const AExistingValue: TValue; 20 | const ASerializer: TJsonSerializer): TValue; override; 21 | function CanConvert(ATypeInf: PTypeInfo): Boolean; override; 22 | end; 23 | 24 | implementation 25 | 26 | uses 27 | System.DateUtils; 28 | { TJsonUnixTimeConverter } 29 | 30 | function TJsonUnixTimeConverter.CanConvert(ATypeInf: PTypeInfo): Boolean; 31 | begin 32 | Result := ATypeInf^.Kind = tkInteger; 33 | end; 34 | 35 | function TJsonUnixTimeConverter.ReadJson(const AReader: TJsonReader; ATypeInf: PTypeInfo; const AExistingValue: TValue; 36 | const ASerializer: TJsonSerializer): TValue; 37 | var 38 | LEnumValue: TDateTime; 39 | begin 40 | LEnumValue := UnixToDateTime(AReader.Value.AsInteger()); 41 | TValue.Make(@LEnumValue, ATypeInf, Result); 42 | end; 43 | 44 | procedure TJsonUnixTimeConverter.WriteJson(const AWriter: TJsonWriter; const AValue: TValue; 45 | const ASerializer: TJsonSerializer); 46 | begin 47 | AWriter.WriteValue(DateTimeToUnix(AValue.AsType(), True)); 48 | end; 49 | 50 | end. 51 | -------------------------------------------------------------------------------- /CloudAPI.LongPolling.pas: -------------------------------------------------------------------------------- 1 | unit CloudAPI.LongPolling; 2 | 3 | interface 4 | 5 | uses 6 | System.Classes; 7 | 8 | type 9 | TcaLongPolling = class(TObject) 10 | private 11 | FPollingInterval: Integer; 12 | FIsActive: Boolean; 13 | FThread: TThread; 14 | protected 15 | procedure SetIsActive(const Value: Boolean); 16 | procedure Execute; virtual; abstract; 17 | public 18 | constructor Create; virtual; 19 | procedure Start; 20 | procedure Stop; 21 | public 22 | property IsActive: Boolean read FIsActive write SetIsActive; 23 | property PollingInterval: Integer read FPollingInterval write FPollingInterval default 1000; 24 | end; 25 | 26 | implementation 27 | 28 | uses 29 | System.SysUtils; 30 | 31 | { TcaLongPolling } 32 | 33 | constructor TcaLongPolling.Create; 34 | begin 35 | inherited Create; 36 | FPollingInterval := 1000; 37 | end; 38 | 39 | procedure TcaLongPolling.SetIsActive(const Value: Boolean); 40 | begin 41 | if FIsActive = Value then 42 | Exit; 43 | FIsActive := Value; 44 | if FIsActive then 45 | begin 46 | FThread := TThread.CreateAnonymousThread(Execute); 47 | FThread.FreeOnTerminate := False; 48 | FThread.Start; 49 | end 50 | else 51 | begin 52 | FIsActive := False; 53 | FreeAndNil(FThread); 54 | end; 55 | end; 56 | 57 | procedure TcaLongPolling.Start; 58 | begin 59 | IsActive := True; 60 | end; 61 | 62 | procedure TcaLongPolling.Stop; 63 | begin 64 | IsActive := False; 65 | end; 66 | 67 | end. 68 | -------------------------------------------------------------------------------- /CloudAPI.MethodLimits.pas: -------------------------------------------------------------------------------- 1 | unit CloudAPI.MethodLimits; 2 | 3 | interface 4 | 5 | type 6 | 7 | TcaMethodLimit = class 8 | private 9 | FTimeLimit: Integer; 10 | FIsGlobalLimit: Boolean; 11 | FMethodName: string; 12 | published 13 | property TimeLimit: Integer read FTimeLimit write FTimeLimit; 14 | property IsGlobalLimit: Boolean read FIsGlobalLimit write FIsGlobalLimit; 15 | property MethodName: string read FMethodName write FMethodName; 16 | end; 17 | 18 | TcaMethodLimitManager = class 19 | 20 | end; 21 | 22 | implementation 23 | 24 | end. 25 | -------------------------------------------------------------------------------- /CloudAPI.Parameter.pas: -------------------------------------------------------------------------------- 1 | unit CloudAPI.Parameter; 2 | 3 | interface 4 | 5 | uses 6 | CloudAPI.Types, 7 | System.Rtti; 8 | 9 | type 10 | TcaParameter = record 11 | private 12 | FName: string; 13 | FValue: TValue; 14 | FParameterType: TcaParameterType; 15 | FIsRequired: Boolean; 16 | FDefaultValue: TValue; 17 | public 18 | function ValueAsString: string; 19 | function DefaultValueAsString: string; 20 | function IsDefaultParameter: Boolean; 21 | class function Create(const AName: string; const AValue, ADefaultValue: TValue; 22 | const AParameterType: TcaParameterType; AIsRequired: Boolean): TcaParameter; static; 23 | public 24 | property Name: string read FName write FName; 25 | property Value: TValue read FValue write FValue; 26 | property DefaultValue: TValue read FDefaultValue write FDefaultValue; 27 | property ParameterType: TcaParameterType read FParameterType write FParameterType; 28 | property IsRequired: Boolean read FIsRequired write FIsRequired; 29 | end; 30 | 31 | implementation 32 | 33 | uses 34 | CloudAPI.RequestArgument; 35 | 36 | { TcaParameter } 37 | 38 | class function TcaParameter.Create(const AName: string; const AValue, ADefaultValue: TValue; 39 | const AParameterType: TcaParameterType; AIsRequired: Boolean): TcaParameter; 40 | begin 41 | Result.Name := AName; 42 | Result.Value := AValue; 43 | Result.DefaultValue := ADefaultValue; 44 | Result.ParameterType := AParameterType; 45 | Result.IsRequired := AIsRequired; 46 | end; 47 | 48 | function TcaParameter.DefaultValueAsString: string; 49 | begin 50 | if not TcaRequestArgument.Current.TryConvertToString(DefaultValue, Result) then 51 | Result := ''; 52 | end; 53 | 54 | function TcaParameter.IsDefaultParameter: Boolean; 55 | var 56 | LVal, LDefVal: string; 57 | begin 58 | LVal := ValueAsString; 59 | LDefVal := DefaultValueAsString; 60 | Result := LVal = LDefVal; 61 | end; 62 | 63 | function TcaParameter.ValueAsString: string; 64 | begin 65 | Result := TcaRequestArgument.Current.ConvertToString(Value); 66 | end; 67 | 68 | end. 69 | -------------------------------------------------------------------------------- /CloudAPI.Request.Body.pas: -------------------------------------------------------------------------------- 1 | unit CloudAPI.Request.Body; 2 | 3 | interface 4 | 5 | uses 6 | System.Classes, 7 | System.Net.Mime; 8 | 9 | type 10 | TcaRequestBodyType = (None, FormData, x_www_form_urlEncoded, Raw, Binary); 11 | 12 | TcaRequestBody = class 13 | private 14 | FType: TcaRequestBodyType; 15 | FRaw: TStringList; 16 | FFormData: TMultipartFormData; 17 | Fx_www_form_urlEncoded: TStringList; 18 | public 19 | constructor Create; 20 | destructor Destroy; override; 21 | property &Type: TcaRequestBodyType read FType write FType default TcaRequestBodyType.None; 22 | property Raw: TStringList read FRaw write FRaw; 23 | property FormData: TMultipartFormData read FFormData write FFormData; 24 | end; 25 | 26 | implementation 27 | 28 | { TcaRequestBody } 29 | 30 | constructor TcaRequestBody.Create; 31 | begin 32 | FType := TcaRequestBodyType.None; 33 | FRaw := TStringList.Create; 34 | FFormData := TMultipartFormData.Create(); 35 | end; 36 | 37 | destructor TcaRequestBody.Destroy; 38 | begin 39 | FRaw.Free; 40 | FFormData.Free; 41 | inherited; 42 | end; 43 | 44 | end. 45 | -------------------------------------------------------------------------------- /CloudAPI.Request.New.pas: -------------------------------------------------------------------------------- 1 | unit CloudAPI.Request.New; 2 | 3 | interface 4 | 5 | uses 6 | CloudAPI.Parameter, 7 | CloudAPI.Request.Body, 8 | System.Generics.Collections, 9 | System.Classes; 10 | 11 | type 12 | 13 | TcaRequest = class 14 | private 15 | FQueryParams: TList; 16 | FBody: TcaRequestBody; 17 | FHttpMethod: string; 18 | public 19 | constructor Create; 20 | destructor Destroy; override; 21 | property HttpMethod: string read FHttpMethod write FHttpMethod; 22 | end; 23 | 24 | implementation 25 | 26 | { TcaRequest } 27 | 28 | constructor TcaRequest.Create; 29 | begin 30 | FQueryParams := TList.Create; 31 | FBody := TcaRequestBody.Create; 32 | end; 33 | 34 | destructor TcaRequest.Destroy; 35 | begin 36 | FBody.Free; 37 | FQueryParams.Free; 38 | inherited; 39 | end; 40 | 41 | end. 42 | -------------------------------------------------------------------------------- /CloudAPI.Request.pas: -------------------------------------------------------------------------------- 1 | unit CloudAPI.Request; 2 | 3 | interface 4 | 5 | uses 6 | CloudAPI.Parameter, 7 | CloudAPI.Types, 8 | System.Generics.Collections, 9 | System.Net.UrlClient, 10 | System.Rtti, System.Classes; 11 | 12 | type 13 | 14 | TcaParameterList = TList; 15 | TcaFileList = TList; 16 | 17 | IcaRequest = interface 18 | ['{13E72C25-63BE-4F99-8957-7DDA6810C28C}'] 19 | // private 20 | function GetAlwaysMultipartFormData: Boolean; 21 | function GetDefaultParameterType: TcaParameterType; 22 | function GetFiles: TcaFileList; 23 | function GetMethod: TcaMethod; 24 | function GetCookies: TcaParameterList; 25 | function GetGetOrPosts: TcaParameterList; 26 | function GetHttpHeaders: TcaParameterList; 27 | function GetUrlSegments: TcaParameterList; 28 | function GetQueryString: TcaParameterList; 29 | function GetResource: string; 30 | procedure SetAlwaysMultipartFormData(const Value: Boolean); 31 | procedure SetDefaultParameterType(const Value: TcaParameterType); 32 | procedure SetMethod(const Value: TcaMethod); 33 | procedure SetResource(const Value: string); 34 | function GetRequestBody: TStringList; 35 | function GetStartAt: TDateTime; 36 | procedure SetStartAt(const Value: TDateTime); 37 | // public 38 | function AddParam(AParam: TcaParameter): IcaRequest; overload; 39 | function AddParam(const AName: string; AValue: TValue): IcaRequest; overload; 40 | function AddParam(const AName: string; AValue: TValue; AType: TcaParameterType): IcaRequest; overload; 41 | function AddHeader(const AName, AValue: string): IcaRequest; 42 | function AddHeaders(AHeaders: TArray < TPair < string, string >> ): IcaRequest; 43 | function AddCookie(const AName, AValue: string): IcaRequest; 44 | function AddUrlSegment(const AName, AValue: string): IcaRequest; 45 | function AddQueryParameter(const AName, AValue: string): IcaRequest; overload; 46 | function AddQueryParameterJoined(const ANameValue: string; ADelimeter: Char = '='): IcaRequest; overload; 47 | function AddQueryParameter(const AName, AValue: string; const AEncode: Boolean): IcaRequest; overload; 48 | function AddQueryParametersJoined(const ANameValues: string; ALineDelimeter: Char = '&'; ADelimeter: Char = '=') 49 | : IcaRequest; overload; 50 | procedure AddFile(const AFile: TcaFileToSend); 51 | function GetLimitInfo: TcaRequestLimit; 52 | procedure SetLimitInfo(const Value: TcaRequestLimit); 53 | // public 54 | function IsMultipartFormData: Boolean; 55 | function IsRequestBody: Boolean; 56 | property DefaultParameterType: TcaParameterType read GetDefaultParameterType write SetDefaultParameterType; 57 | property Files: TcaFileList read GetFiles; 58 | property AlwaysMultipartFormData: Boolean read GetAlwaysMultipartFormData write SetAlwaysMultipartFormData; 59 | property Resource: string read GetResource write SetResource; 60 | property Method: TcaMethod read GetMethod write SetMethod; 61 | property Cookies: TcaParameterList read GetCookies; 62 | property GetOrPosts: TcaParameterList read GetGetOrPosts; 63 | property HttpHeaders: TcaParameterList read GetHttpHeaders; 64 | property UrlSegments: TcaParameterList read GetUrlSegments; 65 | property QueryParameters: TcaParameterList read GetQueryString; 66 | property LimitInfo: TcaRequestLimit read GetLimitInfo write SetLimitInfo; 67 | property RequestBody: TStringList read GetRequestBody; 68 | property StartAt: TDateTime read GetStartAt write SetStartAt; 69 | end; 70 | 71 | TcaRequest = class(TInterfacedObject, IcaRequest) 72 | private 73 | FAlwaysMultipartFormData: Boolean; 74 | FDefaultParameterType: TcaParameterType; 75 | FMethod: TcaMethod; 76 | FResource: string; 77 | FHttpHeaders: TcaParameterList; 78 | FCookies: TcaParameterList; 79 | FGetOrPosts: TcaParameterList; 80 | FUrlSegments: TcaParameterList; 81 | FQueryStrings: TcaParameterList; 82 | FFiles: TcaFileList; 83 | FLimitInfo: TcaRequestLimit; 84 | FRequestBody: TStringList; 85 | FStartAt: TDateTime; 86 | function GetAlwaysMultipartFormData: Boolean; 87 | function GetDefaultParameterType: TcaParameterType; 88 | function GetFiles: TcaFileList; 89 | function GetMethod: TcaMethod; 90 | function GetResource: string; 91 | procedure SetAlwaysMultipartFormData(const Value: Boolean); 92 | procedure SetDefaultParameterType(const Value: TcaParameterType); 93 | procedure SetMethod(const Value: TcaMethod); 94 | procedure SetResource(const Value: string); 95 | function GetCookies: TcaParameterList; 96 | function GetGetOrPosts: TcaParameterList; 97 | function GetHttpHeaders: TcaParameterList; 98 | function GetLimitInfo: TcaRequestLimit; 99 | function GetUrlSegments: TcaParameterList; 100 | function GetQueryString: TcaParameterList; 101 | function GetRequestBody: TStringList; 102 | procedure SetLimitInfo(const Value: TcaRequestLimit); 103 | function GetStartAt: TDateTime; 104 | procedure SetStartAt(const Value: TDateTime); 105 | public 106 | constructor Create; overload; 107 | constructor Create(const AMethod: TcaMethod); overload; 108 | constructor Create(const AResource: string); overload; 109 | constructor Create(const AResource: string; const AMethod: TcaMethod); overload; 110 | constructor Create(const AResource: TUri; const AMethod: TcaMethod); overload; 111 | constructor Create(const AResource: TUri); overload; 112 | destructor Destroy; override; 113 | function AddParam(AParam: TcaParameter): IcaRequest; overload; 114 | function AddParam(const AName: string; AValue: TValue): IcaRequest; overload; 115 | function AddParam(const AName: string; AValue: TValue; AType: TcaParameterType): IcaRequest; overload; 116 | function AddHeader(const AName, AValue: string): IcaRequest; 117 | function AddHeaders(AHeaders: TArray < TPair < string, string >> ): IcaRequest; 118 | function AddCookie(const AName, AValue: string): IcaRequest; 119 | function AddUrlSegment(const AName, AValue: string): IcaRequest; 120 | function AddQueryParameter(const AName, AValue: string): IcaRequest; overload; 121 | function AddQueryParameterJoined(const ANameValue: string; ADelimeter: Char = '='): IcaRequest; overload; 122 | function AddQueryParameter(const AName, AValue: string; const AEncode: Boolean): IcaRequest; overload; 123 | function AddQueryParametersJoined(const ANameValues: string; ALineDelimeter: Char = '&'; ADelimeter: Char = '=') 124 | : IcaRequest; overload; 125 | procedure AddFile(const AFile: TcaFileToSend); overload; 126 | procedure AddFile(const AFile: TcaFileToSend; AParameterType: TcaParameterType); overload; 127 | function IsMultipartFormData: Boolean; 128 | function IsRequestBody: Boolean; 129 | public 130 | property DefaultParameterType: TcaParameterType read GetDefaultParameterType write SetDefaultParameterType; 131 | property Files: TcaFileList read GetFiles; 132 | property AlwaysMultipartFormData: Boolean read GetAlwaysMultipartFormData write SetAlwaysMultipartFormData; 133 | property Resource: string read GetResource write SetResource; 134 | property Method: TcaMethod read GetMethod write SetMethod; 135 | property Cookies: TcaParameterList read GetCookies; 136 | property GetOrPosts: TcaParameterList read GetGetOrPosts; 137 | property HttpHeaders: TcaParameterList read GetHttpHeaders; 138 | property UrlSegments: TcaParameterList read GetUrlSegments; 139 | property QueryParameters: TcaParameterList read GetQueryString; 140 | property LimitInfo: TcaRequestLimit read GetLimitInfo write SetLimitInfo; 141 | property RequestBody: TStringList read GetRequestBody; 142 | property StartAt: TDateTime read GetStartAt write SetStartAt; 143 | end; 144 | 145 | implementation 146 | 147 | uses 148 | CloudAPI.Exceptions, 149 | System.SysUtils; 150 | 151 | { TcaRequest } 152 | 153 | constructor TcaRequest.Create; 154 | begin 155 | inherited Create; 156 | FFiles := TcaFileList.Create; 157 | FHttpHeaders := TcaParameterList.Create; 158 | FCookies := TcaParameterList.Create; 159 | FGetOrPosts := TcaParameterList.Create; 160 | FUrlSegments := TcaParameterList.Create; 161 | FQueryStrings := TcaParameterList.Create; 162 | FRequestBody := TStringList.Create; 163 | FMethod := TcaMethod.GET; 164 | end; 165 | 166 | constructor TcaRequest.Create(const AMethod: TcaMethod); 167 | begin 168 | Self.Create('', AMethod); 169 | end; 170 | 171 | destructor TcaRequest.Destroy; 172 | begin 173 | FHttpHeaders.Free; 174 | FCookies.Free; 175 | FGetOrPosts.Free; 176 | FUrlSegments.Free; 177 | FQueryStrings.Free; 178 | FFiles.Free; 179 | FRequestBody.Free; 180 | inherited Destroy; 181 | end; 182 | 183 | function TcaRequest.AddCookie(const AName, AValue: string): IcaRequest; 184 | begin 185 | Result := AddParam(AName, AValue, TcaParameterType.Cookie); 186 | end; 187 | 188 | procedure TcaRequest.AddFile(const AFile: TcaFileToSend); 189 | begin 190 | AddFile(AFile, DefaultParameterType); 191 | end; 192 | 193 | function TcaRequest.AddParam(AParam: TcaParameter): IcaRequest; 194 | var 195 | LFile: TcaFileToSend; 196 | begin 197 | if AParam.Value.IsType then 198 | begin 199 | LFile := AParam.Value.AsType; 200 | if not LFile.IsEmpty then 201 | begin 202 | LFile.Name := AParam.Name; 203 | AddFile(LFile, AParam.ParameterType); 204 | end; 205 | end 206 | else if AParam.IsDefaultParameter and AParam.IsRequired then 207 | begin 208 | TcaExceptionManager.Current.Alert(ECloudApiRequairedParameterException.Create(FResource, AParam)); 209 | end 210 | else if AParam.IsDefaultParameter then 211 | begin 212 | Exit; 213 | end 214 | else 215 | case AParam.ParameterType of 216 | TcaParameterType.Cookie: 217 | FCookies.Add(AParam); 218 | TcaParameterType.HttpHeader: 219 | FHttpHeaders.Add(AParam); 220 | TcaParameterType.GetOrPost: 221 | FGetOrPosts.Add(AParam); 222 | TcaParameterType.UrlSegment: 223 | FUrlSegments.Add(AParam); 224 | TcaParameterType.RequestBody: 225 | begin 226 | if FRequestBody.Text.IsEmpty then 227 | FRequestBody.Text := AParam.ValueAsString; 228 | end; 229 | TcaParameterType.QueryString, TcaParameterType.QueryStringWithoutEncode: 230 | FQueryStrings.Add(AParam); 231 | end; 232 | Result := Self; 233 | end; 234 | 235 | function TcaRequest.AddParam(const AName: string; AValue: TValue; AType: TcaParameterType): IcaRequest; 236 | begin 237 | Result := AddParam(TcaParameter.Create(AName, AValue, TValue.Empty, AType, False)); 238 | end; 239 | 240 | function TcaRequest.AddQueryParameterJoined(const ANameValue: string; ADelimeter: Char = '='): IcaRequest; 241 | var 242 | lNameValue: TArray; 243 | begin 244 | lNameValue := ANameValue.Split([ADelimeter]); 245 | if Length(lNameValue) <> 2 then 246 | raise EArgumentException.Create('Cant split ANameValue'); 247 | Result := AddParam(lNameValue[0], lNameValue[1], TcaParameterType.QueryString); 248 | end; 249 | 250 | function TcaRequest.AddQueryParameter(const AName, AValue: string): IcaRequest; 251 | begin 252 | Result := AddParam(AName, AValue, TcaParameterType.QueryString); 253 | end; 254 | 255 | function TcaRequest.AddParam(const AName: string; AValue: TValue): IcaRequest; 256 | begin 257 | Result := AddParam(AName, AValue, TcaParameterType.GetOrPost); 258 | end; 259 | 260 | function TcaRequest.AddUrlSegment(const AName, AValue: string): IcaRequest; 261 | begin 262 | Result := AddParam(AName, AValue, TcaParameterType.UrlSegment); 263 | end; 264 | 265 | constructor TcaRequest.Create(const AResource: TUri); 266 | begin 267 | Self.Create(AResource.ToString, FMethod); 268 | end; 269 | 270 | constructor TcaRequest.Create(const AResource: TUri; const AMethod: TcaMethod); 271 | begin 272 | Self.Create(AResource.ToString, AMethod); 273 | end; 274 | 275 | constructor TcaRequest.Create(const AResource: string; const AMethod: TcaMethod); 276 | begin 277 | Self.Create; 278 | FResource := AResource; 279 | FMethod := AMethod; 280 | { TODO -oMaxim SYSOEV -cGeneral : Parsing AResource - extract queryParameters } 281 | end; 282 | 283 | constructor TcaRequest.Create(const AResource: string); 284 | begin 285 | Self.Create(AResource, FMethod); 286 | end; 287 | 288 | procedure TcaRequest.AddFile(const AFile: TcaFileToSend; AParameterType: TcaParameterType); 289 | var 290 | LParam: TcaParameter; 291 | begin 292 | case AFile.&Type of 293 | TcaFileToSendType.&File, TcaFileToSendType.Stream: 294 | begin 295 | FFiles.Add(AFile); 296 | end; 297 | TcaFileToSendType.URL: 298 | begin 299 | LParam := TcaParameter.Create(AFile.Name, AFile.URL, '', AParameterType, True); 300 | AddParam(LParam); 301 | end; 302 | TcaFileToSendType.ID: 303 | begin 304 | LParam := TcaParameter.Create(AFile.Name, AFile.ID, '', AParameterType, True); 305 | AddParam(LParam); 306 | end; 307 | else 308 | raise ENotImplemented.Create('[procedure TcaRequest.AddFile] Report me, if I rise'); 309 | end; 310 | 311 | end; 312 | 313 | function TcaRequest.AddHeader(const AName, AValue: string): IcaRequest; 314 | begin 315 | Result := AddParam(AName, AValue, TcaParameterType.HttpHeader); 316 | end; 317 | 318 | function TcaRequest.AddHeaders(AHeaders: TArray < TPair < string, string >> ): IcaRequest; 319 | var 320 | LHeader: TPair; 321 | begin 322 | for LHeader in AHeaders do 323 | begin 324 | AddHeader(LHeader.Key, LHeader.Value); 325 | end; 326 | end; 327 | 328 | function TcaRequest.AddQueryParameter(const AName, AValue: string; const AEncode: Boolean): IcaRequest; 329 | var 330 | LParameterType: TcaParameterType; 331 | begin 332 | if AEncode then 333 | LParameterType := TcaParameterType.QueryString 334 | else 335 | LParameterType := TcaParameterType.QueryStringWithoutEncode; 336 | Result := AddParam(AName, AValue, LParameterType); 337 | end; 338 | 339 | function TcaRequest.AddQueryParametersJoined(const ANameValues: string; ALineDelimeter, ADelimeter: Char): IcaRequest; 340 | var 341 | lNameValues: TArray; 342 | lNameValue: string; 343 | begin 344 | lNameValues := ANameValues.Split([ALineDelimeter]); 345 | for lNameValue in lNameValues do 346 | AddQueryParameterJoined(lNameValue, ADelimeter); 347 | end; 348 | 349 | function TcaRequest.GetAlwaysMultipartFormData: Boolean; 350 | begin 351 | Result := FAlwaysMultipartFormData; 352 | end; 353 | 354 | function TcaRequest.GetCookies: TcaParameterList; 355 | begin 356 | Result := FCookies; 357 | end; 358 | 359 | function TcaRequest.GetDefaultParameterType: TcaParameterType; 360 | begin 361 | Result := FDefaultParameterType; 362 | end; 363 | 364 | function TcaRequest.GetFiles: TcaFileList; 365 | begin 366 | Result := FFiles; 367 | end; 368 | 369 | function TcaRequest.GetGetOrPosts: TcaParameterList; 370 | begin 371 | Result := FGetOrPosts; 372 | end; 373 | 374 | function TcaRequest.GetHttpHeaders: TcaParameterList; 375 | begin 376 | Result := FHttpHeaders; 377 | end; 378 | 379 | function TcaRequest.GetLimitInfo: TcaRequestLimit; 380 | begin 381 | Result := FLimitInfo; 382 | end; 383 | 384 | function TcaRequest.GetMethod: TcaMethod; 385 | begin 386 | Result := FMethod; 387 | end; 388 | 389 | function TcaRequest.GetQueryString: TcaParameterList; 390 | begin 391 | Result := FQueryStrings; 392 | end; 393 | 394 | function TcaRequest.GetRequestBody: TStringList; 395 | begin 396 | Result := FRequestBody; 397 | end; 398 | 399 | function TcaRequest.GetResource: string; 400 | begin 401 | Result := FResource; 402 | end; 403 | 404 | function TcaRequest.GetStartAt: TDateTime; 405 | begin 406 | Result := FStartAt; 407 | end; 408 | 409 | function TcaRequest.GetUrlSegments: TcaParameterList; 410 | begin 411 | Result := FUrlSegments; 412 | end; 413 | 414 | function TcaRequest.IsMultipartFormData: Boolean; 415 | begin 416 | Result := AlwaysMultipartFormData or (FFiles.Count > 0); 417 | end; 418 | 419 | function TcaRequest.IsRequestBody: Boolean; 420 | begin 421 | Result := FRequestBody.Count > 0; 422 | end; 423 | 424 | procedure TcaRequest.SetAlwaysMultipartFormData(const Value: Boolean); 425 | begin 426 | FAlwaysMultipartFormData := Value; 427 | end; 428 | 429 | procedure TcaRequest.SetDefaultParameterType(const Value: TcaParameterType); 430 | begin 431 | FDefaultParameterType := Value; 432 | end; 433 | 434 | procedure TcaRequest.SetLimitInfo(const Value: TcaRequestLimit); 435 | begin 436 | FLimitInfo := Value; 437 | end; 438 | 439 | procedure TcaRequest.SetMethod(const Value: TcaMethod); 440 | begin 441 | FMethod := Value; 442 | end; 443 | 444 | procedure TcaRequest.SetResource(const Value: string); 445 | begin 446 | FResource := Value; 447 | end; 448 | 449 | procedure TcaRequest.SetStartAt(const Value: TDateTime); 450 | begin 451 | FStartAt := Value; 452 | end; 453 | 454 | end. 455 | -------------------------------------------------------------------------------- /CloudAPI.RequestArgument.pas: -------------------------------------------------------------------------------- 1 | unit CloudAPI.RequestArgument; 2 | 3 | interface 4 | 5 | uses 6 | CloudAPI.Request, 7 | CloudAPI.Parameter, 8 | CloudAPI.Types, 9 | System.Rtti, 10 | System.SysUtils, 11 | System.TypInfo, 12 | System.Generics.Collections; 13 | 14 | type 15 | 16 | TcaTypeConverter = class(TDictionary < string, TFunc < TValue, string >> ) 17 | end; 18 | 19 | TcaRequestArgument = class 20 | private 21 | class var fCurrent: TcaRequestArgument; 22 | private 23 | fConverter: TcaTypeConverter; 24 | fRtti: TRttiContext; 25 | public 26 | constructor Create; 27 | destructor Destroy; override; 28 | procedure RegisterConverter(AConverter: TFunc); 29 | procedure RegisterToJson; 30 | function ObjToParams(AArguments: Pointer; AType: TRttiType; ADefaultParam: TcaParameter) 31 | : TArray; overload; 32 | function ObjToParams(AArguments: T): TArray; overload; 33 | function ObjToRequest(AArguments: T): IcaRequest; overload; 34 | function ConvertToString(AValue: TValue): string; 35 | function TryConvertToString(AValue: TValue; var AStringValue: string): Boolean; 36 | function TryGetConverterName(AValue: TValue; var AConverterName: string): Boolean; 37 | function ParsePrototype(AType: Pointer; var ARttiType: TRttiType; var ADefaltParam: TcaParameter; 38 | var Resourse: string; var AMethod: TcaMethod): Boolean; 39 | function ParseLimitInfo(ARttiType: TRttiType; AResourse: string; ALimitInfo: TcaRequestLimit): Boolean; 40 | 41 | class function Current: TcaRequestArgument; 42 | class constructor Create; 43 | class destructor Destroy; 44 | end; 45 | 46 | implementation 47 | 48 | uses 49 | CloudAPI.Attributes, 50 | CloudAPI.Converter.BasicTypes, CloudAPI.Client.Base; 51 | 52 | function GetShortStringString(const ShortStringPointer: PByte): string; 53 | var 54 | ShortStringLength: Byte; 55 | FirstShortStringCharacter: MarshaledAString; 56 | ConvertedLength: Cardinal; 57 | UnicodeCharacters: array [Byte] of Char; 58 | // cannot be more than 255 characters, reserve 1 character for terminating null 59 | begin 60 | if not Assigned(ShortStringPointer) then 61 | Result := '' 62 | else 63 | begin 64 | ShortStringLength := ShortStringPointer^; 65 | if ShortStringLength = 0 then 66 | Result := '' 67 | else 68 | begin 69 | FirstShortStringCharacter := MarshaledAString(ShortStringPointer + 1); 70 | ConvertedLength := UTF8ToUnicode(UnicodeCharacters, Length(UnicodeCharacters), FirstShortStringCharacter, 71 | ShortStringLength); 72 | // UTF8ToUnicode will always include the null terminator character in the Result: 73 | ConvertedLength := ConvertedLength - 1; 74 | SetString(Result, UnicodeCharacters, ConvertedLength); 75 | end; 76 | end; 77 | end; 78 | { TcaRequestArgument } 79 | 80 | function TcaRequestArgument.TryConvertToString(AValue: TValue; var AStringValue: string): Boolean; 81 | var 82 | LName: string; 83 | begin 84 | Result := TryGetConverterName(AValue, LName); 85 | if Result then 86 | AStringValue := fConverter[LName](AValue) 87 | end; 88 | 89 | function TcaRequestArgument.TryGetConverterName(AValue: TValue; var AConverterName: string): Boolean; 90 | begin 91 | if AValue.IsEmpty then 92 | begin 93 | AConverterName := 'AValue.IsEmpty'; 94 | Exit(False); 95 | end; 96 | AConverterName := GetShortStringString(@AValue.TypeInfo.Name); 97 | Result := fConverter.ContainsKey(AConverterName); 98 | end; 99 | 100 | function TcaRequestArgument.ConvertToString(AValue: TValue): string; 101 | begin 102 | if not TryConvertToString(AValue, Result) then 103 | raise ENotSupportedException.CreateFmt('Converter for "%S" not supported', [AValue.ToString]); 104 | end; 105 | 106 | class constructor TcaRequestArgument.Create; 107 | begin 108 | fCurrent := TcaRequestArgument.Create; 109 | end; 110 | 111 | class destructor TcaRequestArgument.Destroy; 112 | begin 113 | fCurrent.Free; 114 | end; 115 | 116 | function TcaRequestArgument.ObjToParams(AArguments: Pointer; AType: TRttiType; ADefaultParam: TcaParameter) 117 | : TArray; 118 | var 119 | LRttiField: TRttiField; 120 | LRttiAttr: TCustomAttribute; 121 | LParam: TcaParameter; 122 | lParamList: TList; 123 | LArguments: Pointer; 124 | lIsCaParameter: Boolean; 125 | begin 126 | if AType.TypeKind = TTypeKind.tkClass then // <------Viktor Akselrod 127 | LArguments := PPointer(AArguments)^ 128 | else 129 | LArguments := AArguments; 130 | if not Assigned(LArguments) then 131 | Exit; 132 | lParamList := TList.Create; 133 | try 134 | for LRttiField in AType.GetFields do 135 | begin 136 | lIsCaParameter := False; 137 | LParam := ADefaultParam; 138 | LParam.IsRequired := False; 139 | LParam.Name := LRttiField.Name; 140 | LParam.Value := LRttiField.GetValue(LArguments); 141 | for LRttiAttr in LRttiField.GetAttributes do 142 | begin 143 | if LRttiAttr is TcaCustomAttribute then 144 | lIsCaParameter := True; // Поле является параметром для CloudAPI 145 | if LRttiAttr is caIsRequairedAttribute then 146 | LParam.IsRequired := (LRttiAttr as caIsRequairedAttribute).IsRequired 147 | else if LRttiAttr is caNameAttribute then 148 | LParam.Name := (LRttiAttr as caNameAttribute).Name 149 | else if LRttiAttr is caDefaultValueAttribute then 150 | LParam.DefaultValue := (LRttiAttr as caDefaultValueAttribute).ToString 151 | else if LRttiAttr is caParameterTypeAttribute then 152 | LParam.ParameterType := (LRttiAttr as caParameterTypeAttribute).ParameterType; 153 | end; 154 | if lIsCaParameter then 155 | lParamList.Add(LParam); 156 | end; 157 | Result := lParamList.ToArray; 158 | finally 159 | lParamList.Free; 160 | end; 161 | end; 162 | 163 | function TcaRequestArgument.ObjToRequest(AArguments: T): IcaRequest; 164 | var 165 | LRttiType: TRttiType; 166 | LParam: TcaParameter; 167 | lParams: TArray; 168 | lRes: string; 169 | lMethod: TcaMethod; 170 | begin 171 | // Result := ObjToRequest(@AArguments, TypeInfo(T)); 172 | Result := TcaRequest.Create; 173 | // ParsePrototype(AType, LRttiType, LParam, lRes, lMethod); 174 | ParsePrototype(TypeInfo(T), LRttiType, LParam, lRes, lMethod); 175 | Result.Resource := lRes; 176 | Result.Method := lMethod; 177 | ParseLimitInfo(LRttiType, Result.Resource, Result.LimitInfo); 178 | // lParams := ObjToParams(AArguments, LRttiType, LParam); 179 | lParams := ObjToParams(@AArguments, LRttiType, LParam); 180 | for LParam in lParams do 181 | Result.AddParam(LParam); 182 | end; 183 | 184 | function TcaRequestArgument.ParseLimitInfo(ARttiType: TRttiType; AResourse: string; 185 | ALimitInfo: TcaRequestLimit): Boolean; 186 | var 187 | LRttiAttr: TCustomAttribute; 188 | begin 189 | Result := True; 190 | for LRttiAttr in ARttiType.GetAttributes do 191 | begin 192 | if LRttiAttr is caLimitedMethodAttribute then 193 | begin 194 | ALimitInfo := TcaRequestLimit.Create( // 195 | (LRttiAttr as caLimitedMethodAttribute).Limit, // 196 | AResourse, // 197 | (LRttiAttr as caLimitedMethodAttribute).IsGlobal) 198 | end; 199 | end; 200 | end; 201 | 202 | function TcaRequestArgument.ParsePrototype(AType: Pointer; var ARttiType: TRttiType; var ADefaltParam: TcaParameter; 203 | var Resourse: string; var AMethod: TcaMethod): Boolean; 204 | var 205 | LRttiAttr: TCustomAttribute; 206 | begin 207 | Result := True; 208 | ADefaltParam.ParameterType := TcaParameterType.QueryString; 209 | AMethod := TcaMethod.GET; 210 | ARttiType := fRtti.GetType(AType); 211 | for LRttiAttr in ARttiType.GetAttributes do 212 | begin 213 | if LRttiAttr is caNameAttribute then 214 | Resourse := (LRttiAttr as caNameAttribute).Name; 215 | if LRttiAttr is caMethodAttribute then 216 | AMethod := (LRttiAttr as caMethodAttribute).Method; 217 | if LRttiAttr is caParameterTypeAttribute then 218 | ADefaltParam.ParameterType := (LRttiAttr as caParameterTypeAttribute).ParameterType; 219 | end; 220 | end; 221 | 222 | procedure TcaRequestArgument.RegisterConverter(AConverter: TFunc); 223 | var 224 | LTypeInfo: PTypeInfo; 225 | LName: string; 226 | begin 227 | LTypeInfo := TypeInfo(T); 228 | LName := string(LTypeInfo.Name); 229 | fConverter.AddOrSetValue(LName, AConverter); 230 | end; 231 | 232 | procedure TcaRequestArgument.RegisterToJson; 233 | begin 234 | RegisterConverter( 235 | function(AValue: TValue): string 236 | var 237 | lData: T; 238 | lCA: TCloudApiClientBase; 239 | begin 240 | lData := AValue.AsType; 241 | lCA := TCloudApiClientBase.Create; 242 | try 243 | Result := lCA.Serializer.Serialize(lData); 244 | finally 245 | lCA.Free; 246 | end; 247 | end); 248 | end; 249 | 250 | constructor TcaRequestArgument.Create; 251 | begin 252 | fConverter := TcaTypeConverter.Create(); 253 | fRtti := TRttiContext.Create(); 254 | TcaBasicConverters.BasicConverter(Self); 255 | end; 256 | 257 | class function TcaRequestArgument.Current: TcaRequestArgument; 258 | begin 259 | Result := fCurrent; 260 | end; 261 | 262 | destructor TcaRequestArgument.Destroy; 263 | begin 264 | fConverter.Free; 265 | fRtti.Free; 266 | end; 267 | 268 | function TcaRequestArgument.ObjToParams(AArguments: T): TArray; 269 | var 270 | LRttiType: TRttiType; 271 | lDefaultParameter: TcaParameter; 272 | lRes: string; 273 | lMethod: TcaMethod; 274 | begin 275 | ParsePrototype(TypeInfo(T), LRttiType, lDefaultParameter, lRes, lMethod); 276 | Result := ObjToParams(@AArguments, LRttiType, lDefaultParameter); 277 | end; 278 | 279 | end. 280 | -------------------------------------------------------------------------------- /CloudAPI.Response.Printer.pas: -------------------------------------------------------------------------------- 1 | unit CloudAPI.Response.Printer; 2 | 3 | interface 4 | 5 | uses 6 | System.Json.Serializers, 7 | System.Net.HttpClient, 8 | System.Net.URLClient, 9 | CloudAPI.Response; 10 | 11 | type 12 | TrpRequest = class 13 | private 14 | [JsonName('Url')] 15 | FUrl: string; 16 | [JsonName('Method')] 17 | FMethod: string; 18 | [JsonName('Headers')] 19 | FHeaders: TArray; 20 | [JsonName('Content')] 21 | FContent: string; 22 | protected 23 | 24 | public 25 | constructor Create(AHttpRequest: IHTTPRequest); 26 | class function TNetHeadersToStrings(AHeaders: TNetHeaders): TArray; 27 | public 28 | property Url: string read FUrl; 29 | property Method: string read FMethod; 30 | property Headers: TArray read FHeaders; 31 | property Content: string read FContent; 32 | end; 33 | 34 | TrpResponse = class 35 | private 36 | [JsonName('StatusCode')] 37 | FStatusCode: Integer; 38 | [JsonName('StatusText')] 39 | FStatusText: string; 40 | [JsonName('Headers')] 41 | FHeaders: TArray; 42 | [JsonName('Content')] 43 | FContent: string; 44 | public 45 | constructor Create(AHttpResponse: IHTTPResponse); 46 | public 47 | property StatusCode: Integer read FStatusCode; 48 | property StatusText: string read FStatusText; 49 | property Content: string read FContent; 50 | end; 51 | 52 | TcaResponsePrinter = class 53 | private 54 | [JsonName('Request')] 55 | FRequest: TrpRequest; 56 | [JsonName('Response')] 57 | FResponse: TrpResponse; 58 | protected 59 | public 60 | function AsJson: string; 61 | constructor Create(); 62 | 63 | procedure ParseResponse(AResponse: TcaResponseBase); 64 | procedure FreeData; 65 | destructor Destroy; override; 66 | property Request: TrpRequest read FRequest; 67 | property Response: TrpResponse read FResponse; 68 | class procedure ToConsole(AResponse: TcaResponseBase); 69 | end; 70 | 71 | implementation 72 | 73 | uses 74 | System.Json.Types, 75 | System.SysUtils, 76 | System.Classes; 77 | 78 | function StreamToString(aStream: TStream): string; 79 | var 80 | SS: TStringStream; 81 | begin 82 | if aStream <> nil then 83 | begin 84 | SS := TStringStream.Create(''); 85 | try 86 | SS.CopyFrom(aStream, 0); // No need to position at 0 nor provide size 87 | Result := SS.DataString; 88 | finally 89 | SS.Free; 90 | end; 91 | end 92 | else 93 | begin 94 | Result := ''; 95 | end; 96 | end; 97 | { TcaPrintResponse } 98 | 99 | function TcaResponsePrinter.AsJson: string; 100 | var 101 | lSerializer: TJsonSerializer; 102 | begin 103 | lSerializer := TJsonSerializer.Create; 104 | try 105 | lSerializer.Formatting := TJsonFormatting.Indented; 106 | lSerializer.StringEscapeHandling := TJsonStringEscapeHandling.EscapeNonAscii; 107 | Result := lSerializer.Serialize(Self); 108 | finally 109 | lSerializer.Free; 110 | end; 111 | end; 112 | 113 | constructor TcaResponsePrinter.Create(); 114 | begin 115 | FRequest := nil; 116 | FResponse := nil; 117 | end; 118 | 119 | destructor TcaResponsePrinter.Destroy; 120 | begin 121 | FreeData; 122 | inherited; 123 | end; 124 | 125 | procedure TcaResponsePrinter.FreeData; 126 | begin 127 | if Assigned(FRequest) then 128 | FreeAndNil(FRequest); 129 | if Assigned(FResponse) then 130 | FreeAndNil(FResponse); 131 | end; 132 | 133 | procedure TcaResponsePrinter.ParseResponse(AResponse: TcaResponseBase); 134 | begin 135 | FreeData; 136 | if Assigned(AResponse.HttpRequest) then 137 | FRequest := TrpRequest.Create(AResponse.HttpRequest); 138 | if Assigned(AResponse.HttpResponse) then 139 | FResponse := TrpResponse.Create(AResponse.HttpResponse); 140 | end; 141 | 142 | class procedure TcaResponsePrinter.ToConsole(AResponse: TcaResponseBase); 143 | var 144 | lSelf: TcaResponsePrinter; 145 | begin 146 | lSelf := TcaResponsePrinter.Create(); 147 | try 148 | lSelf.ParseResponse(AResponse); 149 | Writeln(lSelf.AsJson); 150 | finally 151 | lSelf.Free; 152 | end; 153 | end; 154 | 155 | { TrpRequest } 156 | 157 | constructor TrpRequest.Create(AHttpRequest: IHTTPRequest); 158 | begin 159 | FUrl := AHttpRequest.Url.ToString; 160 | FMethod := AHttpRequest.MethodString; 161 | FHeaders := TNetHeadersToStrings(AHttpRequest.Headers); 162 | FContent := StreamToString(AHttpRequest.SourceStream); 163 | end; 164 | 165 | class function TrpRequest.TNetHeadersToStrings(AHeaders: TNetHeaders): TArray; 166 | var 167 | i: Integer; 168 | begin 169 | SetLength(Result, length(AHeaders)); 170 | for i := Low(AHeaders) to High(AHeaders) do 171 | Result[i] := AHeaders[i].Name + ' = ' + AHeaders[i].Value; 172 | end; 173 | 174 | { TrpResponse } 175 | 176 | constructor TrpResponse.Create(AHttpResponse: IHTTPResponse); 177 | begin 178 | FStatusCode := AHttpResponse.StatusCode; 179 | FStatusText := AHttpResponse.StatusText; 180 | FHeaders := TrpRequest.TNetHeadersToStrings(AHttpResponse.Headers); 181 | if AHttpResponse.HeaderValue['Content-Type'] = 'application/json' then 182 | FContent := AHttpResponse.ContentAsString(); 183 | end; 184 | 185 | end. 186 | -------------------------------------------------------------------------------- /CloudAPI.Response.pas: -------------------------------------------------------------------------------- 1 | unit CloudAPI.Response; 2 | 3 | interface 4 | 5 | uses 6 | CloudAPI.Exceptions, 7 | CloudAPI.Request, 8 | System.JSON, 9 | System.JSON.Serializers, 10 | System.Net.HttpClient, 11 | System.SysUtils; 12 | 13 | type 14 | TcaTiming = record 15 | private 16 | FStartTime: TDateTime; 17 | FEndTime: TDateTime; 18 | function GetDuration: Integer; 19 | public 20 | class function Create(const AStartTime, AEndTime: TDateTime): TcaTiming; static; 21 | property StartTime: TDateTime read FStartTime; 22 | property EndTime: TDateTime read FEndTime; 23 | property Duration: Integer read GetDuration; 24 | end; 25 | 26 | IcaResponseBase = interface 27 | ['{D577F707-054A-449C-BE42-015B7EF03CDC}'] 28 | // private 29 | function GetHttpRequest: IHTTPRequest; 30 | function GetHttpResponse: IHTTPResponse; 31 | procedure SetHttpRequest(const Value: IHTTPRequest); 32 | procedure SetHttpResponse(const Value: IHTTPResponse); 33 | function GetTiming: TcaTiming; 34 | function GetException: ECloudApiException; 35 | procedure SetException(const Value: ECloudApiException); 36 | // public 37 | function AsJson: TJSONValue; 38 | function RawBytes: TBytes; 39 | property HttpRequest: IHTTPRequest read GetHttpRequest write SetHttpRequest; 40 | property HttpResponse: IHTTPResponse read GetHttpResponse write SetHttpResponse; 41 | property Timing: TcaTiming read GetTiming; 42 | property Exception: ECloudApiException read GetException write SetException; 43 | end; 44 | 45 | TcaResponseBase = class(TInterfacedObject, IcaResponseBase) 46 | private 47 | FHttpRequest: IHTTPRequest; 48 | FHttpResponse: IHTTPResponse; 49 | FTiming: TcaTiming; 50 | fException: ECloudApiException; 51 | FJson: TJSONValue; 52 | function GetHttpRequest: IHTTPRequest; 53 | function GetHttpResponse: IHTTPResponse; 54 | procedure SetHttpRequest(const Value: IHTTPRequest); 55 | procedure SetHttpResponse(const Value: IHTTPResponse); 56 | function GetTiming: TcaTiming; 57 | function GetException: ECloudApiException; 58 | procedure SetException(const Value: ECloudApiException); 59 | protected 60 | procedure TryLoadJSON(AHttpResponse: IHTTPResponse); 61 | public 62 | function AsJson: TJSONValue; 63 | function RawBytes: TBytes; 64 | constructor Create(ACloudRequest: IcaRequest; AHttpRequest: IHTTPRequest; AHttpResponse: IHTTPResponse; 65 | AException: ECloudApiException); 66 | destructor Destroy; override; 67 | property HttpRequest: IHTTPRequest read GetHttpRequest write SetHttpRequest; 68 | property HttpResponse: IHTTPResponse read GetHttpResponse write SetHttpResponse; 69 | property Timing: TcaTiming read GetTiming; 70 | property Exception: ECloudApiException read GetException write SetException; 71 | end; 72 | 73 | IcaResponse = interface(IcaResponseBase) 74 | // private 75 | function GetData: T; 76 | function GetSerializer: TJsonSerializer; 77 | procedure SetData(const Value: T); 78 | procedure SetSerializer(const Value: TJsonSerializer); 79 | // public 80 | property Data: T read GetData write SetData; 81 | property Serializer: TJsonSerializer read GetSerializer write SetSerializer; 82 | end; 83 | 84 | TcaResponse = class(TcaResponseBase, IcaResponse) 85 | private 86 | FSerializer: TJsonSerializer; 87 | FData: T; 88 | function GetData: T; 89 | function GetSerializer: TJsonSerializer; 90 | procedure SetData(const Value: T); 91 | procedure SetSerializer(const Value: TJsonSerializer); 92 | protected 93 | procedure DoUpdateData(const AData: string); 94 | function TestHtml(const AData: string): Boolean; 95 | public 96 | constructor Create(ACloudRequest: IcaRequest; AHttpRequest: IHTTPRequest; AHttpResponse: IHTTPResponse; 97 | ASerializer: TJsonSerializer; AException: ECloudApiException); reintroduce; 98 | property Data: T read GetData write SetData; 99 | property Serializer: TJsonSerializer read GetSerializer write SetSerializer; 100 | end; 101 | 102 | implementation 103 | 104 | uses 105 | CloudAPI.Types; 106 | 107 | function TcaResponseBase.AsJson: TJSONValue; 108 | begin 109 | Result := FJson; 110 | end; 111 | 112 | constructor TcaResponseBase.Create(ACloudRequest: IcaRequest; AHttpRequest: IHTTPRequest; AHttpResponse: IHTTPResponse; 113 | AException: ECloudApiException); 114 | begin 115 | inherited Create(); 116 | FHttpRequest := AHttpRequest; 117 | FHttpResponse := AHttpResponse; 118 | FTiming := TcaTiming.Create(ACloudRequest.StartAt, Now); 119 | fException := AException; 120 | if Assigned(AHttpResponse) then 121 | TryLoadJSON(AHttpResponse); 122 | end; 123 | 124 | destructor TcaResponseBase.Destroy; 125 | begin 126 | if Assigned(FJson) then 127 | FreeAndNil(FJson); 128 | inherited; 129 | end; 130 | 131 | function TcaResponseBase.GetException: ECloudApiException; 132 | begin 133 | Result := fException; 134 | end; 135 | 136 | function TcaResponseBase.GetHttpRequest: IHTTPRequest; 137 | begin 138 | Result := FHttpRequest; 139 | end; 140 | 141 | function TcaResponseBase.GetHttpResponse: IHTTPResponse; 142 | begin 143 | Result := FHttpResponse; 144 | end; 145 | 146 | function TcaResponseBase.GetTiming: TcaTiming; 147 | begin 148 | Result := FTiming; 149 | end; 150 | 151 | function TcaResponseBase.RawBytes: TBytes; 152 | begin 153 | FHttpResponse.ContentStream.Position := 0; 154 | SetLength(Result, FHttpResponse.ContentStream.Size); 155 | FHttpResponse.ContentStream.Read(Result[0], FHttpResponse.ContentStream.Size); 156 | end; 157 | 158 | procedure TcaResponseBase.SetException(const Value: ECloudApiException); 159 | begin 160 | fException := Value; 161 | end; 162 | 163 | procedure TcaResponseBase.SetHttpRequest(const Value: IHTTPRequest); 164 | begin 165 | FHttpRequest := Value; 166 | end; 167 | 168 | procedure TcaResponseBase.SetHttpResponse(const Value: IHTTPResponse); 169 | begin 170 | FHttpResponse := Value; 171 | end; 172 | 173 | procedure TcaResponseBase.TryLoadJSON(AHttpResponse: IHTTPResponse); 174 | var 175 | lJsonStr: string; 176 | begin 177 | if Assigned(FJson) then 178 | FreeAndNil(FJson); 179 | if AHttpResponse.HeaderValue['Content-Type'] <> 'application/json' then 180 | Exit; 181 | try 182 | lJsonStr := AHttpResponse.ContentAsString(TEncoding.UTF8); 183 | FJson := TJSONObject.ParseJSONValue(lJsonStr); 184 | except 185 | on E: System.SysUtils.Exception do 186 | fException := ECloudApiException.Create(E.ToString); 187 | end; 188 | end; 189 | 190 | constructor TcaResponse.Create(ACloudRequest: IcaRequest; AHttpRequest: IHTTPRequest; AHttpResponse: IHTTPResponse; 191 | ASerializer: TJsonSerializer; AException: ECloudApiException); 192 | var 193 | lContentAsString: string; 194 | begin 195 | inherited Create(ACloudRequest, AHttpRequest, AHttpResponse, AException); 196 | FSerializer := ASerializer; 197 | if Assigned(FHttpResponse) then 198 | begin 199 | lContentAsString := FHttpResponse.ContentAsString(TEncoding.UTF8); 200 | if TestHtml(lContentAsString) then 201 | fException := ECloudApiException.Create('600', 'Server return Html text') 202 | else if not Assigned(fException) then 203 | DoUpdateData(lContentAsString); 204 | end; 205 | end; 206 | 207 | procedure TcaResponse.DoUpdateData(const AData: string); 208 | begin 209 | try 210 | FData := FSerializer.Deserialize(AData); 211 | except 212 | on E: System.SysUtils.Exception do 213 | begin 214 | fException := ECloudApiException.Create(E.ClassName, E.ToString); 215 | end; 216 | end; 217 | end; 218 | 219 | function TcaResponse.GetData: T; 220 | begin 221 | Result := FData; 222 | end; 223 | 224 | function TcaResponse.GetSerializer: TJsonSerializer; 225 | begin 226 | Result := FSerializer; 227 | end; 228 | 229 | procedure TcaResponse.SetData(const Value: T); 230 | begin 231 | FData := Value; 232 | end; 233 | 234 | procedure TcaResponse.SetSerializer(const Value: TJsonSerializer); 235 | begin 236 | FSerializer := Value; 237 | end; 238 | 239 | function TcaResponse.TestHtml(const AData: string): Boolean; 240 | begin 241 | Result := AData.Substring(0, 5).TrimLeft.ToLower = ' 16 | /// Содержит информацию о файле 17 | /// 18 | TcaFileToSend = record 19 | private 20 | FUrlOrIdOrFilePath: string; 21 | FContent: TStream; 22 | FType: TcaFileToSendType; 23 | FName: string; 24 | private 25 | function GetFileName: string; 26 | class function TestString(const AValue: string): TcaFileToSendType; static; 27 | class function Create(const AData: string; AContent: TStream; 28 | const ATag: TcaFileToSendType = TcaFileToSendType.Unknown): TcaFileToSend; static; 29 | {$REGION 'operator overload'} 30 | public 31 | class operator Equal(a, b: TcaFileToSend): Boolean; 32 | class operator Implicit(const AValue: string): TcaFileToSend; 33 | class operator Implicit(AValue: TStream): TcaFileToSend; 34 | {$ENDREGION} 35 | public 36 | /// 37 | /// Возвращает Ссылку либо ID либо Имя файла 38 | /// 39 | function GetUrlOrIdOrFilePath: string; 40 | /// 41 | /// Хранит тип файла 42 | /// 43 | property &Type: TcaFileToSendType read FType write FType; 44 | /// 45 | /// Имя файла 46 | /// 47 | property Name: string read FName write FName; 48 | /// 49 | /// Идентификатор файла 50 | /// 51 | property ID: string read FUrlOrIdOrFilePath write FUrlOrIdOrFilePath; 52 | /// 53 | /// Ссылка на файл 54 | /// 55 | property URL: string read FUrlOrIdOrFilePath write FUrlOrIdOrFilePath; 56 | /// 57 | /// Контент (TStream) 58 | /// 59 | property Content: TStream read FContent write FContent; 60 | /// 61 | /// Полный путь к файлу на диске 62 | /// 63 | property FilePath: string read FUrlOrIdOrFilePath write FUrlOrIdOrFilePath; 64 | class function FromFile(const AFileName: string): TcaFileToSend; static; 65 | class function FromID(const AID: string): TcaFileToSend; static; 66 | class function FromURL(const AUrl: string): TcaFileToSend; static; 67 | class function FromStream(const AContent: TStream; const AFileName: string): TcaFileToSend; static; 68 | class function Empty: TcaFileToSend; static; 69 | function IsEmpty: Boolean; 70 | end; 71 | 72 | TcaRequestLimit = record 73 | private 74 | FIsGlobal: Boolean; 75 | FStartedAt: TDateTime; 76 | FEndingAt: TDateTime; 77 | FLimit: Int64; 78 | FName: string; 79 | public 80 | class function Create(const ALimit: Int64; const AName: string; const AIsGlobal: Boolean): TcaRequestLimit; static; 81 | property StartedAt: TDateTime read FStartedAt write FStartedAt; 82 | property EndingAt: TDateTime read FEndingAt write FEndingAt; 83 | property Limit: Int64 read FLimit write FLimit; 84 | property Name: string read FName write FName; 85 | function IsExpired: Boolean; 86 | function ActualLimit: Int64; 87 | property IsGlobal: Boolean read FIsGlobal write FIsGlobal; 88 | class function DatesDuration(const AAfter, ABefore: TDateTime): UInt64; static; 89 | end; 90 | 91 | implementation 92 | 93 | uses 94 | System.DateUtils, 95 | System.SysUtils; 96 | 97 | { TtgFileToSend } 98 | 99 | class function TcaFileToSend.Create(const AData: string; AContent: TStream; 100 | const ATag: TcaFileToSendType = TcaFileToSendType.Unknown): TcaFileToSend; 101 | begin 102 | Result.&Type := ATag; 103 | Result.FUrlOrIdOrFilePath := AData; 104 | Result.Content := AContent; 105 | end; 106 | 107 | class function TcaFileToSend.Empty: TcaFileToSend; 108 | begin 109 | Result := TcaFileToSend.Create('', nil, TcaFileToSendType.Error); 110 | end; 111 | 112 | class operator TcaFileToSend.Equal(a, b: TcaFileToSend): Boolean; 113 | begin 114 | Result := (a.FUrlOrIdOrFilePath = b.FUrlOrIdOrFilePath) and (a.&Type = b.&Type) and (a.Content = b.Content); 115 | end; 116 | 117 | function TcaFileToSend.GetFileName: string; 118 | var 119 | LBeginPos: integer; 120 | begin 121 | LBeginPos := FUrlOrIdOrFilePath.LastIndexOfAny(['\', '/']) + 1; 122 | Result := FUrlOrIdOrFilePath.Substring(LBeginPos); 123 | end; 124 | 125 | function TcaFileToSend.GetUrlOrIdOrFilePath: string; 126 | begin 127 | Result := FUrlOrIdOrFilePath; 128 | end; 129 | 130 | class function TcaFileToSend.FromFile(const AFileName: string): TcaFileToSend; 131 | begin 132 | if not FileExists(AFileName) then 133 | raise EFileNotFoundException.CreateFmt('File %S not found!', [AFileName]); 134 | Result := TcaFileToSend.Create(AFileName, nil, TcaFileToSendType.&File); 135 | Result.Name := Result.GetFileName; 136 | end; 137 | 138 | class function TcaFileToSend.FromID(const AID: string): TcaFileToSend; 139 | begin 140 | Result := TcaFileToSend.Create(AID, nil, TcaFileToSendType.ID); 141 | end; 142 | 143 | class function TcaFileToSend.FromStream(const AContent: TStream; const AFileName: string): TcaFileToSend; 144 | begin 145 | if AFileName.IsEmpty then 146 | raise Exception.Create('TtgFileToSend: AFileName is empty!'); 147 | if not Assigned(AContent) then 148 | raise EStreamError.Create('Stream not assigned!'); 149 | Result := TcaFileToSend.Create(AFileName, AContent, TcaFileToSendType.Stream); 150 | Result.Name := Result.GetFileName; 151 | end; 152 | 153 | class function TcaFileToSend.FromURL(const AUrl: string): TcaFileToSend; 154 | begin 155 | Result := TcaFileToSend.Create(AUrl, nil, TcaFileToSendType.URL); 156 | end; 157 | 158 | class operator TcaFileToSend.Implicit(const AValue: string): TcaFileToSend; 159 | begin 160 | case TestString(AValue) of 161 | TcaFileToSendType.ID: 162 | Result := TcaFileToSend.FromID(AValue); 163 | TcaFileToSendType.URL: 164 | Result := TcaFileToSend.FromURL(AValue); 165 | TcaFileToSendType.&File: 166 | Result := TcaFileToSend.FromFile(AValue); 167 | end; 168 | end; 169 | 170 | class operator TcaFileToSend.Implicit(AValue: TStream): TcaFileToSend; 171 | begin 172 | Result := TcaFileToSend.FromStream(AValue, 'file'); 173 | end; 174 | 175 | function TcaFileToSend.IsEmpty: Boolean; 176 | begin 177 | Result := FUrlOrIdOrFilePath.IsEmpty and not Assigned(Content); 178 | end; 179 | 180 | class function TcaFileToSend.TestString(const AValue: string): TcaFileToSendType; 181 | begin 182 | if FileExists(AValue) then 183 | Result := TcaFileToSendType.&File 184 | else if AValue.contains('://') then 185 | Result := TcaFileToSendType.URL 186 | else 187 | Result := TcaFileToSendType.ID; 188 | end; 189 | 190 | { TcaRequestLimit } 191 | 192 | function TcaRequestLimit.ActualLimit: Int64; 193 | begin 194 | Result := DatesDuration(EndingAt, Now); 195 | end; 196 | 197 | class function TcaRequestLimit.Create(const ALimit: Int64; const AName: string; const AIsGlobal: Boolean) 198 | : TcaRequestLimit; 199 | begin 200 | Result.Limit := ALimit; 201 | Result.Name := AName; 202 | Result.IsGlobal := AIsGlobal; 203 | Result.StartedAt := Now; 204 | Result.EndingAt := IncMilliSecond(Result.StartedAt, Result.Limit); 205 | end; 206 | 207 | class function TcaRequestLimit.DatesDuration(const AAfter, ABefore: TDateTime): UInt64; 208 | var 209 | LAftMSec, LBefMSec: Int64; 210 | begin 211 | LAftMSec := DateTimeToMilliseconds(AAfter); 212 | LBefMSec := DateTimeToMilliseconds(ABefore); 213 | Result := LAftMSec - LBefMSec; 214 | end; 215 | 216 | function TcaRequestLimit.IsExpired: Boolean; 217 | begin 218 | Result := Now > EndingAt; 219 | end; 220 | 221 | end. 222 | -------------------------------------------------------------------------------- /CloudAPI.dpk: -------------------------------------------------------------------------------- 1 | package CloudAPI; 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 | {$IMPLICITBUILD ON} 29 | 30 | requires 31 | rtl; 32 | 33 | contains 34 | CloudAPI.Client.Base in 'CloudAPI.Client.Base.pas', 35 | CloudAPI.IAuthenticator in 'CloudAPI.IAuthenticator.pas', 36 | CloudAPI.Response in 'CloudAPI.Response.pas', 37 | CloudAPI.Types in 'CloudAPI.Types.pas', 38 | CloudAPI.RequestArgument in 'CloudAPI.RequestArgument.pas', 39 | CloudAPI.Converter.BasicTypes in 'CloudAPI.Converter.BasicTypes.pas', 40 | CloudAPI.Attributes in 'CloudAPI.Attributes.pas', 41 | CloudAPI.Parameter in 'CloudAPI.Parameter.pas', 42 | CloudAPI.Authenticator.Basic in 'CloudAPI.Authenticator.Basic.pas', 43 | CloudAPI.Json.Converters in 'CloudAPI.Json.Converters.pas', 44 | CloudAPI.Exceptions in 'CloudAPI.Exceptions.pas', 45 | CloudAPI.LongPolling in 'CloudAPI.LongPolling.pas', 46 | CloudAPI.Ext.MethodLimits in 'CloudAPI.Ext.MethodLimits.pas', 47 | CloudAPI.Client in 'CloudAPI.Client.pas', 48 | CloudAPI.Request in 'CloudAPI.Request.pas', 49 | CloudAPI.Core.RequestBuilder in 'CloudAPI.Core.RequestBuilder.pas', 50 | CloudAPI.Core.Constants in 'CloudAPI.Core.Constants.pas', 51 | CloudAPI.Response.Printer in 'CloudAPI.Response.Printer.pas', 52 | CloudAPI.Request.New in 'CloudAPI.Request.New.pas', 53 | CloudAPI.Request.Body in 'CloudAPI.Request.Body.pas'; 54 | 55 | end. 56 | -------------------------------------------------------------------------------- /CloudAPI.dproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {13BDE2E6-345B-4449-8E24-F2231100AE1E} 4 | CloudAPI.dpk 5 | 19.2 6 | None 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 | Base 29 | true 30 | 31 | 32 | true 33 | Cfg_1 34 | true 35 | true 36 | 37 | 38 | true 39 | Base 40 | true 41 | 42 | 43 | true 44 | Cfg_2 45 | true 46 | true 47 | 48 | 49 | ..\bin 50 | .\$(Platform)\$(Config) 51 | false 52 | false 53 | false 54 | false 55 | false 56 | true 57 | true 58 | System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) 59 | CloudAPI 60 | 1033 61 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= 62 | .\DUnitX;$(DCC_UnitSearchPath) 63 | 64 | 65 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 66 | Debug 67 | true 68 | rtl;$(DCC_UsePackage) 69 | 70 | 71 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) 72 | Debug 73 | true 74 | 75 | 76 | DEBUG;$(DCC_Define) 77 | true 78 | false 79 | true 80 | true 81 | true 82 | 83 | 84 | false 85 | true 86 | true 87 | 88 | 89 | false 90 | RELEASE;$(DCC_Define) 91 | 0 92 | 0 93 | 94 | 95 | true 96 | 97 | 98 | 99 | MainSource 100 | 101 | 102 | 103 | 104 | 105 | 106 | 107 | 108 | 109 | 110 | 111 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 | 120 | 121 | 122 | 123 | Cfg_2 124 | Base 125 | 126 | 127 | Base 128 | 129 | 130 | Cfg_1 131 | Base 132 | 133 | 134 | 135 | Delphi.Personality.12 136 | Package 137 | 138 | 139 | 140 | CloudAPI.dpk 141 | 142 | 143 | Microsoft Office 2000 Sample Automation Server Wrapper Components 144 | Microsoft Office XP Sample Automation Server Wrapper Components 145 | 146 | 147 | 148 | 149 | 150 | true 151 | 152 | 153 | 154 | 155 | true 156 | 157 | 158 | 159 | 160 | true 161 | 162 | 163 | 164 | 165 | CloudAPI.bpl 166 | true 167 | 168 | 169 | 170 | 171 | 1 172 | 173 | 174 | 0 175 | 176 | 177 | 178 | 179 | classes 180 | 1 181 | 182 | 183 | classes 184 | 1 185 | 186 | 187 | 188 | 189 | res\xml 190 | 1 191 | 192 | 193 | res\xml 194 | 1 195 | 196 | 197 | 198 | 199 | library\lib\armeabi-v7a 200 | 1 201 | 202 | 203 | 204 | 205 | library\lib\armeabi 206 | 1 207 | 208 | 209 | library\lib\armeabi 210 | 1 211 | 212 | 213 | 214 | 215 | library\lib\armeabi-v7a 216 | 1 217 | 218 | 219 | 220 | 221 | library\lib\mips 222 | 1 223 | 224 | 225 | library\lib\mips 226 | 1 227 | 228 | 229 | 230 | 231 | library\lib\armeabi-v7a 232 | 1 233 | 234 | 235 | library\lib\arm64-v8a 236 | 1 237 | 238 | 239 | 240 | 241 | library\lib\armeabi-v7a 242 | 1 243 | 244 | 245 | 246 | 247 | res\drawable 248 | 1 249 | 250 | 251 | res\drawable 252 | 1 253 | 254 | 255 | 256 | 257 | res\values 258 | 1 259 | 260 | 261 | res\values 262 | 1 263 | 264 | 265 | 266 | 267 | res\values-v21 268 | 1 269 | 270 | 271 | res\values-v21 272 | 1 273 | 274 | 275 | 276 | 277 | res\values 278 | 1 279 | 280 | 281 | res\values 282 | 1 283 | 284 | 285 | 286 | 287 | res\drawable 288 | 1 289 | 290 | 291 | res\drawable 292 | 1 293 | 294 | 295 | 296 | 297 | res\drawable-xxhdpi 298 | 1 299 | 300 | 301 | res\drawable-xxhdpi 302 | 1 303 | 304 | 305 | 306 | 307 | res\drawable-xxxhdpi 308 | 1 309 | 310 | 311 | res\drawable-xxxhdpi 312 | 1 313 | 314 | 315 | 316 | 317 | res\drawable-ldpi 318 | 1 319 | 320 | 321 | res\drawable-ldpi 322 | 1 323 | 324 | 325 | 326 | 327 | res\drawable-mdpi 328 | 1 329 | 330 | 331 | res\drawable-mdpi 332 | 1 333 | 334 | 335 | 336 | 337 | res\drawable-hdpi 338 | 1 339 | 340 | 341 | res\drawable-hdpi 342 | 1 343 | 344 | 345 | 346 | 347 | res\drawable-xhdpi 348 | 1 349 | 350 | 351 | res\drawable-xhdpi 352 | 1 353 | 354 | 355 | 356 | 357 | res\drawable-mdpi 358 | 1 359 | 360 | 361 | res\drawable-mdpi 362 | 1 363 | 364 | 365 | 366 | 367 | res\drawable-hdpi 368 | 1 369 | 370 | 371 | res\drawable-hdpi 372 | 1 373 | 374 | 375 | 376 | 377 | res\drawable-xhdpi 378 | 1 379 | 380 | 381 | res\drawable-xhdpi 382 | 1 383 | 384 | 385 | 386 | 387 | res\drawable-xxhdpi 388 | 1 389 | 390 | 391 | res\drawable-xxhdpi 392 | 1 393 | 394 | 395 | 396 | 397 | res\drawable-xxxhdpi 398 | 1 399 | 400 | 401 | res\drawable-xxxhdpi 402 | 1 403 | 404 | 405 | 406 | 407 | res\drawable-small 408 | 1 409 | 410 | 411 | res\drawable-small 412 | 1 413 | 414 | 415 | 416 | 417 | res\drawable-normal 418 | 1 419 | 420 | 421 | res\drawable-normal 422 | 1 423 | 424 | 425 | 426 | 427 | res\drawable-large 428 | 1 429 | 430 | 431 | res\drawable-large 432 | 1 433 | 434 | 435 | 436 | 437 | res\drawable-xlarge 438 | 1 439 | 440 | 441 | res\drawable-xlarge 442 | 1 443 | 444 | 445 | 446 | 447 | res\values 448 | 1 449 | 450 | 451 | res\values 452 | 1 453 | 454 | 455 | 456 | 457 | 1 458 | 459 | 460 | 1 461 | 462 | 463 | 0 464 | 465 | 466 | 467 | 468 | 1 469 | .framework 470 | 471 | 472 | 1 473 | .framework 474 | 475 | 476 | 0 477 | 478 | 479 | 480 | 481 | 1 482 | .dylib 483 | 484 | 485 | 1 486 | .dylib 487 | 488 | 489 | 0 490 | .dll;.bpl 491 | 492 | 493 | 494 | 495 | 1 496 | .dylib 497 | 498 | 499 | 1 500 | .dylib 501 | 502 | 503 | 1 504 | .dylib 505 | 506 | 507 | 1 508 | .dylib 509 | 510 | 511 | 1 512 | .dylib 513 | 514 | 515 | 0 516 | .bpl 517 | 518 | 519 | 520 | 521 | 0 522 | 523 | 524 | 0 525 | 526 | 527 | 0 528 | 529 | 530 | 0 531 | 532 | 533 | 0 534 | 535 | 536 | 0 537 | 538 | 539 | 0 540 | 541 | 542 | 0 543 | 544 | 545 | 546 | 547 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 548 | 1 549 | 550 | 551 | 552 | 553 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 554 | 1 555 | 556 | 557 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 558 | 1 559 | 560 | 561 | 562 | 563 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 564 | 1 565 | 566 | 567 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 568 | 1 569 | 570 | 571 | 572 | 573 | 1 574 | 575 | 576 | 1 577 | 578 | 579 | 1 580 | 581 | 582 | 583 | 584 | 1 585 | 586 | 587 | 1 588 | 589 | 590 | 1 591 | 592 | 593 | 594 | 595 | 1 596 | 597 | 598 | 1 599 | 600 | 601 | 1 602 | 603 | 604 | 605 | 606 | 1 607 | 608 | 609 | 1 610 | 611 | 612 | 1 613 | 614 | 615 | 616 | 617 | 1 618 | 619 | 620 | 1 621 | 622 | 623 | 1 624 | 625 | 626 | 627 | 628 | 1 629 | 630 | 631 | 1 632 | 633 | 634 | 1 635 | 636 | 637 | 638 | 639 | 1 640 | 641 | 642 | 1 643 | 644 | 645 | 1 646 | 647 | 648 | 649 | 650 | 1 651 | 652 | 653 | 1 654 | 655 | 656 | 1 657 | 658 | 659 | 660 | 661 | 1 662 | 663 | 664 | 1 665 | 666 | 667 | 1 668 | 669 | 670 | 671 | 672 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 673 | 1 674 | 675 | 676 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 677 | 1 678 | 679 | 680 | 681 | 682 | 1 683 | 684 | 685 | 1 686 | 687 | 688 | 1 689 | 690 | 691 | 692 | 693 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 694 | 1 695 | 696 | 697 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 698 | 1 699 | 700 | 701 | 702 | 703 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 704 | 1 705 | 706 | 707 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 708 | 1 709 | 710 | 711 | 712 | 713 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 714 | 1 715 | 716 | 717 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 718 | 1 719 | 720 | 721 | 722 | 723 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 724 | 1 725 | 726 | 727 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 728 | 1 729 | 730 | 731 | 732 | 733 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 734 | 1 735 | 736 | 737 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 738 | 1 739 | 740 | 741 | 742 | 743 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 744 | 1 745 | 746 | 747 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 748 | 1 749 | 750 | 751 | 752 | 753 | 1 754 | 755 | 756 | 1 757 | 758 | 759 | 1 760 | 761 | 762 | 763 | 764 | 1 765 | 766 | 767 | 1 768 | 769 | 770 | 1 771 | 772 | 773 | 774 | 775 | 1 776 | 777 | 778 | 1 779 | 780 | 781 | 1 782 | 783 | 784 | 785 | 786 | 1 787 | 788 | 789 | 1 790 | 791 | 792 | 1 793 | 794 | 795 | 796 | 797 | 1 798 | 799 | 800 | 1 801 | 802 | 803 | 1 804 | 805 | 806 | 807 | 808 | 1 809 | 810 | 811 | 1 812 | 813 | 814 | 1 815 | 816 | 817 | 818 | 819 | 1 820 | 821 | 822 | 1 823 | 824 | 825 | 1 826 | 827 | 828 | 829 | 830 | 1 831 | 832 | 833 | 1 834 | 835 | 836 | 1 837 | 838 | 839 | 840 | 841 | 1 842 | 843 | 844 | 1 845 | 846 | 847 | 1 848 | 849 | 850 | 851 | 852 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 853 | 1 854 | 855 | 856 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 857 | 1 858 | 859 | 860 | 861 | 862 | 1 863 | 864 | 865 | 1 866 | 867 | 868 | 1 869 | 870 | 871 | 872 | 873 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 874 | 1 875 | 876 | 877 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 878 | 1 879 | 880 | 881 | 882 | 883 | 1 884 | 885 | 886 | 1 887 | 888 | 889 | 1 890 | 891 | 892 | 893 | 894 | 1 895 | 896 | 897 | 1 898 | 899 | 900 | 1 901 | 902 | 903 | 904 | 905 | 1 906 | 907 | 908 | 1 909 | 910 | 911 | 1 912 | 913 | 914 | 915 | 916 | 1 917 | 918 | 919 | 1 920 | 921 | 922 | 1 923 | 924 | 925 | 926 | 927 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 928 | 1 929 | 930 | 931 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 932 | 1 933 | 934 | 935 | 936 | 937 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 938 | 1 939 | 940 | 941 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 942 | 1 943 | 944 | 945 | 946 | 947 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 948 | 1 949 | 950 | 951 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 952 | 1 953 | 954 | 955 | 956 | 957 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 958 | 1 959 | 960 | 961 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 962 | 1 963 | 964 | 965 | 966 | 967 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 968 | 1 969 | 970 | 971 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 972 | 1 973 | 974 | 975 | 976 | 977 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 978 | 1 979 | 980 | 981 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 982 | 1 983 | 984 | 985 | 986 | 987 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 988 | 1 989 | 990 | 991 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 992 | 1 993 | 994 | 995 | 996 | 997 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 998 | 1 999 | 1000 | 1001 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1002 | 1 1003 | 1004 | 1005 | 1006 | 1007 | 1 1008 | 1009 | 1010 | 1 1011 | 1012 | 1013 | 1014 | 1015 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 1016 | 1 1017 | 1018 | 1019 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 1020 | 1 1021 | 1022 | 1023 | 1024 | 1025 | 1026 | 1027 | 1028 | 1029 | 1 1030 | 1031 | 1032 | 1 1033 | 1034 | 1035 | 1 1036 | 1037 | 1038 | 1039 | 1040 | 1041 | 1042 | 1043 | Contents\Resources 1044 | 1 1045 | 1046 | 1047 | Contents\Resources 1048 | 1 1049 | 1050 | 1051 | 1052 | 1053 | library\lib\armeabi-v7a 1054 | 1 1055 | 1056 | 1057 | library\lib\arm64-v8a 1058 | 1 1059 | 1060 | 1061 | 1 1062 | 1063 | 1064 | 1 1065 | 1066 | 1067 | 1 1068 | 1069 | 1070 | 1 1071 | 1072 | 1073 | 1 1074 | 1075 | 1076 | 1 1077 | 1078 | 1079 | 0 1080 | 1081 | 1082 | 1083 | 1084 | library\lib\armeabi-v7a 1085 | 1 1086 | 1087 | 1088 | 1089 | 1090 | 1 1091 | 1092 | 1093 | 1 1094 | 1095 | 1096 | 1097 | 1098 | Assets 1099 | 1 1100 | 1101 | 1102 | Assets 1103 | 1 1104 | 1105 | 1106 | 1107 | 1108 | Assets 1109 | 1 1110 | 1111 | 1112 | Assets 1113 | 1 1114 | 1115 | 1116 | 1117 | 1118 | 1119 | 1120 | 1121 | 1122 | 1123 | 1124 | 1125 | 1126 | 1127 | 1128 | True 1129 | False 1130 | 1131 | 1132 | 12 1133 | 1134 | 1135 | 1136 | 1137 | 1138 | -------------------------------------------------------------------------------- /CloudAPIProject.groupproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {379FF357-E435-4305-8620-0262633A1602} 4 | 5 | 6 | 7 | 8 | 9 | 10 | CloudAPI.dproj 11 | 12 | 13 | 14 | Default.Personality.12 15 | 16 | 17 | 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 | -------------------------------------------------------------------------------- /ISSUE_TEMPLATE.md: -------------------------------------------------------------------------------- 1 | ### TelegaPi version/Версия TelegaPi 2 | > v.3.5.5 3 | ### IDE version/ Версия IDE 4 | > RAD Studio Berlin 5 | ### Information/Информация 6 | > The SendVideo method does not work. 7 | ### Steps to reproduce the behavior/Что нужно сделать, для воспроизведения 8 | > I call the method, similarly to SendFoto in the examples: tgBot.SendVideo (theChatID, TtgFileToSend.FromFile ('c:\testmp4\test.mp4')); 9 | >I get: OnGlobalException: RequestAPI @ Could not convert variant of type (UnicodeString) into type (Double) 10 | -------------------------------------------------------------------------------- /LICENSE.txt: -------------------------------------------------------------------------------- 1 | This library is Open Source software, can be used this in commercial projects, modify, and distribute as source code or binary files. 2 | === 3 | This library licensed at two license: GNU GPL v2 and Modified MIT License (MIT) 4 | You can choose one of two license. 5 | 1. GNU GPL v2: https://www.gnu.org/licenses/gpl2.html 6 | 2. Modified MIT License (MIT): 7 | === 8 | Modified MIT License (MIT) 9 | 10 | Copyright (c) 2009-2016 Peter Sokolov, ErrorSoft(c) 11 | 12 | Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: 13 | 14 | 1. The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. 15 | 2. Do not have to sell this library as a standalone components library or as part of another components library (you can agree with me on licensing). 16 | 3. Desirable specify the use of this library in your software (example: about window). 17 | 18 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 19 | -------------------------------------------------------------------------------- /Logo/I_stand_with_Ukraine_banner.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rareMaxim/CloudAPI/8e664a2bd14298e465b8cee98772ebea0a923d53/Logo/I_stand_with_Ukraine_banner.png -------------------------------------------------------------------------------- /Logo/I_stand_with_Ukraine_banner.psd: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rareMaxim/CloudAPI/8e664a2bd14298e465b8cee98772ebea0a923d53/Logo/I_stand_with_Ukraine_banner.psd -------------------------------------------------------------------------------- /Logo/ca-CloudAPI-Delphi-512.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rareMaxim/CloudAPI/8e664a2bd14298e465b8cee98772ebea0a923d53/Logo/ca-CloudAPI-Delphi-512.png -------------------------------------------------------------------------------- /Logo/ca-CloudAPI-Delphi-512.psd: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rareMaxim/CloudAPI/8e664a2bd14298e465b8cee98772ebea0a923d53/Logo/ca-CloudAPI-Delphi-512.psd -------------------------------------------------------------------------------- /Logo/ca-CloudAPI-Delphi-Ukraine-512.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rareMaxim/CloudAPI/8e664a2bd14298e465b8cee98772ebea0a923d53/Logo/ca-CloudAPI-Delphi-Ukraine-512.png -------------------------------------------------------------------------------- /Logo/ca-CloudAPI-Delphi-Ukraine-512.psd: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rareMaxim/CloudAPI/8e664a2bd14298e465b8cee98772ebea0a923d53/Logo/ca-CloudAPI-Delphi-Ukraine-512.psd -------------------------------------------------------------------------------- /Logo/ca-CloudEmoji-Delphi-512.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rareMaxim/CloudAPI/8e664a2bd14298e465b8cee98772ebea0a923d53/Logo/ca-CloudEmoji-Delphi-512.png -------------------------------------------------------------------------------- /Logo/ca-CloudEmoji-Delphi-512.xcf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rareMaxim/CloudAPI/8e664a2bd14298e465b8cee98772ebea0a923d53/Logo/ca-CloudEmoji-Delphi-512.xcf -------------------------------------------------------------------------------- /Logo/ca-RECT-CloudEmoji-Delphi-128.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rareMaxim/CloudAPI/8e664a2bd14298e465b8cee98772ebea0a923d53/Logo/ca-RECT-CloudEmoji-Delphi-128.png -------------------------------------------------------------------------------- /Logo/ca-RECT-CloudEmoji-Delphi-128.xcf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rareMaxim/CloudAPI/8e664a2bd14298e465b8cee98772ebea0a923d53/Logo/ca-RECT-CloudEmoji-Delphi-128.xcf -------------------------------------------------------------------------------- /Logo/ca-RECT-CloudEmoji-Delphi-512.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rareMaxim/CloudAPI/8e664a2bd14298e465b8cee98772ebea0a923d53/Logo/ca-RECT-CloudEmoji-Delphi-512.png -------------------------------------------------------------------------------- /Logo/ca-RECT-CloudEmoji-Delphi-512.xcf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rareMaxim/CloudAPI/8e664a2bd14298e465b8cee98772ebea0a923d53/Logo/ca-RECT-CloudEmoji-Delphi-512.xcf -------------------------------------------------------------------------------- /Logo/repository-open-graph-template.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rareMaxim/CloudAPI/8e664a2bd14298e465b8cee98772ebea0a923d53/Logo/repository-open-graph-template.png -------------------------------------------------------------------------------- /Logo/repository-open-graph-template.psd: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rareMaxim/CloudAPI/8e664a2bd14298e465b8cee98772ebea0a923d53/Logo/repository-open-graph-template.psd -------------------------------------------------------------------------------- /Logo/style.TXT: -------------------------------------------------------------------------------- 1 | topFontColor=d4d4e6 2 | bottomFontColor=fff9e4 -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | [![SWUbanner](https://github.com/ms301/CloudAPI/blob/master/Logo/I_stand_with_Ukraine_banner.png?raw=true)](https://github.com/vshymanskyy/StandWithUkraine/blob/main/docs/README.md) 2 | 3 | # Delphi Cloud Api - Beta # 4 | 5 | Delphi Cloud Api - Library for working with many API in Delphi 6 | 7 | 8 | Version Delphi Cloud Api: *0.1* 9 | -------------------------------------------------------------------------------- /Tests/CloudApiTest.dpr: -------------------------------------------------------------------------------- 1 | program CloudApiTest; 2 | 3 | {$IFNDEF TESTINSIGHT} 4 | {$APPTYPE CONSOLE} 5 | {$ENDIF} 6 | {$STRONGLINKTYPES ON} 7 | 8 | uses 9 | System.SysUtils, 10 | {$IFDEF TESTINSIGHT} 11 | TestInsight.DUnitX, 12 | {$ELSE} 13 | DUnitX.Loggers.Console, 14 | DUnitX.Loggers.Xml.NUnit, 15 | {$ENDIF } 16 | DUnitX.TestFramework, 17 | RequestArgumentTest in 'UntiTests\RequestArgumentTest.pas', 18 | RequestArgumentTest.Types in 'UntiTests\RequestArgumentTest.Types.pas'; 19 | 20 | {$IFNDEF TESTINSIGHT} 21 | 22 | var 23 | runner: ITestRunner; 24 | results: IRunResults; 25 | logger: ITestLogger; 26 | nunitLogger: ITestLogger; 27 | {$ENDIF} 28 | 29 | begin 30 | ReportMemoryLeaksOnShutdown := True; 31 | {$IFDEF TESTINSIGHT} 32 | TestInsight.DUnitX.RunRegisteredTests; 33 | {$ELSE} 34 | try 35 | // Check command line options, will exit if invalid 36 | TDUnitX.CheckCommandLine; 37 | // Create the test runner 38 | runner := TDUnitX.CreateRunner; 39 | // Tell the runner to use RTTI to find Fixtures 40 | runner.UseRTTI := True; 41 | // When true, Assertions must be made during tests; 42 | runner.FailsOnNoAsserts := False; 43 | 44 | // tell the runner how we will log things 45 | // Log to the console window if desired 46 | if TDUnitX.Options.ConsoleMode <> TDunitXConsoleMode.Off then 47 | begin 48 | logger := TDUnitXConsoleLogger.Create(TDUnitX.Options.ConsoleMode = TDunitXConsoleMode.Quiet); 49 | runner.AddLogger(logger); 50 | end; 51 | // Generate an NUnit compatible XML File 52 | nunitLogger := TDUnitXXMLNUnitFileLogger.Create(TDUnitX.Options.XMLOutputFile); 53 | runner.AddLogger(nunitLogger); 54 | 55 | // Run tests 56 | results := runner.Execute; 57 | if not results.AllPassed then 58 | System.ExitCode := EXIT_ERRORS; 59 | 60 | {$IFNDEF CI} 61 | // We don't want this happening when running under CI. 62 | if TDUnitX.Options.ExitBehavior = TDUnitXExitBehavior.Pause then 63 | begin 64 | System.Write('Done.. press key to quit.'); 65 | System.Readln; 66 | end; 67 | {$ENDIF} 68 | except 69 | on E: Exception do 70 | System.Writeln(E.ClassName, ': ', E.Message); 71 | end; 72 | {$ENDIF} 73 | 74 | end. 75 | -------------------------------------------------------------------------------- /Tests/Intergrated/HttpBinTest.Types.pas: -------------------------------------------------------------------------------- 1 | unit HttpBinTest.Types; 2 | 3 | interface 4 | 5 | uses 6 | System.Generics.Collections, 7 | System.JSON.Converters, 8 | System.JSON.Serializers; 9 | 10 | type 11 | TJsonStringStringDictionaryConverter = class(TJsonStringDictionaryConverter); 12 | 13 | TTestResponseBody = class 14 | private 15 | [JsonName('url')] 16 | Furl: string; 17 | [JsonName('origin')] 18 | Forigin: string; 19 | [JsonName('headers')] 20 | [JsonConverter(TJsonStringStringDictionaryConverter)] 21 | FHeaders: TDictionary; 22 | public 23 | property Url: string read Furl write Furl; 24 | property Origin: string read Forigin write Forigin; 25 | property Headers: TDictionary read FHeaders write FHeaders; 26 | end; 27 | 28 | implementation 29 | 30 | end. 31 | -------------------------------------------------------------------------------- /Tests/Intergrated/HttpBinTest.pas: -------------------------------------------------------------------------------- 1 | unit HttpBinTest; 2 | 3 | interface 4 | 5 | uses 6 | CloudApi.Client.Sync, 7 | DUnitX.TestFramework, 8 | System.Generics.Collections, 9 | CloudApi.Types; 10 | 11 | type 12 | TBaseTest = class 13 | procedure PrintDict(NewParam: TArray < TPair < string, string >> ); 14 | end; 15 | 16 | [TestFixture] 17 | THTTPMethodsTest = class(TBaseTest) 18 | strict private 19 | FCloud: TCloudApiClient; 20 | protected 21 | procedure InternalExec(const AMethod: TcaMethod; const AResource: string; AWithPrint: Boolean); 22 | public 23 | [Setup] 24 | procedure Setup; 25 | [TearDown] 26 | procedure TearDown; 27 | [Test] 28 | procedure Get; 29 | [Test] 30 | procedure Post; 31 | [Test] 32 | procedure Delete; 33 | [Test] 34 | procedure Patch; 35 | [Test] 36 | procedure PUT; 37 | [Test] 38 | procedure Image; 39 | end; 40 | 41 | [TestFixture] 42 | TAuthTest = class(TBaseTest) 43 | strict private 44 | FCloud: TCloudApiClient; 45 | protected 46 | public 47 | [Setup] 48 | procedure Setup; 49 | [TearDown] 50 | procedure TearDown; 51 | [Test] 52 | procedure BasicAuth; 53 | end; 54 | 55 | implementation 56 | 57 | uses 58 | CloudApi.Authenticator.Basic, 59 | CloudApi.Response, 60 | CloudApi.Request, 61 | HttpBinTest.Types; 62 | 63 | procedure THTTPMethodsTest.Patch; 64 | begin 65 | InternalExec(TcaMethod.Patch, 'patch', False); 66 | end; 67 | 68 | procedure THTTPMethodsTest.Post; 69 | begin 70 | InternalExec(TcaMethod.Post, 'post', False); 71 | end; 72 | 73 | procedure THTTPMethodsTest.PUT; 74 | begin 75 | InternalExec(TcaMethod.PUT, 'put', False); 76 | end; 77 | 78 | procedure THTTPMethodsTest.Setup; 79 | begin 80 | FCloud := TCloudApiClient.Create; 81 | FCloud.BaseUrl := 'https://httpbin.org'; 82 | end; 83 | 84 | procedure THTTPMethodsTest.TearDown; 85 | begin 86 | FCloud.Free; 87 | end; 88 | 89 | procedure THTTPMethodsTest.Delete; 90 | begin 91 | InternalExec(TcaMethod.Delete, 'delete', False); 92 | end; 93 | 94 | procedure THTTPMethodsTest.Get; 95 | begin 96 | InternalExec(TcaMethod.Get, 'get', False); 97 | end; 98 | 99 | procedure THTTPMethodsTest.Image; 100 | var 101 | LRequest: IcaRequest; 102 | LResp: IcaResponseBase; 103 | begin 104 | LRequest := TcaRequest.Create; 105 | LRequest.AddHeader('accept', 'image/*'); 106 | LResp := FCloud.Download('https://httpbin.org/image', '1.png', LRequest); 107 | Assert.AreEqual(200, LResp.HttpResponse.StatusCode); 108 | end; 109 | 110 | procedure THTTPMethodsTest.InternalExec(const AMethod: TcaMethod; const AResource: string; AWithPrint: Boolean); 111 | var 112 | LReq: IcaRequest; 113 | LRes: IcaResponse; 114 | begin 115 | LReq := TcaRequest.Create; 116 | LReq.Resource := AResource; 117 | LReq.Method := AMethod; 118 | LRes := FCloud.Execute(LReq); 119 | Assert.AreEqual(LRes.HttpResponse.StatusCode, 200); 120 | Assert.IsNotEmpty(LRes.Data.Url); 121 | if AWithPrint then 122 | PrintDict(LRes.Data.Headers.ToArray); 123 | end; 124 | 125 | { TAuthTest } 126 | 127 | procedure TAuthTest.BasicAuth; 128 | const 129 | AUTH_USERNAME = 'username'; 130 | AUTH_PASSWORD = 'passWord'; 131 | var 132 | LReq: IcaRequest; 133 | LRes: IcaResponseBase; 134 | begin 135 | FCloud.Authenticator := TBasicAuthenticator.Create(AUTH_USERNAME, AUTH_PASSWORD); 136 | LReq := TcaRequest.Create; 137 | LReq.Resource := 'basic-auth/' + AUTH_USERNAME + '/' + AUTH_PASSWORD; 138 | LReq.Method := TcaMethod.Get; 139 | LRes := FCloud.Execute(LReq); 140 | Assert.AreEqual(LRes.HttpResponse.StatusCode, 200); 141 | end; 142 | 143 | procedure TAuthTest.Setup; 144 | begin 145 | FCloud := TCloudApiClient.Create; 146 | FCloud.BaseUrl := 'https://httpbin.org'; 147 | end; 148 | 149 | procedure TAuthTest.TearDown; 150 | begin 151 | FCloud.Free; 152 | end; 153 | 154 | { TBaseTest } 155 | 156 | procedure TBaseTest.PrintDict(NewParam: TArray < TPair < string, string >> ); 157 | var 158 | I: Integer; 159 | begin 160 | System.Writeln('Count: ', Length(NewParam)); 161 | for I := Low(NewParam) to High(NewParam) do 162 | System.Writeln(NewParam[I].Key + '=' + NewParam[I].Value); 163 | 164 | end; 165 | 166 | initialization 167 | 168 | TDUnitX.RegisterTestFixture(THTTPMethodsTest); 169 | 170 | end. 171 | -------------------------------------------------------------------------------- /Tests/Intergrated/pipedreamTest.pas: -------------------------------------------------------------------------------- 1 | unit pipedreamTest; 2 | 3 | interface 4 | 5 | uses 6 | DUnitX.TestFramework, 7 | CloudAPI.Client.Sync; 8 | 9 | type 10 | 11 | [TestFixture] 12 | TMyTestObject = class 13 | strict private 14 | FCloud: TCloudApiClient; 15 | public 16 | [Setup] 17 | procedure Setup; 18 | [TearDown] 19 | procedure TearDown; 20 | [Test] 21 | procedure Test1; 22 | end; 23 | 24 | implementation 25 | 26 | uses 27 | CloudAPI.Request, 28 | CloudAPI.Types, 29 | CloudAPI.Response; 30 | 31 | procedure TMyTestObject.Setup; 32 | begin 33 | FCloud := TCloudApiClient.Create(); 34 | FCloud.BaseUrl := 'https://22791691853624b16004d88c83a8fff1.m.pipedream.net'; 35 | end; 36 | 37 | procedure TMyTestObject.TearDown; 38 | begin 39 | FCloud.Free; 40 | end; 41 | 42 | procedure TMyTestObject.Test1; 43 | var 44 | LGet: IcaRequest; 45 | LResponse: IcaResponseBase; 46 | begin 47 | LGet := TcaRequest.Create; 48 | LGet.Method := TcaMethod.GET; 49 | LGet.Resource := 'getCoffee'; 50 | LGet.RequestBody.Text := '{"suggar":1}'; 51 | LResponse := FCloud.Execute(LGet); 52 | Assert.AreEqual(200, LResponse.HttpResponse.StatusCode); 53 | end; 54 | 55 | initialization 56 | 57 | TDUnitX.RegisterTestFixture(TMyTestObject); 58 | 59 | end. 60 | -------------------------------------------------------------------------------- /Tests/UntiTests/RequestArgumentTest.Types.pas: -------------------------------------------------------------------------------- 1 | unit RequestArgumentTest.Types; 2 | 3 | interface 4 | 5 | uses 6 | CloudAPI.Attributes, 7 | CloudAPI.Types; 8 | 9 | type 10 | TOnePairRecord = record 11 | public 12 | [caName('key')] 13 | Value: string; 14 | class function GetValue: TOnePairRecord; static; 15 | end; 16 | 17 | TTwoPairRecord = record 18 | public 19 | [caName('key1')] 20 | Value1: string; 21 | [caName('key2')] 22 | Value2: string; 23 | class function GetValue: TTwoPairRecord; static; 24 | end; 25 | 26 | [caName('getMe')] 27 | [caParameterType(TcaParameterType.QueryString)] 28 | TOnePairClass = class 29 | private 30 | [caName('key')] 31 | fValue: string; 32 | public 33 | property Value: string read fValue write fValue; 34 | class function GetValue: TOnePairClass; static; 35 | end; 36 | 37 | TBaseClass = class 38 | private 39 | fExcludeParam: integer; 40 | [caName('key1')] 41 | fIncludeParam: integer; 42 | end; 43 | 44 | [caName('getMe')] 45 | [caParameterType(TcaParameterType.QueryString)] 46 | TTwoPairClass = class(TBaseClass) 47 | private 48 | [caName('key2')] 49 | fValue: string; 50 | public 51 | property Value: string read fValue write fValue; 52 | class function GetValue: TTwoPairClass; static; 53 | end; 54 | 55 | implementation 56 | 57 | { TOnePairRecord } 58 | 59 | class function TOnePairRecord.GetValue: TOnePairRecord; 60 | begin 61 | Result.Value := 'Value'; 62 | end; 63 | 64 | { TTwoPairRecord } 65 | 66 | class function TTwoPairRecord.GetValue: TTwoPairRecord; 67 | begin 68 | Result.Value1 := 'Value1'; 69 | Result.Value2 := 'Value2'; 70 | end; 71 | 72 | { TOnePairClass } 73 | 74 | class function TOnePairClass.GetValue: TOnePairClass; 75 | begin 76 | Result := TOnePairClass.Create; 77 | Result.fValue := 'Value'; 78 | end; 79 | 80 | { TTwoPairClass } 81 | 82 | class function TTwoPairClass.GetValue: TTwoPairClass; 83 | begin 84 | Result := TTwoPairClass.Create; 85 | Result.fValue := 'Value'; 86 | Result.fIncludeParam := 1; 87 | end; 88 | 89 | end. 90 | -------------------------------------------------------------------------------- /Tests/UntiTests/RequestArgumentTest.pas: -------------------------------------------------------------------------------- 1 | unit RequestArgumentTest; 2 | 3 | interface 4 | 5 | uses 6 | CloudAPI.RequestArgument, 7 | CloudAPI.Parameter, 8 | System.Rtti, 9 | DUnitX.TestFramework; 10 | 11 | type 12 | 13 | [TestFixture] 14 | TcaRequestArgumentTest = class 15 | strict private 16 | fRequestArgument: TcaRequestArgument; 17 | public 18 | [Setup] 19 | procedure Setup; 20 | [TearDown] 21 | procedure TearDown; 22 | [Test] 23 | procedure RecordOneValue; 24 | [Test] 25 | procedure RecordTwoValue; 26 | [Test] 27 | procedure ClassOneValue; 28 | [Test] 29 | procedure ClassTwoValue; 30 | end; 31 | 32 | implementation 33 | 34 | uses 35 | RequestArgumentTest.Types; 36 | 37 | procedure TcaRequestArgumentTest.RecordTwoValue; 38 | var 39 | lParams: TArray; 40 | lVal: TTwoPairRecord; 41 | begin 42 | lVal := TTwoPairRecord.GetValue; 43 | lParams := fRequestArgument.ObjToParams(lVal); 44 | Assert.IsNotNull(lParams); 45 | Assert.AreEqual(lParams[0].Name, 'key1'); 46 | Assert.AreEqual(lParams[0].ValueAsString, 'Value1'); 47 | Assert.AreEqual(lParams[1].Name, 'key2'); 48 | Assert.AreEqual(lParams[1].ValueAsString, 'Value2'); 49 | end; 50 | 51 | procedure TcaRequestArgumentTest.Setup; 52 | begin 53 | fRequestArgument := TcaRequestArgument.Create; 54 | end; 55 | 56 | procedure TcaRequestArgumentTest.TearDown; 57 | begin 58 | fRequestArgument.Free; 59 | fRequestArgument := nil; 60 | end; 61 | 62 | procedure TcaRequestArgumentTest.ClassOneValue; 63 | var 64 | lParams: TArray; 65 | lVal: TOnePairClass; 66 | begin 67 | lVal := TOnePairClass.GetValue; 68 | try 69 | lParams := fRequestArgument.ObjToParams(lVal); 70 | Assert.IsNotNull(lParams); 71 | Assert.AreEqual(1, Length(lParams)); 72 | Assert.AreEqual(lParams[0].Name, 'key'); 73 | Assert.AreEqual(lParams[0].ValueAsString, 'Value'); 74 | finally 75 | lVal.Free; 76 | end; 77 | end; 78 | 79 | procedure TcaRequestArgumentTest.ClassTwoValue; 80 | var 81 | lParams: TArray; 82 | lVal: TTwoPairClass; 83 | begin 84 | lVal := TTwoPairClass.GetValue; 85 | try 86 | lParams := fRequestArgument.ObjToParams(lVal); 87 | Assert.IsNotNull(lParams); 88 | Assert.AreEqual(2, Length(lParams)); 89 | Assert.AreEqual(lParams[0].Name, 'key2'); 90 | Assert.AreEqual(lParams[0].ValueAsString, 'Value'); 91 | Assert.AreEqual(lParams[1].Name, 'key1'); 92 | Assert.AreEqual(lParams[1].ValueAsString, '1'); 93 | finally 94 | lVal.Free; 95 | end; 96 | end; 97 | 98 | procedure TcaRequestArgumentTest.RecordOneValue; 99 | var 100 | lParams: TArray; 101 | lVal: TOnePairRecord; 102 | begin 103 | lVal := TOnePairRecord.GetValue; 104 | lParams := fRequestArgument.ObjToParams(lVal); 105 | Assert.IsNotNull(lParams); 106 | Assert.AreEqual(lParams[0].Name, 'key'); 107 | Assert.AreEqual(lParams[0].ValueAsString, 'Value'); 108 | end; 109 | 110 | initialization 111 | 112 | TDUnitX.RegisterTestFixture(TcaRequestArgumentTest); 113 | 114 | end. 115 | -------------------------------------------------------------------------------- /Tests/UntiTests/RequestLimitManagerTest.pas: -------------------------------------------------------------------------------- 1 | unit RequestLimitManagerTest; 2 | 3 | interface 4 | 5 | uses 6 | CloudApi.Ext.MethodLimits, 7 | DUnitX.TestFramework; 8 | 9 | type 10 | 11 | [TestFixture] 12 | TRequestLimitManagerTest = class 13 | strict private 14 | FLimitMng: TcaRequestLimitManager; 15 | private 16 | 17 | public 18 | [Setup] 19 | procedure Setup; 20 | [TearDown] 21 | procedure TearDown; 22 | [Test] 23 | procedure LocalLimit; 24 | [Test] 25 | procedure GlobalLimit; 26 | end; 27 | 28 | implementation 29 | 30 | uses 31 | System.SysUtils; 32 | 33 | procedure TRequestLimitManagerTest.GlobalLimit; 34 | const 35 | LIMIT_NAME = 'GLOBAL'; 36 | var 37 | LLimit: Int64; 38 | begin 39 | FLimitMng.Add(1000, LIMIT_NAME, True); 40 | LLimit := FLimitMng.GlobalWait(); 41 | Assert.IsTrue(LLimit > 900); 42 | sleep(500); 43 | LLimit := FLimitMng.GlobalWait; 44 | Assert.IsTrue(LLimit < 500); 45 | 46 | end; 47 | 48 | procedure TRequestLimitManagerTest.LocalLimit; 49 | const 50 | LIMIT_NAME = 'loc_lim_1000'; 51 | var 52 | LLimit: Int64; 53 | begin 54 | FLimitMng.Add(1000, LIMIT_NAME, False); 55 | LLimit := FLimitMng.LocalWait(LIMIT_NAME); 56 | Assert.IsTrue(LLimit > 900); 57 | sleep(500); 58 | LLimit := FLimitMng.LocalWait(LIMIT_NAME); 59 | Assert.IsTrue(LLimit < 500); 60 | end; 61 | 62 | procedure TRequestLimitManagerTest.Setup; 63 | begin 64 | FLimitMng := TcaRequestLimitManager.Create; 65 | end; 66 | 67 | procedure TRequestLimitManagerTest.TearDown; 68 | begin 69 | FLimitMng.Free; 70 | end; 71 | 72 | initialization 73 | 74 | TDUnitX.RegisterTestFixture(TRequestLimitManagerTest); 75 | 76 | end. 77 | --------------------------------------------------------------------------------