diff --git a/Quick.CloudStorage.Provider.Amazon.pas b/Quick.CloudStorage.Provider.Amazon.pas new file mode 100644 index 0000000..d635970 --- /dev/null +++ b/Quick.CloudStorage.Provider.Amazon.pas @@ -0,0 +1,145 @@ +unit Quick.CloudStorage.Provider.Amazon; + +interface + +uses + Classes, + System.SysUtils, + Quick.Commons, + Quick.CloudStorage, + Quick.Amazon; + +type + + TCloudStorageAmazonProvider = class(TCloudStorageProvider) + private + fAmazon : TQuickAmazon; + fAmazonID : string; + fAmazonKey: string; + fAmazonRegion : string; + fSecure : Boolean; + fCurrentBuckeet: string; + procedure SetSecure(const Value: Boolean); + public + constructor Create; overload; + constructor Create(const aAccountID, aAccountKey, aAWSRegion : string); overload; + destructor Destroy; override; + property Secure : Boolean read fSecure write SetSecure; + procedure OpenDir(const aPath : string); override; + function GetFile(const aPath: string; out stream : TStream) : Boolean; override; + end; + +implementation + +{ TCloudExplorerProvider } + +constructor TCloudStorageAmazonProvider.Create; +begin + fAmazon := TQuickAmazon.Create; + fAmazon.AmazonProtocol := amHTTPS; +end; + +constructor TCloudStorageAmazonProvider.Create(const aAccountID, aAccountKey, aAWSRegion : string); +begin + Create; + fAmazonID := aAccountID; + fAmazonKey := aAccountKey; + fAmazonRegion := aAWSRegion; + fAmazon.AccountName := fAmazonID; + fAmazon.AccountKey := fAmazonKey; + fAmazon.AWSRegion := TQuickAmazon.GetAWSRegion(fAmazonRegion); +end; + +destructor TCloudStorageAmazonProvider.Destroy; +begin + if Assigned(fAmazon) then fAmazon.Free; + inherited; +end; + +function TCloudStorageAmazonProvider.GetFile(const aPath: string; out stream : TStream) : Boolean; +begin + +end; + +procedure TCloudStorageAmazonProvider.OpenDir(const aPath : string); +var + lista : TAmazonObjects; + Blob : TAmazonObject; + i : Integer; + azurefilter : string; + DirItem : TCloudItem; + respinfo : TAmazonResponseInfo; +begin + if aPath = '..' then + begin + CurrentPath := RemoveLastPathSegment(CurrentPath); + end + else + begin + if CurrentPath = '' then CurrentPath := aPath + else CurrentPath := CurrentPath + aPath; + end; + if Assigned(OnBeginReadDir) then OnBeginReadDir(CurrentPath); + if CurrentPath.StartsWith('/') then CurrentPath := Copy(CurrentPath,2,CurrentPath.Length); + if (not CurrentPath.IsEmpty) and (not CurrentPath.EndsWith('/')) then CurrentPath := CurrentPath + '/'; + + Status := stRetrieving; + lista := fAmazon.ListObjects(RootFolder,CurrentPath,fAmazon.AWSRegion,respinfo); + try + if CurrentPath <> '' then + begin + if Assigned(OnGetListItem) then + begin + DirItem := TCloudItem.Create; + try + DirItem.Name := '..'; + DirItem.IsDir := True; + DirItem.Date := 0; + OnGetListItem(DirItem); + finally + DirItem.Free; + end; + end; + end; + + if respinfo.StatusCode = 200 then + begin + for Blob in lista do + begin + DirItem := TCloudItem.Create; + try + if Blob.Name.StartsWith(CurrentPath) then Blob.Name := StringReplace(Blob.Name,CurrentPath,'',[]); + if Blob.Name.Contains('/') then + begin + DirItem.IsDir := True; + DirItem.Name := Copy(Blob.Name,1,Blob.Name.IndexOf('/')); + end + else + begin + DirItem.IsDir := False; + DirItem.Name := Blob.Name; + DirItem.Size := Blob.Size; + DirItem.Date := Blob.Modified; + end; + if Assigned(OnGetListItem) then OnGetListItem(DirItem); + finally + DirItem.Free; + end; + end; + Status := stDone; + end + else Status := stFailed; + finally + lista.Free; + ResponseInfo.Get(respinfo.StatusCode,respinfo.StatusMsg); + end; +end; + +procedure TCloudStorageAmazonProvider.SetSecure(const Value: Boolean); +begin + fSecure := Value; + if Value then fAmazon.AmazonProtocol := TAmazonProtocol.amHTTPS + else fAmazon.AmazonProtocol := TAmazonProtocol.amHTTP; +end; + +end. diff --git a/Quick.CloudStorage.Provider.Azure.pas b/Quick.CloudStorage.Provider.Azure.pas new file mode 100644 index 0000000..759fbcb --- /dev/null +++ b/Quick.CloudStorage.Provider.Azure.pas @@ -0,0 +1,340 @@ +unit Quick.CloudStorage.Provider.Azure; + +interface + +uses + Classes, + System.SysUtils, + System.Generics.Collections, + Quick.Commons, + Quick.CloudStorage, + IPPeerClient, + Data.Cloud.CloudAPI, + Data.Cloud.AzureAPI; + +type + + TCloudStorageAzureProvider = class(TCloudStorageProvider) + private + fAzureConnection : TAzureConnectionInfo; + fAzureID : string; + fAzureKey : string; + procedure SetSecure(aValue: Boolean); override; + function ListContainers(azContainersStartWith : string; azResponseInfo : TResponseInfo) : TStrings; + public + constructor Create; overload; override; + constructor Create(const aAccountName, aAccountKey : string); overload; + destructor Destroy; override; + function GetRootFolders : TStrings; override; + procedure OpenDir(const aPath : string); override; + function GetFile(const aPath: string; out stream : TStream) : Boolean; override; + function GetURL(const aPath : string) : string; override; + end; + +implementation + +{ TCloudExplorerProvider } + +constructor TCloudStorageAzureProvider.Create; +begin + fAzureConnection := TAzureConnectionInfo.Create(nil); +end; + +constructor TCloudStorageAzureProvider.Create(const aAccountName, aAccountKey : string); +begin + inherited Create; + Create; + fAzureID := aAccountName; + fAzureKey := aAccountKey; + fAzureConnection.AccountName := aAccountName; + fAzureConnection.AccountKey := aAccountKey; +end; + +destructor TCloudStorageAzureProvider.Destroy; +begin + if Assigned(fAzureConnection) then fAzureConnection.Free; + inherited; +end; + +function TCloudStorageAzureProvider.GetFile(const aPath: string; out stream : TStream) : Boolean; +var + BlobService : TAzureBlobService; + CloudResponseInfo : TCloudResponseInfo; +begin + BlobService := TAzureBlobService.Create(fAzureConnection); + try + CloudResponseInfo := TCloudResponseInfo.Create; + try + Result := BlobService.GetBlob(RootFolder,aPath,stream,'',CloudResponseInfo); + if not Result then raise Exception.CreateFmt('Cloud error %d : %s',[CloudResponseInfo.StatusCode,CloudResponseInfo.StatusMessage]); + finally + CloudResponseInfo.Free; + end; + finally + BlobService.Free; + end; +end; + +function TCloudStorageAzureProvider.GetRootFolders: TStrings; +var + respinfo : TResponseInfo; +begin + Result := ListContainers('',respinfo); +end; + +function TCloudStorageAzureProvider.GetURL(const aPath: string): string; +begin + Result := Format('https://%s.blob.core.windows.net/%s/%s',[fAzureConnection.AccountName,RootFolder,aPath]); +end; + +function TCloudStorageAzureProvider.ListContainers(azContainersStartWith : string; azResponseInfo : TResponseInfo) : TStrings; +var + BlobService : TAzureBlobService; + CloudResponseInfo : TCloudResponseInfo; + cNextMarker : string; + AzParams : TStrings; + AzContainer : TAzureContainer; + AzContainers : TList; +begin + Result := TStringList.Create; + cNextMarker := ''; + BlobService := TAzureBlobService.Create(fAzureConnection); + CloudResponseInfo := TCloudResponseInfo.Create; + try + BlobService.Timeout := Timeout; + repeat + AzParams := TStringList.Create; + try + if azContainersStartWith <> '' then AzParams.Values['prefix'] := azContainersStartWith; + if cNextMarker <> '' then AzParams.Values['marker'] := cNextMarker; + AzContainers := BlobService.ListContainers(cNextMarker,AzParams,CloudResponseInfo); + try + azResponseInfo.Get(CloudResponseInfo); + if (azResponseInfo.StatusCode = 200) and (Assigned(AzContainers)) then + begin + for AzContainer in AzContainers do + begin + Result.Add(AzContainer.Name); + end; + end; + finally + if Assigned(AzContainer) then + begin + //frees ContainerList objects + for AzContainer in AzContainers do AzContainer.Free; + AzContainers.Free; + end; + end; + finally + AzParams.Free; + end; + until (cNextMarker = '') or (azResponseInfo.StatusCode <> 200); + finally + BlobService.Free; + CloudResponseInfo.Free; + end; +end; + +procedure TCloudStorageAzureProvider.OpenDir(const aPath: string); +var + BlobService : TAzureBlobService; + azBlob : TAzureBlob; + azBlobList : TList; + DirItem : TCloudItem; + CloudResponseInfo : TCloudResponseInfo; + cNextMarker : string; + AzParams : TStrings; + azResponseInfo : TResponseInfo; + azContainer : string; +begin + Status := stSearching; + cNextMarker := ''; + if aPath = '..' then + begin + CurrentPath := RemoveLastPathSegment(CurrentPath); + end + else + begin + if (CurrentPath = '') or (aPath.StartsWith('/')) then CurrentPath := aPath + else CurrentPath := CurrentPath + aPath; + end; + if Assigned(OnBeginReadDir) then OnBeginReadDir(CurrentPath); + if CurrentPath.StartsWith('/') then CurrentPath := Copy(CurrentPath,2,CurrentPath.Length); + if (not CurrentPath.IsEmpty) and (not CurrentPath.EndsWith('/')) then CurrentPath := CurrentPath + '/'; + + azContainer := RootFolder; + if azContainer = '' then azContainer := '$root'; + BlobService := TAzureBlobService.Create(fAzureConnection); + try + BlobService.Timeout := Timeout; + Status := stRetrieving; + if Assigned(OnGetListItem) then + begin + DirItem := TCloudItem.Create; + try + DirItem.Name := '..'; + DirItem.IsDir := True; + DirItem.Date := 0; + OnGetListItem(DirItem); + finally + DirItem.Free; + end; + end; + repeat + if not (Status in [stSearching,stRetrieving]) then Exit; + AzParams := TStringList.Create; + try + if fCancelOperation then + begin + fCancelOperation := False; + Exit; + end; + AzParams.Values['prefix'] := CurrentPath; + //if not Recursive then + AzParams.Values['delimiter'] := '/'; + AzParams.Values['maxresults'] := '100'; + if cNextMarker <> '' then AzParams.Values['marker'] := cNextMarker; + CloudResponseInfo := TCloudResponseInfo.Create; + try + azBlobList := BlobService.ListBlobs(azContainer,cNextMarker,AzParams,CloudResponseInfo); + azResponseInfo.Get(CloudResponseInfo); + if azResponseInfo.StatusCode = 200 then + begin + try + for azBlob in azBlobList do + begin + if not (Status in [stSearching,stRetrieving]) then Exit; + if fCancelOperation then + begin + fCancelOperation := False; + Exit; + end; + DirItem := TCloudItem.Create; + try + DirItem.Name := azBlob.Name; + if DirItem.Name.StartsWith(CurrentPath) then DirItem.Name := StringReplace(DirItem.Name,CurrentPath,'',[]); + if DirItem.Name.Contains('/') then + begin + DirItem.IsDir := True; + DirItem.Name := Copy(DirItem.Name,1,DirItem.Name.IndexOf('/')); + end + else + begin + DirItem.IsDir := False; + DirItem.Size := StrToInt64Def(azBlob.Properties.Values['Content-Length'],0); + DirItem.Date := GMT2DateTime(azBlob.Properties.Values['Last-Modified']); + end; + if Assigned(OnGetListItem) then OnGetListItem(DirItem); + finally + DirItem.Free; + end; + azBlob.Free; + end; + finally + //frees azbloblist objects + //for azBlob in azBlobList do azBlob.Free; + azBlobList.Free; + end; + end + else + begin + Status := stFailed; + Exit; + end; + finally + CloudResponseInfo.Free; + end; + finally + FreeAndNil(AzParams); + end; + if Assigned(OnRefreshReadDir) then OnRefreshReadDir(CurrentPath); + until (cNextMarker = '') or (azResponseInfo.StatusCode <> 200); + Status := stDone; + finally + BlobService.Free; + if Assigned(OnEndReadDir) then OnEndReadDir(CurrentPath); + end; +end; + +{procedure TCloudStorageAzureProvider.OpenDir(const aPath : string); +var + lista : TBlobList; + Blob : TAzureBlobObject; + i : Integer; + azurefilter : string; + DirItem : TCloudItem; + respinfo : TAzureResponseInfo; +begin + if aPath = '..' then + begin + CurrentPath := RemoveLastPathSegment(CurrentPath); + end + else + begin + if CurrentPath = '' then CurrentPath := aPath + else CurrentPath := CurrentPath + aPath; + end; + if Assigned(OnBeginReadDir) then OnBeginReadDir(CurrentPath); + if CurrentPath.StartsWith('/') then CurrentPath := Copy(CurrentPath,2,CurrentPath.Length); + if (not CurrentPath.IsEmpty) and (not CurrentPath.EndsWith('/')) then CurrentPath := CurrentPath + '/'; + + Status := stRetrieving; + lista := fAzure.ListBlobs(RootFolder,CurrentPath,False,respinfo); + try + if Assigned(lista) then + begin + if Assigned(OnGetListItem) then + begin + DirItem := TCloudItem.Create; + try + DirItem.Name := '..'; + DirItem.IsDir := True; + DirItem.Date := 0; + OnGetListItem(DirItem); + finally + DirItem.Free; + end; + end; + end; + + if respinfo.StatusCode = 200 then + begin + for Blob in lista do + begin + DirItem := TCloudItem.Create; + try + if Blob.Name.StartsWith(CurrentPath) then Blob.Name := StringReplace(Blob.Name,CurrentPath,'',[]); + if Blob.Name.Contains('/') then + begin + DirItem.IsDir := True; + DirItem.Name := Copy(Blob.Name,1,Blob.Name.IndexOf('/')); + end + else + begin + DirItem.IsDir := False; + DirItem.Name := Blob.Name; + DirItem.Size := Blob.Size; + DirItem.Date := Blob.LastModified; + end; + if Assigned(OnGetListItem) then OnGetListItem(DirItem); + finally + DirItem.Free; + end; + end; + Status := stDone; + end + else Status := stFailed; + finally + lista.Free; + ResponseInfo.Get(respinfo.StatusCode,respinfo.StatusMsg); + end; +end;} + +procedure TCloudStorageAzureProvider.SetSecure(aValue: Boolean); +begin + inherited; + if aValue then fAzureConnection.Protocol := 'HTTPS' + else fAzureConnection.Protocol := 'HTTP'; +end; + +end. diff --git a/Quick.CloudStorage.pas b/Quick.CloudStorage.pas new file mode 100644 index 0000000..15aa67c --- /dev/null +++ b/Quick.CloudStorage.pas @@ -0,0 +1,256 @@ +unit Quick.CloudStorage; + +interface + +uses + Classes, + System.SysUtils, + System.Generics.Collections, + Data.Cloud.CloudAPI; + +type + + TCloudActionStatus = (stNone, stSearching, stRetrieving, stDone, stFailed); + + TCloudProtocol = (cpHTTP,cpHTTPS); + + TResponseInfo = record + StatusCode : Integer; + StatusMsg : string; + procedure Get(aStatusCode : Integer; const aStatusMsg : string); overload; + procedure Get(aCloudResponseInfo : TCloudResponseInfo); overload; + end; + + TCloudItem = class + private + fName : string; + fIsDir : Boolean; + fSize : Int64; + fDate : TDateTime; + public + property Name : string read fName write fName; + property IsDir : Boolean read fIsDir write fIsDir; + property Size : Int64 read fSize write fSize; + property Date : TDateTime read fDate write fDate; + end; + + TCloudItemList = TObjectList; + + TReadDirEvent = procedure(const aDir : string) of object; + TGetListItemEvent = procedure(aItem : TCloudItem) of object; + TChangeStatusEvent = procedure(aStatus : TCloudActionStatus) of object; + + ICloudStorage = interface + ['{5F36CD88-405F-45C1-89E0-9114146CA8D9}'] + function GetName : string; + function GetRootFolders : TStrings; + procedure OpenDir(const aPath : string); + function GetFile(const aSourcePath: string; out stream : TStream) : Boolean; overload; + function GetFile(const aSourcePath, aTargetLocalFile : string) : Boolean; overload; + function GetURL(const aPath : string) : string; + end; + + TCloudPermissions = class + private + fCanList : Boolean; + fCanRead : Boolean; + fCanWrite : Boolean; + fCanDelete : Boolean; + public + property CanList : Boolean read fCanList write fCanList; + property CanRead : Boolean read fCanRead write fCanRead; + property CanWrite : Boolean read fCanWrite write fCanWrite; + property CanDelete : Boolean read fCanDelete write fCanDelete; + end; + + TCloudStorageProvider = class(TInterfacedObject,ICloudStorage) + private + fName : string; + fResponseInfo : TResponseInfo; + fCurrentPath : string; + fOnGetListItem : TGetListItemEvent; + fOnBeginReadDir : TReadDirEvent; + fOnRefresReadDir : TReadDirEvent; + fOnEndReadDir : TReadDirEvent; + fOnChangeStatus : TChangeStatusEvent; + fStatus: TCloudActionStatus; + fRootFolder : string; + fTimeout : Integer; + fSecure : Boolean; + fPermissions : TCloudPermissions; + procedure SetStatus(aStatus : TCloudActionStatus); + protected + fCancelOperation : Boolean; + procedure SetSecure(aValue : Boolean); virtual; + function GMT2DateTime(const gmtdate : string):TDateTime; + public + constructor Create; virtual; + destructor Destroy; override; + property Name : string read fName write fName; + property ResponseInfo : TResponseInfo read fResponseInfo write fResponseInfo; + property Timeout : Integer read fTimeout write fTimeout; + property CurrentPath : string read fCurrentPath write fCurrentPath; + property RootFolder : string read fRootFolder write fRootFolder; + property OnBeginReadDir : TReadDirEvent read fOnBeginReadDir write fOnBeginReadDir; + property OnRefreshReadDir : TReadDirEvent read fOnRefresReadDir write fOnRefresReadDir; + property OnEndReadDir : TReadDirEvent read fOnEndReadDir write fOnEndReadDir; + property OnGetListItem : TGetListItemEvent read fOnGetListItem write fOnGetListItem; + property Status : TCloudActionStatus read fStatus write SetStatus; + property Secure : Boolean read fSecure write SetSecure; + property OnChangeStatus : TChangeStatusEvent read fOnChangeStatus write fOnChangeStatus; + property Permissions : TCloudPermissions read fPermissions write fPermissions; + class function GetStatusStr(aStatus : TCloudActionStatus) : string; + function GetName : string; + function GetRootFolders : TStrings; virtual; abstract; + procedure OpenDir(const aPath : string); virtual; abstract; + function GetFile(const aPath: string; out stream : TStream) : Boolean; overload; virtual; abstract; + function GetFile(const aSourcePath, aTargetLocalFile : string) : Boolean; overload; virtual; + function GetURL(const aPath : string) : string; virtual; abstract; + end; + +implementation + +const + CloudActionStatusStr : array of string = ['','Searching...','Retrieving...','Done','Failed']; + +constructor TCloudStorageProvider.Create; +begin + fCancelOperation := False; + fPermissions := TCloudPermissions.Create; + fTimeout := 30; + fSecure := True; + fPermissions.CanList := True; + fPermissions.CanRead := True; + fPermissions.CanWrite := True; + fPermissions.CanDelete := True; +end; + +destructor TCloudStorageProvider.Destroy; +begin + if Assigned(fPermissions) then fPermissions.Free; + inherited; +end; + +function TCloudStorageProvider.GetFile(const aSourcePath, aTargetLocalFile: string): Boolean; +var + stream : TStream; +begin + stream := TFileStream.Create(aTargetLocalFile,fmCreate); + try + Result := GetFile(aSourcePath,stream); + finally + stream.Free; + end; +end; + +function TCloudStorageProvider.GetName: string; +begin + Result := fName; +end; + +class function TCloudStorageProvider.GetStatusStr(aStatus: TCloudActionStatus): string; +begin + Result := CloudActionStatusStr[Integer(aStatus)]; +end; + +function TCloudStorageProvider.GMT2DateTime(const gmtdate: string): TDateTime; + function GetMonthDig(Value : string):Integer; + const + aMonth : array[1..12] of string = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec'); + var + idx : Integer; + begin + Result := 0; + for idx := 1 to 12 do + begin + if CompareText(Value,aMonth[idx]) = 0 then + begin + Result := idx; + Break; + end; + end; + end; +var + i : Integer; + Len : Integer; + wDay, wMonth, wYear, + wHour, wMinute, wSec : Word; +begin + //GMT Format: 'Mon, 12 Jan 2014 16:20:35 GMT' + Result := 0; + Len := 0; + if gmtdate = '' then Exit; + + try + for i := 0 to Length(gmtdate) do + begin + if gmtdate[i] in ['0'..'9'] then + begin + Len := i; + Break; + end; + end; + + //Day + wDay := StrToIntDef(Copy(gmtdate,Len,2),0); + if wDay = 0 then Exit; + + Inc(Len,3); + + //Month + wMonth := GetMonthDig(Copy(gmtdate,Len,3)); + if wMonth = 0 then Exit; + Inc(Len,4); + + //Year + wYear := StrToIntDef(Copy(gmtdate,Len,4),0); + if wYear = 0 then Exit; + Inc(Len,5); + + //Hour + wHour := StrToIntDef(Copy(gmtdate,Len,2),99); + if wHour = 99 then Exit; + Inc(Len,3); + + //Min + wMinute := StrToIntDef(Copy(gmtdate,Len,2),99); + if wMinute = 99 then Exit; + Inc(Len,3); + + //Sec + wSec := StrToIntDef(Copy(gmtdate,Len,2),99); + if wSec = 99 then Exit; + + Result := EncodeDate(wYear,wMonth,wDay) + EncodeTime(wHour,wMinute,wSec,0); + except + Result := 0; + end; +end; + +procedure TCloudStorageProvider.SetSecure(aValue: Boolean); +begin + fSecure := aValue; +end; + +procedure TCloudStorageProvider.SetStatus(aStatus: TCloudActionStatus); +begin + fStatus := aStatus; + if Assigned(fOnChangeStatus) then fOnChangeStatus(aStatus); +end; + + +{ TResponseInfo } + +procedure TResponseInfo.Get(aStatusCode: Integer; const aStatusMsg: string); +begin + Self.StatusCode := aStatusCode; + Self.StatusMsg := aStatusMsg; +end; + +procedure TResponseInfo.Get(aCloudResponseInfo : TCloudResponseInfo); +begin + Self.StatusCode := aCloudResponseInfo.StatusCode; + Self.StatusMsg := aCloudResponseInfo.StatusMessage; +end; + +end. diff --git a/Quick.Crypto.pas b/Quick.Crypto.pas new file mode 100644 index 0000000..a385c7d --- /dev/null +++ b/Quick.Crypto.pas @@ -0,0 +1,198 @@ +{ *************************************************************************** + + Copyright (c) 2016-2017 Kike Pérez + + Unit : Quick.Crypto + Description : Cryptography utils + Author : Kike Pérez + Version : 1.19 + Created : 15/10/2017 + Modified : 08/11/2017 + + This file is part of QuickLib: https://github.com/exilon/QuickLib + + *************************************************************************** + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. + + *************************************************************************** } +unit Quick.Crypto; + +interface + +uses + +function AES128_Encrypt(Value, Password: string): string; +function AES128_Decrypt(Value, Password: string): string; + +implementation + +uses + SysUtils, Windows, IdCoderMIME, IdGlobal; + +//------------------------------------------------------------------------------------------------------------------------- +// Base64 Encode/Decode +//------------------------------------------------------------------------------------------------------------------------- + +function Base64_Encode(Value: TBytes): string; +var + Encoder: TIdEncoderMIME; +begin + Encoder := TIdEncoderMIME.Create(nil); + try + Result := Encoder.EncodeBytes(TIdBytes(Value)); + finally + Encoder.Free; + end; +end; + +function Base64_Decode(Value: string): TBytes; +var + Encoder: TIdDecoderMIME; +begin + Encoder := TIdDecoderMIME.Create(nil); + try + Result := TBytes(Encoder.DecodeBytes(Value)); + finally + Encoder.Free; + end; +end; + +//------------------------------------------------------------------------------------------------------------------------- +// WinCrypt.h +//------------------------------------------------------------------------------------------------------------------------- + +type + HCRYPTPROV = Cardinal; + HCRYPTKEY = Cardinal; + ALG_ID = Cardinal; + HCRYPTHASH = Cardinal; + +const + _lib_ADVAPI32 = 'ADVAPI32.dll'; + CALG_SHA_256 = 32780; + CALG_AES_128 = 26126; + CRYPT_NEWKEYSET = $00000008; + PROV_RSA_AES = 24; + KP_MODE = 4; + CRYPT_MODE_CBC = 1; + +function CryptAcquireContext(var Prov: HCRYPTPROV; Container: PChar; Provider: PChar; ProvType: LongWord; Flags: LongWord): LongBool; stdcall; external _lib_ADVAPI32 name 'CryptAcquireContextW'; +function CryptDeriveKey(Prov: HCRYPTPROV; Algid: ALG_ID; BaseData: HCRYPTHASH; Flags: LongWord; var Key: HCRYPTKEY): LongBool; stdcall; external _lib_ADVAPI32 name 'CryptDeriveKey'; +function CryptSetKeyParam(hKey: HCRYPTKEY; dwParam: LongInt; pbData: PBYTE; dwFlags: LongInt): LongBool stdcall; stdcall; external _lib_ADVAPI32 name 'CryptSetKeyParam'; +function CryptEncrypt(Key: HCRYPTKEY; Hash: HCRYPTHASH; Final: LongBool; Flags: LongWord; pbData: PBYTE; var Len: LongInt; BufLen: LongInt): LongBool;stdcall;external _lib_ADVAPI32 name 'CryptEncrypt'; +function CryptDecrypt(Key: HCRYPTKEY; Hash: HCRYPTHASH; Final: LongBool; Flags: LongWord; pbData: PBYTE; var Len: LongInt): LongBool; stdcall; external _lib_ADVAPI32 name 'CryptDecrypt'; +function CryptCreateHash(Prov: HCRYPTPROV; Algid: ALG_ID; Key: HCRYPTKEY; Flags: LongWord; var Hash: HCRYPTHASH): LongBool; stdcall; external _lib_ADVAPI32 name 'CryptCreateHash'; +function CryptHashData(Hash: HCRYPTHASH; Data: PChar; DataLen: LongWord; Flags: LongWord): LongBool; stdcall; external _lib_ADVAPI32 name 'CryptHashData'; +function CryptReleaseContext(hProv: HCRYPTPROV; dwFlags: LongWord): LongBool; stdcall; external _lib_ADVAPI32 name 'CryptReleaseContext'; +function CryptDestroyHash(hHash: HCRYPTHASH): LongBool; stdcall; external _lib_ADVAPI32 name 'CryptDestroyHash'; +function CryptDestroyKey(hKey: HCRYPTKEY): LongBool; stdcall; external _lib_ADVAPI32 name 'CryptDestroyKey'; + +//------------------------------------------------------------------------------------------------------------------------- + +{$WARN SYMBOL_PLATFORM OFF} + +function __CryptAcquireContext(ProviderType: Integer): HCRYPTPROV; +begin + if (not CryptAcquireContext(Result, nil, nil, ProviderType, 0)) then + begin + if HRESULT(GetLastError) = NTE_BAD_KEYSET then + Win32Check(CryptAcquireContext(Result, nil, nil, ProviderType, CRYPT_NEWKEYSET)) + else + RaiseLastOSError; + end; +end; + +function __AES128_DeriveKeyFromPassword(m_hProv: HCRYPTPROV; Password: string): HCRYPTKEY; +var + hHash: HCRYPTHASH; + Mode: DWORD; +begin + Win32Check(CryptCreateHash(m_hProv, CALG_SHA_256, 0, 0, hHash)); + try + Win32Check(CryptHashData(hHash, PChar(Password), Length(Password) * SizeOf(Char), 0)); + Win32Check(CryptDeriveKey(m_hProv, CALG_AES_128, hHash, 0, Result)); + // Wine uses a different default mode of CRYPT_MODE_EBC + Mode := CRYPT_MODE_CBC; + Win32Check(CryptSetKeyParam(Result, KP_MODE, Pointer(@Mode), 0)); + finally + CryptDestroyHash(hHash); + end; +end; + +function AES128_Encrypt(Value, Password: string): string; +var + hCProv: HCRYPTPROV; + hKey: HCRYPTKEY; + lul_datalen: Integer; + lul_buflen: Integer; + Buffer: TBytes; +begin + Assert(Password <> ''); + if (Value = '') then + Result := '' + else begin + hCProv := __CryptAcquireContext(PROV_RSA_AES); + try + hKey := __AES128_DeriveKeyFromPassword(hCProv, Password); + try + // allocate buffer space + lul_datalen := Length(Value) * SizeOf(Char); + Buffer := TEncoding.Unicode.GetBytes(Value + ' '); + lul_buflen := Length(Buffer); + // encrypt to buffer + Win32Check(CryptEncrypt(hKey, 0, True, 0, @Buffer[0], lul_datalen, lul_buflen)); + SetLength(Buffer, lul_datalen); + // base 64 result + Result := Base64_Encode(Buffer); + finally + CryptDestroyKey(hKey); + end; + finally + CryptReleaseContext(hCProv, 0); + end; + end; +end; + +function AES128_Decrypt(Value, Password: string): string; +var + hCProv: HCRYPTPROV; + hKey: HCRYPTKEY; + lul_datalen: Integer; + Buffer: TBytes; +begin + Assert(Password <> ''); + if Value = '' then + Result := '' + else begin + hCProv := __CryptAcquireContext(PROV_RSA_AES); + try + hKey := __AES128_DeriveKeyFromPassword(hCProv, Password); + try + // decode base64 + Buffer := Base64_Decode(Value); + // allocate buffer space + lul_datalen := Length(Buffer); + // decrypt buffer to to string + Win32Check(CryptDecrypt(hKey, 0, True, 0, @Buffer[0], lul_datalen)); + Result := TEncoding.Unicode.GetString(Buffer, 0, lul_datalen); + finally + CryptDestroyKey(hKey); + end; + finally + CryptReleaseContext(hCProv, 0); + end; + end; +end; + +end. diff --git a/Quick.Threads.pas b/Quick.Threads.pas index 892df51..d6cf108 100644 --- a/Quick.Threads.pas +++ b/Quick.Threads.pas @@ -7,7 +7,7 @@ Author : Kike Pérez Version : 1.2 Created : 09/03/2018 - Modified : 07/04/2018 + Modified : 19/12/2018 This file is part of QuickLib: https://github.com/exilon/QuickLib @@ -36,6 +36,7 @@ interface uses Classes, Types, + SysUtils, //Quick.Chrono, {$IFNDEF FPC} System.RTLConsts, @@ -44,8 +45,7 @@ interface {$ELSE} RtlConsts, Generics.Collections, - syncobjs, - SysUtils; + syncobjs; {$ENDIF} type @@ -157,6 +157,27 @@ TThreadObjectList = class(TList) end; {$ENDIF} + {$IFDEF FPC} + TProc = procedure of object; + {$ENDIF} + + IAnonymousThread = interface + procedure Start; + function OnTerminate(aProc : TProc) : IAnonymousThread; + end; + + TAnonymousThread = class(TInterfacedObject,IAnonymousThread) + private + fThread : TThread; + fTerminateProc : TProc; + constructor Create(aProc : TProc); + procedure NotifyTerminate(Sender : TObject); + public + class function Execute(aProc : TProc) : IAnonymousThread; + procedure Start; + function OnTerminate(aProc : TProc) : IAnonymousThread; + end; + implementation { TThreadedQueueCS } @@ -634,4 +655,33 @@ procedure TThreadObjectList.UnlockList; end; {$ENDIF} +{ TThreadEx } + +constructor TAnonymousThread.Create(aProc : TProc); +begin + fThread := TThread.CreateAnonymousThread(@aProc); +end; + +class function TAnonymousThread.Execute(aProc: TProc): IAnonymousThread; +begin + Result := TAnonymousThread.Create(aProc); +end; + +procedure TAnonymousThread.NotifyTerminate(Sender: TObject); +begin + fTerminateProc; +end; + +function TAnonymousThread.OnTerminate(aProc: TProc): IAnonymousThread; +begin + Result := Self; + fTerminateProc := aProc; + fThread.OnTerminate := Self.NotifyTerminate; +end; + +procedure TAnonymousThread.Start; +begin + fThread.Start; +end; + end. diff --git a/samples/firemonkey/QuickAutoMapper/Android/Debug/AutoMapperObjects/library/lib/armeabi-v7a/gdbserver b/samples/firemonkey/QuickAutoMapper/Android/Debug/AutoMapperObjects/library/lib/armeabi-v7a/gdbserver new file mode 100644 index 0000000..b5a5c60 Binary files /dev/null and b/samples/firemonkey/QuickAutoMapper/Android/Debug/AutoMapperObjects/library/lib/armeabi-v7a/gdbserver differ diff --git a/samples/firemonkey/QuickAutoMapper/AndroidManifest.template.xml b/samples/firemonkey/QuickAutoMapper/AndroidManifest.template.xml new file mode 100644 index 0000000..b593684 --- /dev/null +++ b/samples/firemonkey/QuickAutoMapper/AndroidManifest.template.xml @@ -0,0 +1,42 @@ + + + + + + +<%uses-permission%> + + + +<%application-meta-data%> + <%services%> + + + + + + + + + + <%activity%> + <%receivers%> + + + diff --git a/samples/firemonkey/QuickAutoMapper/AutoMapperObjects.deployproj b/samples/firemonkey/QuickAutoMapper/AutoMapperObjects.deployproj new file mode 100644 index 0000000..65572fd --- /dev/null +++ b/samples/firemonkey/QuickAutoMapper/AutoMapperObjects.deployproj @@ -0,0 +1,241 @@ + + + + 12 + + + emulator-5554 + + + iPhone5 + + + + + + + AutoMapperObjects\ + AutoMapperObjects.exe + ProjectOutput + 0 + + + True + True + + + + + AutoMapperObjects.app\Contents\MacOS\ + libcgsqlite3.dylib + DependencyModule + 1 + + + True + + + AutoMapperObjects.app\Contents\MacOS\ + libcgunwind.1.0.dylib + DependencyModule + 1 + + + True + + + + + AutoMapperObjects\res\drawable-ldpi\ + ic_launcher.png + Android_LauncherIcon36 + 1 + + + True + + + AutoMapperObjects\library\lib\armeabi\ + libAutoMapperObjects.so + AndroidLibnativeArmeabiFile + 1 + + + True + + + AutoMapperObjects\ + AndroidManifest.xml + ProjectAndroidManifest + 1 + + + True + + + AutoMapperObjects\library\lib\armeabi\ + libAutoMapperObjects.so + AndroidLibnativeArmeabiFile + 1 + + + True + + + AutoMapperObjects\res\drawable-hdpi\ + ic_launcher.png + Android_LauncherIcon72 + 1 + + + True + + + AutoMapperObjects\res\drawable-xxhdpi\ + ic_launcher.png + Android_LauncherIcon144 + 1 + + + True + + + AutoMapperObjects\res\drawable-xlarge\ + splash_image.png + Android_SplashImage960 + 1 + + + True + + + AutoMapperObjects\res\drawable-normal\ + splash_image.png + Android_SplashImage470 + 1 + + + True + + + AutoMapperObjects\res\drawable-small\ + splash_image.png + Android_SplashImage426 + 1 + + + True + + + AutoMapperObjects\res\drawable-large\ + splash_image.png + Android_SplashImage640 + 1 + + + True + + + AutoMapperObjects\res\drawable-xhdpi\ + ic_launcher.png + Android_LauncherIcon96 + 1 + + + True + + + AutoMapperObjects\library\lib\mips\ + libAutoMapperObjects.so + AndroidLibnativeMipsFile + 1 + + + True + + + AutoMapperObjects\res\drawable-mdpi\ + ic_launcher.png + Android_LauncherIcon48 + 1 + + + True + + + AutoMapperObjects\library\lib\mips\ + libAutoMapperObjects.so + AndroidLibnativeMipsFile + 1 + + + True + + + AutoMapperObjects\classes\ + classes.dex + AndroidClassesDexFile + 1 + + + True + + + AutoMapperObjects\library\lib\armeabi-v7a\ + libAutoMapperObjects.so + ProjectOutput + 1 + + + True + True + + + AutoMapperObjects\res\drawable\ + splash_image_def.xml + AndroidSplashImageDef + 1 + + + True + + + AutoMapperObjects\res\values\ + styles.xml + AndroidSplashStyles + 1 + + + True + + + AutoMapperObjects\library\lib\armeabi-v7a\ + gdbserver + AndroidGDBServer + 1 + + + True + + + + + AutoMapperObjects.app\ + libcgunwind.1.0.dylib + DependencyModule + 1 + + + True + + + AutoMapperObjects.app\ + libPCRE.dylib + DependencyModule + 1 + + + True + + +