├── Logo.png ├── Packages ├── Hprose.dcr ├── HproseSyna.res ├── HproseXE8.res ├── HproseIndy10.res ├── HproseIndy8.res ├── HproseIndy9.res ├── HproseIndy10_5.res ├── HproseIndy8.dpk ├── HproseIndy9.dpk ├── HproseXE8.dpk ├── HproseIndy10_5.dpk ├── HproseIndy10.dpk └── HproseSyna.dpk ├── Test ├── HproseTest.res ├── HproseTest.dpr ├── CaseInsensitiveArrayListTestCase.pas ├── CaseInsensitiveHashedListTestCase.pas ├── ArrayListTestCase.pas └── HashedListTestCase.pas ├── CppBuilder ├── HproseIndy8.res ├── HproseIndy9.res ├── HproseIndy10.res ├── HproseIndy10_5.res ├── HproseIndy10.cpp ├── HproseIndy10_5.cpp ├── HproseIndy8.cpp ├── HproseIndy9.cpp ├── HproseIndy8.bpk ├── HproseIndy9.cbproj ├── HproseIndy10.cbproj └── HproseIndy10_5.cbproj ├── Icons ├── THproseTcpClient.bmp ├── THproseTcpClient.png ├── THproseTcpServer.bmp ├── THproseTcpServer.png ├── THproseHttpClient.bmp ├── THproseHttpClient.png ├── THproseHttpServer.bmp ├── THproseHttpServer.png ├── THproseHttpClient.fw.png ├── THproseHttpServer.fw.png ├── THproseTcpClient.fw.png └── THproseTcpServer.fw.png ├── Source ├── Synapse │ ├── synautil.pas │ ├── synsock.pas │ ├── synafpc.pas │ ├── HproseHttpClient.pas │ └── synaip.pas ├── Hprose.inc ├── Indy9 │ └── HproseHttpClient.pas ├── Indy10 │ └── HproseHttpClient.pas ├── Indy10_5 │ └── HproseHttpClient.pas ├── XE8 │ └── HproseHttpClient.pas └── Indy8 │ └── HproseHttpClient.pas ├── .gitignore ├── Delphinus.Info.json ├── Delphinus.Install.json ├── LICENSE.md ├── README.md └── Lazarus ├── HproseIndy.lpk ├── HproseSyna.lpk └── Hprose.lrs /Logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hprose/hprose-delphi/HEAD/Logo.png -------------------------------------------------------------------------------- /Packages/Hprose.dcr: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hprose/hprose-delphi/HEAD/Packages/Hprose.dcr -------------------------------------------------------------------------------- /Test/HproseTest.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hprose/hprose-delphi/HEAD/Test/HproseTest.res -------------------------------------------------------------------------------- /Packages/HproseSyna.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hprose/hprose-delphi/HEAD/Packages/HproseSyna.res -------------------------------------------------------------------------------- /Packages/HproseXE8.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hprose/hprose-delphi/HEAD/Packages/HproseXE8.res -------------------------------------------------------------------------------- /CppBuilder/HproseIndy8.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hprose/hprose-delphi/HEAD/CppBuilder/HproseIndy8.res -------------------------------------------------------------------------------- /CppBuilder/HproseIndy9.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hprose/hprose-delphi/HEAD/CppBuilder/HproseIndy9.res -------------------------------------------------------------------------------- /Icons/THproseTcpClient.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hprose/hprose-delphi/HEAD/Icons/THproseTcpClient.bmp -------------------------------------------------------------------------------- /Icons/THproseTcpClient.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hprose/hprose-delphi/HEAD/Icons/THproseTcpClient.png -------------------------------------------------------------------------------- /Icons/THproseTcpServer.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hprose/hprose-delphi/HEAD/Icons/THproseTcpServer.bmp -------------------------------------------------------------------------------- /Icons/THproseTcpServer.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hprose/hprose-delphi/HEAD/Icons/THproseTcpServer.png -------------------------------------------------------------------------------- /Packages/HproseIndy10.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hprose/hprose-delphi/HEAD/Packages/HproseIndy10.res -------------------------------------------------------------------------------- /Packages/HproseIndy8.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hprose/hprose-delphi/HEAD/Packages/HproseIndy8.res -------------------------------------------------------------------------------- /Packages/HproseIndy9.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hprose/hprose-delphi/HEAD/Packages/HproseIndy9.res -------------------------------------------------------------------------------- /CppBuilder/HproseIndy10.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hprose/hprose-delphi/HEAD/CppBuilder/HproseIndy10.res -------------------------------------------------------------------------------- /Icons/THproseHttpClient.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hprose/hprose-delphi/HEAD/Icons/THproseHttpClient.bmp -------------------------------------------------------------------------------- /Icons/THproseHttpClient.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hprose/hprose-delphi/HEAD/Icons/THproseHttpClient.png -------------------------------------------------------------------------------- /Icons/THproseHttpServer.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hprose/hprose-delphi/HEAD/Icons/THproseHttpServer.bmp -------------------------------------------------------------------------------- /Icons/THproseHttpServer.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hprose/hprose-delphi/HEAD/Icons/THproseHttpServer.png -------------------------------------------------------------------------------- /Packages/HproseIndy10_5.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hprose/hprose-delphi/HEAD/Packages/HproseIndy10_5.res -------------------------------------------------------------------------------- /Source/Synapse/synautil.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hprose/hprose-delphi/HEAD/Source/Synapse/synautil.pas -------------------------------------------------------------------------------- /CppBuilder/HproseIndy10_5.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hprose/hprose-delphi/HEAD/CppBuilder/HproseIndy10_5.res -------------------------------------------------------------------------------- /Icons/THproseHttpClient.fw.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hprose/hprose-delphi/HEAD/Icons/THproseHttpClient.fw.png -------------------------------------------------------------------------------- /Icons/THproseHttpServer.fw.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hprose/hprose-delphi/HEAD/Icons/THproseHttpServer.fw.png -------------------------------------------------------------------------------- /Icons/THproseTcpClient.fw.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hprose/hprose-delphi/HEAD/Icons/THproseTcpClient.fw.png -------------------------------------------------------------------------------- /Icons/THproseTcpServer.fw.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hprose/hprose-delphi/HEAD/Icons/THproseTcpServer.fw.png -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | __history 2 | Lazarus/HproseIndy.pas 3 | Lazarus/HproseSyna.pas 4 | Lazarus/HproseLnet.pas 5 | *.o 6 | *.ppu 7 | *.compiled 8 | *.bak 9 | *.dcu 10 | *.otares 11 | *.dproj 12 | *.local 13 | *.ico 14 | *.identcache 15 | *.rsj 16 | *.~pas 17 | *.~dpr 18 | *.cfg 19 | *.exe 20 | *.deployproj 21 | *.dof 22 | *.stat 23 | dunit.ini 24 | __recovery 25 | Debug 26 | Release 27 | *.xml 28 | -------------------------------------------------------------------------------- /Delphinus.Info.json: -------------------------------------------------------------------------------- 1 | { 2 | "id": "{0AE3CEFD-7687-4190-92F7-7940BED824C0}", 3 | "name": "Hprose", 4 | "picture": "Logo.png", 5 | "license_type": "MIT", 6 | "license_file": "LICENSE.md", 7 | "platforms": "Win32;Win64;OSX32;Android;IOSDevice32;IOSDevice64;Linux64", 8 | "package_compiler_min": 14, 9 | "package_compiler_max": 32, 10 | "compiler_min": 14, 11 | "compiler_max": 32, 12 | "first_version": "2.0.1", 13 | "version": "2.0.2" 14 | } -------------------------------------------------------------------------------- /CppBuilder/HproseIndy10.cpp: -------------------------------------------------------------------------------- 1 | //--------------------------------------------------------------------------- 2 | 3 | #include 4 | #pragma hdrstop 5 | #pragma package(smart_init) 6 | //--------------------------------------------------------------------------- 7 | 8 | // Package source. 9 | //--------------------------------------------------------------------------- 10 | 11 | 12 | #pragma argsused 13 | int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) 14 | { 15 | return 1; 16 | } 17 | //--------------------------------------------------------------------------- 18 | -------------------------------------------------------------------------------- /CppBuilder/HproseIndy10_5.cpp: -------------------------------------------------------------------------------- 1 | //--------------------------------------------------------------------------- 2 | 3 | #include 4 | #pragma hdrstop 5 | #pragma package(smart_init) 6 | //--------------------------------------------------------------------------- 7 | 8 | // Package source. 9 | //--------------------------------------------------------------------------- 10 | 11 | 12 | #pragma argsused 13 | int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) 14 | { 15 | return 1; 16 | } 17 | //--------------------------------------------------------------------------- 18 | -------------------------------------------------------------------------------- /CppBuilder/HproseIndy8.cpp: -------------------------------------------------------------------------------- 1 | //--------------------------------------------------------------------------- 2 | 3 | #include 4 | #pragma hdrstop 5 | #pragma package(smart_init) 6 | //--------------------------------------------------------------------------- 7 | 8 | // Package source. 9 | //--------------------------------------------------------------------------- 10 | 11 | #pragma argsused 12 | int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) 13 | { 14 | return 1; 15 | } 16 | //--------------------------------------------------------------------------- 17 | -------------------------------------------------------------------------------- /CppBuilder/HproseIndy9.cpp: -------------------------------------------------------------------------------- 1 | //--------------------------------------------------------------------------- 2 | 3 | #include 4 | #pragma hdrstop 5 | #pragma package(smart_init) 6 | //--------------------------------------------------------------------------- 7 | 8 | // Package source. 9 | //--------------------------------------------------------------------------- 10 | 11 | 12 | #pragma argsused 13 | int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) 14 | { 15 | return 1; 16 | } 17 | //--------------------------------------------------------------------------- 18 | -------------------------------------------------------------------------------- /Delphinus.Install.json: -------------------------------------------------------------------------------- 1 | { 2 | "search_pathes": [{ 3 | "pathes": "Source", 4 | "platforms": "Win32;Win64;OSX32;Android;IOSDevice32;IOSDevice64;Linux64" 5 | }], 6 | "browsing_pathes": [{ 7 | "pathes": "Source", 8 | "platforms": "Win32;Win64;OSX32;Android;IOSDevice32;IOSDevice64;Linux64" 9 | }], 10 | "source_folders": [{ 11 | "folder": "." 12 | }, 13 | { 14 | "folder": "CppBuilder", 15 | "recursive": true 16 | }, 17 | { 18 | "folder": "Icons", 19 | "recursive": true 20 | }, 21 | { 22 | "folder": "Lazarus", 23 | "recursive": true 24 | }, 25 | { 26 | "folder": "Packages", 27 | "recursive": true 28 | }, 29 | { 30 | "folder": "Source", 31 | "recursive": true 32 | }, 33 | { 34 | "folder": "Test", 35 | "recursive": true 36 | }] 37 | } -------------------------------------------------------------------------------- /Packages/HproseIndy8.dpk: -------------------------------------------------------------------------------- 1 | package HproseIndy8; 2 | 3 | {$R *.res} 4 | {$R 'Hprose.dcr'} 5 | {$ALIGN 8} 6 | {$ASSERTIONS OFF} 7 | {$BOOLEVAL OFF} 8 | {$DEBUGINFO OFF} 9 | {$EXTENDEDSYNTAX ON} 10 | {$IMPORTEDDATA ON} 11 | {$IOCHECKS OFF} 12 | {$LOCALSYMBOLS OFF} 13 | {$LONGSTRINGS ON} 14 | {$OPENSTRINGS ON} 15 | {$OPTIMIZATION ON} 16 | {$OVERFLOWCHECKS OFF} 17 | {$RANGECHECKS OFF} 18 | {$REFERENCEINFO OFF} 19 | {$SAFEDIVIDE OFF} 20 | {$STACKFRAMES OFF} 21 | {$TYPEDADDRESS OFF} 22 | {$VARSTRINGCHECKS ON} 23 | {$WRITEABLECONST OFF} 24 | {$MINENUMSIZE 1} 25 | {$IMAGEBASE $400000} 26 | {$DESCRIPTION 'Hprose for Delphi with Indy8'} 27 | {$IMPLICITBUILD OFF} 28 | 29 | requires 30 | rtl, 31 | indy; 32 | 33 | contains 34 | ObjAutoX in '..\Source\ObjAutoX.pas', 35 | HproseCommon in '..\Source\HproseCommon.pas', 36 | HproseIO in '..\Source\HproseIO.pas', 37 | HproseClient in '..\Source\HproseClient.pas', 38 | HproseHttpClient in '..\Source\Indy8\HproseHttpClient.pas'; 39 | 40 | end. 41 | 42 | -------------------------------------------------------------------------------- /Packages/HproseIndy9.dpk: -------------------------------------------------------------------------------- 1 | package HproseIndy9; 2 | 3 | {$R *.res} 4 | {$R 'Hprose.dcr'} 5 | {$ALIGN 8} 6 | {$ASSERTIONS OFF} 7 | {$BOOLEVAL OFF} 8 | {$DEBUGINFO OFF} 9 | {$EXTENDEDSYNTAX ON} 10 | {$IMPORTEDDATA ON} 11 | {$IOCHECKS OFF} 12 | {$LOCALSYMBOLS OFF} 13 | {$LONGSTRINGS ON} 14 | {$OPENSTRINGS ON} 15 | {$OPTIMIZATION ON} 16 | {$OVERFLOWCHECKS OFF} 17 | {$RANGECHECKS OFF} 18 | {$REFERENCEINFO OFF} 19 | {$SAFEDIVIDE OFF} 20 | {$STACKFRAMES OFF} 21 | {$TYPEDADDRESS OFF} 22 | {$VARSTRINGCHECKS ON} 23 | {$WRITEABLECONST OFF} 24 | {$MINENUMSIZE 1} 25 | {$IMAGEBASE $400000} 26 | {$DESCRIPTION 'Hprose for Delphi with Indy9'} 27 | {$IMPLICITBUILD OFF} 28 | {$DEFINE RELEASE} 29 | 30 | requires 31 | rtl, 32 | indy; 33 | 34 | contains 35 | ObjAutoX in '..\Source\ObjAutoX.pas', 36 | HproseCommon in '..\Source\HproseCommon.pas', 37 | HproseIO in '..\Source\HproseIO.pas', 38 | HproseClient in '..\Source\HproseClient.pas', 39 | HproseHttpClient in '..\Source\Indy9\HproseHttpClient.pas'; 40 | 41 | end. 42 | -------------------------------------------------------------------------------- /Packages/HproseXE8.dpk: -------------------------------------------------------------------------------- 1 | package HproseXE8; 2 | 3 | {$R *.res} 4 | {$R 'Hprose.dcr'} 5 | {$ALIGN 8} 6 | {$ASSERTIONS ON} 7 | {$BOOLEVAL OFF} 8 | {$DEBUGINFO ON} 9 | {$EXTENDEDSYNTAX ON} 10 | {$IMPORTEDDATA ON} 11 | {$IOCHECKS ON} 12 | {$LOCALSYMBOLS ON} 13 | {$LONGSTRINGS ON} 14 | {$OPENSTRINGS ON} 15 | {$OPTIMIZATION ON} 16 | {$OVERFLOWCHECKS OFF} 17 | {$RANGECHECKS OFF} 18 | {$REFERENCEINFO ON} 19 | {$SAFEDIVIDE OFF} 20 | {$STACKFRAMES OFF} 21 | {$TYPEDADDRESS OFF} 22 | {$VARSTRINGCHECKS ON} 23 | {$WRITEABLECONST OFF} 24 | {$MINENUMSIZE 1} 25 | {$IMAGEBASE $400000} 26 | {$DESCRIPTION 'Hprose for Delphi XE8+'} 27 | {$IMPLICITBUILD OFF} 28 | 29 | requires 30 | rtl, 31 | IndyCore, 32 | IndyProtocols, 33 | IndySystem; 34 | 35 | contains 36 | ObjAutoX in '..\Source\ObjAutoX.pas', 37 | HproseCommon in '..\Source\HproseCommon.pas', 38 | HproseIO in '..\Source\HproseIO.pas', 39 | HproseClient in '..\Source\HproseClient.pas', 40 | HproseHttpClient in '..\Source\XE8\HproseHttpClient.pas'; 41 | 42 | end. 43 | -------------------------------------------------------------------------------- /Packages/HproseIndy10_5.dpk: -------------------------------------------------------------------------------- 1 | package HproseIndy10_5; 2 | 3 | {$R *.res} 4 | {$R 'Hprose.dcr'} 5 | {$ALIGN 8} 6 | {$ASSERTIONS ON} 7 | {$BOOLEVAL OFF} 8 | {$DEBUGINFO ON} 9 | {$EXTENDEDSYNTAX ON} 10 | {$IMPORTEDDATA ON} 11 | {$IOCHECKS ON} 12 | {$LOCALSYMBOLS ON} 13 | {$LONGSTRINGS ON} 14 | {$OPENSTRINGS ON} 15 | {$OPTIMIZATION ON} 16 | {$OVERFLOWCHECKS OFF} 17 | {$RANGECHECKS OFF} 18 | {$REFERENCEINFO ON} 19 | {$SAFEDIVIDE OFF} 20 | {$STACKFRAMES OFF} 21 | {$TYPEDADDRESS OFF} 22 | {$VARSTRINGCHECKS ON} 23 | {$WRITEABLECONST OFF} 24 | {$MINENUMSIZE 1} 25 | {$IMAGEBASE $400000} 26 | {$DESCRIPTION 'Hprose for Delphi with Indy10.5'} 27 | {$IMPLICITBUILD ON} 28 | 29 | requires 30 | rtl, 31 | IndyCore, 32 | IndyProtocols, 33 | IndySystem; 34 | 35 | contains 36 | ObjAutoX in '..\Source\ObjAutoX.pas', 37 | HproseCommon in '..\Source\HproseCommon.pas', 38 | HproseIO in '..\Source\HproseIO.pas', 39 | HproseClient in '..\Source\HproseClient.pas', 40 | HproseHttpClient in '..\Source\Indy10_5\HproseHttpClient.pas'; 41 | 42 | end. 43 | -------------------------------------------------------------------------------- /Packages/HproseIndy10.dpk: -------------------------------------------------------------------------------- 1 | package HproseIndy10; 2 | 3 | {$R *.res} 4 | {$R 'Hprose.dcr'} 5 | {$ALIGN 8} 6 | {$ASSERTIONS OFF} 7 | {$BOOLEVAL OFF} 8 | {$DEBUGINFO OFF} 9 | {$EXTENDEDSYNTAX ON} 10 | {$IMPORTEDDATA ON} 11 | {$IOCHECKS OFF} 12 | {$LOCALSYMBOLS OFF} 13 | {$LONGSTRINGS ON} 14 | {$OPENSTRINGS ON} 15 | {$OPTIMIZATION ON} 16 | {$OVERFLOWCHECKS OFF} 17 | {$RANGECHECKS OFF} 18 | {$REFERENCEINFO OFF} 19 | {$SAFEDIVIDE OFF} 20 | {$STACKFRAMES OFF} 21 | {$TYPEDADDRESS OFF} 22 | {$VARSTRINGCHECKS ON} 23 | {$WRITEABLECONST OFF} 24 | {$MINENUMSIZE 1} 25 | {$IMAGEBASE $400000} 26 | {$DESCRIPTION 'Hprose for Delphi with Indy10'} 27 | {$IMPLICITBUILD OFF} 28 | {$DEFINE RELEASE} 29 | 30 | requires 31 | rtl, 32 | IndyCore, 33 | IndyProtocols, 34 | IndySystem; 35 | 36 | contains 37 | ObjAutoX in '..\Source\ObjAutoX.pas', 38 | HproseCommon in '..\Source\HproseCommon.pas', 39 | HproseIO in '..\Source\HproseIO.pas', 40 | HproseClient in '..\Source\HproseClient.pas', 41 | HproseHttpClient in '..\Source\Indy10\HproseHttpClient.pas'; 42 | 43 | end. 44 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2008-2016 http://hprose.com 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy of 6 | this software and associated documentation files (the "Software"), to deal in 7 | the Software without restriction, including without limitation the rights to 8 | use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of 9 | the Software, and to permit persons to whom the Software is furnished to do so, 10 | subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS 17 | FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR 18 | COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER 19 | IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN 20 | CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | -------------------------------------------------------------------------------- /Packages/HproseSyna.dpk: -------------------------------------------------------------------------------- 1 | package HproseSyna; 2 | 3 | {$R *.res} 4 | {$R 'Hprose.dcr'} 5 | {$ALIGN 8} 6 | {$ASSERTIONS ON} 7 | {$BOOLEVAL OFF} 8 | {$DEBUGINFO OFF} 9 | {$EXTENDEDSYNTAX ON} 10 | {$IMPORTEDDATA ON} 11 | {$IOCHECKS ON} 12 | {$LOCALSYMBOLS OFF} 13 | {$LONGSTRINGS ON} 14 | {$OPENSTRINGS ON} 15 | {$OPTIMIZATION ON} 16 | {$OVERFLOWCHECKS OFF} 17 | {$RANGECHECKS OFF} 18 | {$REFERENCEINFO OFF} 19 | {$SAFEDIVIDE OFF} 20 | {$STACKFRAMES OFF} 21 | {$TYPEDADDRESS OFF} 22 | {$VARSTRINGCHECKS ON} 23 | {$WRITEABLECONST OFF} 24 | {$MINENUMSIZE 1} 25 | {$IMAGEBASE $400000} 26 | {$DESCRIPTION 'Hprose for Delphi/Lazarus with Synapse'} 27 | {$IMPLICITBUILD OFF} 28 | 29 | requires 30 | rtl; 31 | 32 | contains 33 | ObjAutoX in '..\Source\ObjAutoX.pas', 34 | HproseCommon in '..\Source\HproseCommon.pas', 35 | HproseIO in '..\Source\HproseIO.pas', 36 | HproseClient in '..\Source\HproseClient.pas', 37 | blcksock in '..\Source\Synapse\blcksock.pas', 38 | httpsend in '..\Source\Synapse\httpsend.pas', 39 | synafpc in '..\Source\Synapse\synafpc.pas', 40 | synaip in '..\Source\Synapse\synaip.pas', 41 | synautil in '..\Source\Synapse\synautil.pas', 42 | synsock in '..\Source\Synapse\synsock.pas', 43 | synacode in '..\Source\Synapse\synacode.pas', 44 | HproseHttpClient in '..\Source\Synapse\HproseHttpClient.pas'; 45 | 46 | end. 47 | -------------------------------------------------------------------------------- /Test/HproseTest.dpr: -------------------------------------------------------------------------------- 1 | program HproseTest; 2 | { 3 | 4 | Delphi DUnit Test Project 5 | ------------------------- 6 | This project contains the DUnit test framework and the GUI/Console test runners. 7 | Add "CONSOLE_TESTRUNNER" to the conditional defines entry in the project options 8 | to use the console test runner. Otherwise the GUI test runner will be used by 9 | default. 10 | 11 | } 12 | 13 | {$IFDEF CONSOLE_TESTRUNNER} 14 | {$APPTYPE CONSOLE} 15 | {$ENDIF} 16 | 17 | uses 18 | SysUtils, 19 | TextTestRunner, 20 | {$IFDEF FASTMM} 21 | FastMM4, 22 | {$ENDIF} 23 | {$IFDEF MSWINDOWS} 24 | {$IFNDEF NEXTGEN} 25 | Forms, 26 | GuiTestRunner, 27 | {$ENDIF NEXTGEN} 28 | {$ENDIF} 29 | TestFramework, 30 | HproseClient in '..\Source\HproseClient.pas', 31 | HproseCommon in '..\Source\HproseCommon.pas', 32 | HproseIO in '..\Source\HproseIO.pas', 33 | ObjAutoX in '..\Source\ObjAutoX.pas', 34 | ArrayListTestCase in 'ArrayListTestCase.pas', 35 | HashedListTestCase in 'HashedListTestCase.pas', 36 | CaseInsensitiveArrayListTestCase in 'CaseInsensitiveArrayListTestCase.pas', 37 | CaseInsensitiveHashedListTestCase in 'CaseInsensitiveHashedListTestCase.pas'; 38 | 39 | {$R *.RES} 40 | 41 | begin 42 | {$IFDEF MSWINDOWS} 43 | {$IFNDEF NEXTGEN} 44 | Application.Initialize; 45 | {$ENDIF NEXTGEN} 46 | {$ENDIF} 47 | if IsConsole then 48 | begin 49 | {$IFNDEF NEXTGEN} 50 | with TextTestRunner.RunRegisteredTests do 51 | Free; 52 | {$ELSE NEXTGEN} 53 | TextTestRunner.RunRegisteredTests 54 | {$ENDIF NEXTGEN} 55 | end 56 | else 57 | begin 58 | {$IFDEF MSWINDOWS} 59 | {$IFNDEF NEXTGEN} 60 | GuiTestRunner.RunRegisteredTests; 61 | {$ENDIF NEXTGEN} 62 | {$ENDIF} 63 | end; 64 | end. 65 | 66 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 |

Hprose

2 | 3 | # Hprose for Delphi/Lazarus 4 | 5 | [![Join the chat at https://gitter.im/hprose/hprose-delphi](https://badges.gitter.im/Join%20Chat.svg)](https://gitter.im/hprose/hprose-delphi?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) 6 | [![Supported Delphi versions: delphi6-delphi10.3](https://img.shields.io/badge/delphi-6~10.3-blue.svg) ![Supported FreePascal versions: freepascal2-freepascal3](https://img.shields.io/badge/freepascal-2~3-blue.svg)](https://github.com/hprose/hprose-delphi) [![GitHub release](https://img.shields.io/github/release/hprose/hprose-delphi.svg)](https://github.com/hprose/hprose-delphi/releases) 7 | 8 | *Hprose* is a High Performance Remote Object Service Engine. 9 | 10 | It is a modern, lightweight, cross-language, cross-platform, object-oriented, high performance, remote dynamic communication middleware. It is not only easy to use, but powerful. You just need a little time to learn, then you can use it to easily construct cross language cross platform distributed application system. 11 | 12 | *Hprose* supports many programming languages, for example: 13 | 14 | * AAuto Quicker 15 | * ActionScript 16 | * ASP 17 | * C++ 18 | * Dart 19 | * Delphi/Lazarus 20 | * dotNET(C#, Visual Basic...) 21 | * Golang 22 | * Java 23 | * JavaScript 24 | * Node.js 25 | * Objective-C 26 | * Perl 27 | * PHP 28 | * Python 29 | * Ruby 30 | * ... 31 | 32 | Through *Hprose*, You can conveniently and efficiently intercommunicate between those programming languages. 33 | 34 | This project is the implementation of Hprose for Delphi/Lazarus. 35 | 36 | ## Miscellaneous 37 | You can install [Delphinus package manager](https://github.com/Memnarch/Delphinus/wiki/Installing-Delphinus) and install Hprose as a package there. (Delphinus-Support) 38 | -------------------------------------------------------------------------------- /Test/CaseInsensitiveArrayListTestCase.pas: -------------------------------------------------------------------------------- 1 | unit CaseInsensitiveArrayListTestCase; 2 | 3 | interface 4 | 5 | uses 6 | TestFrameWork, HproseCommon; 7 | 8 | type 9 | 10 | TCaseInsensitiveArrayListTestCase = class(TTestCase) 11 | published 12 | procedure TestContains; 13 | procedure TestIndexOf; 14 | procedure TestLastIndexOf; 15 | procedure TestRemove; 16 | end; 17 | 18 | implementation 19 | 20 | uses Variants; 21 | 22 | { TCaseInsensitiveArrayListTestCase } 23 | 24 | procedure TCaseInsensitiveArrayListTestCase.TestContains; 25 | var 26 | L: IList; 27 | begin 28 | L := CaseInsensitiveArrayList([1, 'Abc', 3.14, True, 'ABC']); 29 | Check(L.Contains('hello') = False); 30 | Check(L.Contains('abc') = True); 31 | end; 32 | 33 | procedure TCaseInsensitiveArrayListTestCase.TestIndexOf; 34 | var 35 | L: IList; 36 | begin 37 | L := CaseInsensitiveArrayList([1, 'Abc', 3.14, True, 'ABC']); 38 | Check(L.IndexOf(1.0) = -1); 39 | Check(L.IndexOf(1) = 0); 40 | Check(L.IndexOf(3.14) = 2); 41 | Check(L.IndexOf(False) = -1); 42 | Check(L.IndexOf('abc') = 1); 43 | Check(L.IndexOf('abc', 1) = 1); 44 | Check(L.IndexOf('abc', 2) = 4); 45 | Check(L.IndexOf('abc', 2, 2) = -1); 46 | end; 47 | 48 | procedure TCaseInsensitiveArrayListTestCase.TestLastIndexOf; 49 | var 50 | L: IList; 51 | begin 52 | L := CaseInsensitiveArrayList([1, 'Abc', 3.14, True, 'ABC']); 53 | Check(L.LastIndexOf(1) = 0); 54 | Check(L.LastIndexOf('hello') = -1); 55 | Check(L.LastIndexOf('abc') = 4); 56 | Check(L.LastIndexOf('abc', 3) = 1); 57 | Check(L.LastIndexOf('abc', 4) = 4); 58 | Check(L.LastIndexOf('abc', 3, 2) = -1); 59 | end; 60 | 61 | procedure TCaseInsensitiveArrayListTestCase.TestRemove; 62 | var 63 | L: IList; 64 | begin 65 | L := CaseInsensitiveArrayList([1, 'Abc', 3.14, True, 'ABC']); 66 | Check(L.Remove('abc', FromEnd) = 4); 67 | Check(L.Remove('abc', FromBeginning) = 1); 68 | Check(L.Remove(True) = 2); 69 | end; 70 | 71 | initialization 72 | TestFramework.RegisterTest(TCaseInsensitiveArrayListTestCase.Suite); 73 | 74 | end. 75 | -------------------------------------------------------------------------------- /Test/CaseInsensitiveHashedListTestCase.pas: -------------------------------------------------------------------------------- 1 | unit CaseInsensitiveHashedListTestCase; 2 | 3 | interface 4 | 5 | uses 6 | TestFrameWork, HproseCommon; 7 | 8 | type 9 | 10 | TCaseInsensitiveHashedListTestCase = class(TTestCase) 11 | published 12 | procedure TestContains; 13 | procedure TestIndexOf; 14 | procedure TestLastIndexOf; 15 | procedure TestRemove; 16 | end; 17 | 18 | implementation 19 | 20 | uses Variants; 21 | 22 | { TCaseInsensitiveHashedListTestCase } 23 | 24 | procedure TCaseInsensitiveHashedListTestCase.TestContains; 25 | var 26 | L: IList; 27 | begin 28 | L := CaseInsensitiveHashedList([1, 'Abc', 3.14, True, 'ABC']); 29 | Check(L.Contains('hello') = False); 30 | Check(L.Contains('abc') = True); 31 | end; 32 | 33 | procedure TCaseInsensitiveHashedListTestCase.TestIndexOf; 34 | var 35 | L: IList; 36 | begin 37 | L := CaseInsensitiveHashedList([1, 'Abc', 3.14, True, 'ABC']); 38 | Check(L.IndexOf(1.0) = -1); 39 | Check(L.IndexOf(1) = 0); 40 | Check(L.IndexOf(3.14) = 2); 41 | Check(L.IndexOf(False) = -1); 42 | Check(L.IndexOf('abc') = 1); 43 | Check(L.IndexOf('abc', 1) = 1); 44 | Check(L.IndexOf('abc', 2) = 4); 45 | Check(L.IndexOf('abc', 2, 2) = -1); 46 | end; 47 | 48 | procedure TCaseInsensitiveHashedListTestCase.TestLastIndexOf; 49 | var 50 | L: IList; 51 | begin 52 | L := CaseInsensitiveHashedList([1, 'Abc', 3.14, True, 'ABC']); 53 | Check(L.LastIndexOf(1) = 0); 54 | Check(L.LastIndexOf('hello') = -1); 55 | Check(L.LastIndexOf('abc') = 4); 56 | Check(L.LastIndexOf('abc', 3) = 1); 57 | Check(L.LastIndexOf('abc', 4) = 4); 58 | Check(L.LastIndexOf('abc', 3, 2) = -1); 59 | end; 60 | 61 | procedure TCaseInsensitiveHashedListTestCase.TestRemove; 62 | var 63 | L: IList; 64 | begin 65 | L := CaseInsensitiveHashedList([1, 'Abc', 3.14, True, 'ABC']); 66 | Check(L.Remove('abc', FromEnd) = 4); 67 | Check(L.Remove('abc', FromBeginning) = 1); 68 | Check(L.Remove(True) = 2); 69 | end; 70 | 71 | initialization 72 | TestFramework.RegisterTest(TCaseInsensitiveHashedListTestCase.Suite); 73 | 74 | end. 75 | -------------------------------------------------------------------------------- /Lazarus/HproseIndy.lpk: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 83 | 84 | 85 | 86 | 87 | 88 | 89 | 90 | 91 | 92 | 93 | 94 | 95 | 96 | 97 | -------------------------------------------------------------------------------- /Source/Synapse/synsock.pas: -------------------------------------------------------------------------------- 1 | {==============================================================================| 2 | | Project : Ararat Synapse | 005.002.003 | 3 | |==============================================================================| 4 | | Content: Socket Independent Platform Layer | 5 | |==============================================================================| 6 | | Copyright (c)1999-2013, Lukas Gebauer | 7 | | All rights reserved. | 8 | | | 9 | | Redistribution and use in source and binary forms, with or without | 10 | | modification, are permitted provided that the following conditions are met: | 11 | | | 12 | | Redistributions of source code must retain the above copyright notice, this | 13 | | list of conditions and the following disclaimer. | 14 | | | 15 | | Redistributions in binary form must reproduce the above copyright notice, | 16 | | this list of conditions and the following disclaimer in the documentation | 17 | | and/or other materials provided with the distribution. | 18 | | | 19 | | Neither the name of Lukas Gebauer nor the names of its contributors may | 20 | | be used to endorse or promote products derived from this software without | 21 | | specific prior written permission. | 22 | | | 23 | | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | 24 | | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | 25 | | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | 26 | | ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR | 27 | | ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL | 28 | | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR | 29 | | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER | 30 | | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT | 31 | | LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY | 32 | | OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH | 33 | | DAMAGE. | 34 | |==============================================================================| 35 | | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).| 36 | | Portions created by Lukas Gebauer are Copyright (c)2001-2013. | 37 | | All Rights Reserved. | 38 | |==============================================================================| 39 | | Contributor(s): | 40 | | Tomas Hajny (OS2 support) | 41 | |==============================================================================| 42 | | History: see HISTORY.HTM from distribution package | 43 | | (Found at URL: http://www.ararat.cz/synapse/) | 44 | |==============================================================================} 45 | 46 | {:@exclude} 47 | 48 | unit synsock; 49 | 50 | {$MINENUMSIZE 4} 51 | 52 | //old Delphi does not have MSWINDOWS define. 53 | {$IFDEF WIN32} 54 | {$IFNDEF MSWINDOWS} 55 | {$DEFINE MSWINDOWS} 56 | {$ENDIF} 57 | {$ENDIF} 58 | 59 | {$IFDEF CIL} 60 | {$I ssdotnet.inc} 61 | {$ELSE} 62 | {$IFDEF MSWINDOWS} 63 | {$I sswin32.inc} 64 | {$ELSE} 65 | {$IFDEF WINCE} 66 | {$I sswin32.inc} //not complete yet! 67 | {$ELSE} 68 | {$IFDEF FPC} 69 | {$IFDEF OS2} 70 | {$I ssos2ws1.inc} 71 | {$ELSE OS2} 72 | {$I ssfpc.inc} 73 | {$ENDIF OS2} 74 | {$ELSE} 75 | {$I sslinux.inc} 76 | {$ENDIF} 77 | {$ENDIF} 78 | {$ENDIF} 79 | {$ENDIF} 80 | {$IFDEF POSIX} 81 | //Posix.SysSocket 82 | {$I ssposix.inc} //experimental! 83 | {$ENDIF} 84 | 85 | end. 86 | 87 | -------------------------------------------------------------------------------- /Source/Hprose.inc: -------------------------------------------------------------------------------- 1 | // DELPHI VERSION 2 | 3 | {$IFDEF VER140} 4 | {$DEFINE DELPHI6} 5 | {$DEFINE DELPHI6_UP} 6 | {$ENDIF} 7 | 8 | {$IFDEF VER150} 9 | {$DEFINE DELPHI7} 10 | {$DEFINE DELPHI7_UP} 11 | {$ENDIF} 12 | 13 | {$IFDEF VER160} 14 | {$DEFINE DELPHI8} 15 | {$DEFINE DELPHI8_UP} 16 | {$ENDIF} 17 | 18 | {$IFDEF VER170} 19 | {$DEFINE DELPHI2005} 20 | {$DEFINE DELPHI2005_UP} 21 | {$ENDIF} 22 | 23 | {$IFDEF VER180} 24 | {$DEFINE DELPHI2006} 25 | {$DEFINE DELPHI2006_UP} 26 | {$ENDIF} 27 | 28 | {$IFDEF VER185} 29 | {$DEFINE DELPHI2007} 30 | {$DEFINE DELPHI2007_UP} 31 | {$ENDIF} 32 | 33 | {$IFDEF VER200} 34 | {$DEFINE DELPHI2009} 35 | {$DEFINE DELPHI2009_UP} 36 | {$ENDIF} 37 | 38 | {$IFDEF VER210} 39 | {$DEFINE DELPHI2010} 40 | {$DEFINE DELPHI2010_UP} 41 | {$ENDIF} 42 | 43 | {$IFDEF VER220} 44 | {$DEFINE DELPHIXE} 45 | {$DEFINE DELPHIXE_UP} 46 | {$ENDIF} 47 | 48 | {$IFDEF VER230} 49 | {$DEFINE DELPHIXE2} 50 | {$DEFINE DELPHIXE2_UP} 51 | {$ENDIF} 52 | 53 | {$IFDEF VER240} 54 | {$DEFINE DELPHIXE3} 55 | {$DEFINE DELPHIXE3_UP} 56 | {$ENDIF} 57 | 58 | {$IFDEF VER250} 59 | {$DEFINE DELPHIXE4} 60 | {$DEFINE DELPHIXE4_UP} 61 | {$ENDIF} 62 | 63 | {$IFDEF VER260} 64 | {$DEFINE DELPHIXE5} 65 | {$DEFINE DELPHIXE5_UP} 66 | {$ENDIF} 67 | 68 | {$IFDEF VER270} 69 | {$DEFINE DELPHIXE6} 70 | {$DEFINE DELPHIXE6_UP} 71 | {$ENDIF} 72 | 73 | {$IFDEF VER280} 74 | {$DEFINE DELPHIXE7} 75 | {$DEFINE DELPHIXE7_UP} 76 | {$ENDIF} 77 | 78 | {$IFDEF VER290} 79 | {$DEFINE DELPHIXE8} 80 | {$DEFINE DELPHIXE8_UP} 81 | {$ENDIF} 82 | 83 | {$IFDEF VER300} 84 | {$DEFINE DELPHI10} 85 | {$DEFINE DELPHI10_UP} 86 | {$ENDIF} 87 | 88 | {$IFDEF VER310} 89 | {$DEFINE DELPHI10_1} 90 | {$DEFINE DELPHI10_1_UP} 91 | {$ENDIF} 92 | 93 | {$IFDEF VER320} 94 | {$DEFINE DELPHI10_2} 95 | {$DEFINE DELPHI10_2_UP} 96 | {$ENDIF} 97 | 98 | {$IFDEF VER330} 99 | {$DEFINE DELPHI10_3} 100 | {$DEFINE DELPHI10_3_UP} 101 | {$ENDIF} 102 | 103 | {$IFDEF DELPHI10_3_UP} 104 | {$DEFINE DELPHI10_2_UP} 105 | {$ENDIF} 106 | 107 | {$IFDEF DELPHI10_2_UP} 108 | {$DEFINE DELPHI10_1_UP} 109 | {$ENDIF} 110 | 111 | {$IFDEF DELPHI10_1_UP} 112 | {$DEFINE DELPHI10_UP} 113 | {$ENDIF} 114 | 115 | {$IFDEF DELPHI10_UP} 116 | {$DEFINE DELPHIXE8_UP} 117 | {$ENDIF} 118 | 119 | {$IFDEF DELPHIXE8_UP} 120 | {$DEFINE DELPHIXE7_UP} 121 | {$ENDIF} 122 | 123 | {$IFDEF DELPHIXE7_UP} 124 | {$DEFINE DELPHIXE6_UP} 125 | {$ENDIF} 126 | 127 | {$IFDEF DELPHIXE6_UP} 128 | {$DEFINE DELPHIXE5_UP} 129 | {$ENDIF} 130 | 131 | {$IFDEF DELPHIXE5_UP} 132 | {$DEFINE DELPHIXE4_UP} 133 | {$ENDIF} 134 | 135 | {$IFDEF DELPHIXE4_UP} 136 | {$DEFINE DELPHIXE3_UP} 137 | {$ENDIF} 138 | 139 | {$IFDEF DELPHIXE3_UP} 140 | {$DEFINE DELPHIXE2_UP} 141 | {$ENDIF} 142 | 143 | {$IFDEF DELPHIXE2_UP} 144 | {$DEFINE DELPHIXE_UP} 145 | {$ENDIF} 146 | 147 | {$IFDEF DELPHIXE_UP} 148 | {$DEFINE DELPHI2010_UP} 149 | {$ENDIF} 150 | 151 | {$IFDEF DELPHI2010_UP} 152 | {$DEFINE DELPHI2009_UP} 153 | {$ENDIF} 154 | 155 | {$IFDEF DELPHI2009_UP} 156 | {$DEFINE DELPHI2007_UP} 157 | {$ENDIF} 158 | 159 | {$IFDEF DELPHI2007_UP} 160 | {$DEFINE DELPHI2006_UP} 161 | {$ENDIF} 162 | 163 | {$IFDEF DELPHI2006_UP} 164 | {$DEFINE DELPHI2005_UP} 165 | {$ENDIF} 166 | 167 | {$IFDEF DELPHI2005_UP} 168 | {$DEFINE DELPHI8_UP} 169 | {$ENDIF} 170 | 171 | {$IFDEF DELPHI8_UP} 172 | {$DEFINE DELPHI7_UP} 173 | {$ENDIF} 174 | 175 | {$IFDEF DELPHI7_UP} 176 | {$DEFINE DELPHI6_UP} 177 | {$ENDIF} 178 | 179 | // DELPHI FEATURES 180 | 181 | {$IFDEF DELPHI2005_UP} 182 | {$DEFINE SUPPORTS_FOR_IN} 183 | {$DEFINE SUPPORTS_INLINE} 184 | {$DEFINE SUPPORTS_NESTED_CONSTANTS} 185 | {$DEFINE SUPPORTS_NESTED_TYPES} 186 | {$ENDIF} 187 | 188 | {$IFDEF DELPHI2006_UP} 189 | {$DEFINE SUPPORTS_STATIC} 190 | {$ENDIF} 191 | 192 | {$IFDEF DELPHI2009_UP} 193 | {$DEFINE SUPPORTS_UNICODE} 194 | {$DEFINE SUPPORTS_GENERICS} 195 | {$DEFINE SUPPORTS_UINT64} 196 | {$ENDIF} 197 | 198 | {$IFDEF DELPHI2010_UP} 199 | {$DEFINE SUPPORTS_RTTI} 200 | {$DEFINE SUPPORTS_RTTI2} 201 | {$DEFINE SUPPORTS_ANONYMOUS_METHOD} 202 | {$ENDIF} 203 | 204 | // FREE PASCAL 205 | 206 | {$IFDEF FPC} 207 | {$DEFINE SUPPORTS_UINT64} 208 | {$DEFINE SUPPORTS_RTTI2} 209 | {$MODE OBJFPC} 210 | {$INLINE ON} 211 | {$H+} 212 | {$ENDIF} 213 | 214 | {$IF DEFINED(FPC) AND (FPC_FULLVERSION > 20400)} 215 | {$DEFINE SUPPORTS_UNICODE} 216 | {$IFEND} 217 | 218 | {$IFDEF CPUX64} 219 | {$DEFINE CPU64} 220 | {$ENDIF} 221 | 222 | {$H+} 223 | -------------------------------------------------------------------------------- /Lazarus/HproseSyna.lpk: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 83 | 84 | 85 | 86 | 87 | 88 | 89 | 90 | 91 | 92 | 93 | 94 | 95 | 96 | 97 | 98 | 99 | 100 | 101 | 102 | 103 | 104 | 105 | 106 | 107 | 108 | 109 | 110 | 111 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 | 120 | 121 | 122 | 123 | 124 | 125 | 126 | 127 | 128 | 129 | 130 | 131 | 132 | 133 | 134 | 135 | 136 | 137 | 138 | <_ExternHelp Items="Count"/> 139 | 140 | 141 | 142 | -------------------------------------------------------------------------------- /CppBuilder/HproseIndy8.bpk: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 19 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | [Version Info] 72 | IncludeVerInfo=1 73 | AutoIncBuild=0 74 | MajorVer=1 75 | MinorVer=3 76 | Release=0 77 | Build=0 78 | Debug=0 79 | PreRelease=0 80 | Special=0 81 | Private=0 82 | DLL=0 83 | Locale=1033 84 | CodePage=1252 85 | 86 | [Version Info Keys] 87 | CompanyName=HPRFC 88 | FileDescription= 89 | FileVersion=1.3.0.0 90 | InternalName=Hprose 91 | LegalCopyright= 92 | LegalTrademarks= 93 | OriginalFilename= 94 | ProductName=Hprose 95 | ProductVersion=1.3.0.0 96 | Comments= 97 | 98 | [HistoryLists\hlIncludePath] 99 | Count=1 100 | Item0=..\Indy8;..\;C:\Program Files\Borland\CBuilder6\Projects;Z:\Svnroot\hprose\trunk\delphi\Indy8;Z:\Svnroot\hprose\trunk\delphi;$(BCB)\include;$(BCB)\include\vcl 101 | 102 | [HistoryLists\hlLibraryPath] 103 | Count=1 104 | Item0=..\Indy8;..\;C:\Program Files\Borland\CBuilder6\Projects;Z:\Svnroot\hprose\trunk\delphi\Indy8;Z:\Svnroot\hprose\trunk\delphi;$(BCB)\lib\obj;$(BCB)\lib 105 | 106 | [HistoryLists\hlDebugSourcePath] 107 | Count=1 108 | Item0=$(BCB)\source\vcl 109 | 110 | [Debugging] 111 | DebugSourceDirs=$(BCB)\source\vcl 112 | 113 | [Parameters] 114 | RunParams= 115 | Launcher= 116 | UseLauncher=0 117 | DebugCWD= 118 | HostApplication= 119 | RemoteHost= 120 | RemotePath= 121 | RemoteLauncher= 122 | RemoteCWD= 123 | RemoteDebug=0 124 | 125 | [Compiler] 126 | ShowInfoMsgs=0 127 | LinkDebugVcl=0 128 | LinkCGLIB=0 129 | 130 | [CORBA] 131 | AddServerUnit=1 132 | AddClientUnit=1 133 | PrecompiledHeaders=1 134 | 135 | [Linker] 136 | LibPrefix= 137 | LibSuffix= 138 | LibVersion= 139 | 140 | -------------------------------------------------------------------------------- /Source/Synapse/synafpc.pas: -------------------------------------------------------------------------------- 1 | {==============================================================================| 2 | | Project : Ararat Synapse | 001.003.001 | 3 | |==============================================================================| 4 | | Content: Utils for FreePascal compatibility | 5 | |==============================================================================| 6 | | Copyright (c)1999-2013, Lukas Gebauer | 7 | | All rights reserved. | 8 | | | 9 | | Redistribution and use in source and binary forms, with or without | 10 | | modification, are permitted provided that the following conditions are met: | 11 | | | 12 | | Redistributions of source code must retain the above copyright notice, this | 13 | | list of conditions and the following disclaimer. | 14 | | | 15 | | Redistributions in binary form must reproduce the above copyright notice, | 16 | | this list of conditions and the following disclaimer in the documentation | 17 | | and/or other materials provided with the distribution. | 18 | | | 19 | | Neither the name of Lukas Gebauer nor the names of its contributors may | 20 | | be used to endorse or promote products derived from this software without | 21 | | specific prior written permission. | 22 | | | 23 | | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | 24 | | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | 25 | | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | 26 | | ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR | 27 | | ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL | 28 | | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR | 29 | | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER | 30 | | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT | 31 | | LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY | 32 | | OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH | 33 | | DAMAGE. | 34 | |==============================================================================| 35 | | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).| 36 | | Portions created by Lukas Gebauer are Copyright (c)2003-2013. | 37 | | All Rights Reserved. | 38 | |==============================================================================| 39 | | Contributor(s): | 40 | | Tomas Hajny (OS2 support) | 41 | |==============================================================================| 42 | | History: see HISTORY.HTM from distribution package | 43 | | (Found at URL: http://www.ararat.cz/synapse/) | 44 | |==============================================================================} 45 | 46 | {:@exclude} 47 | 48 | {$IFDEF FPC} 49 | {$MODE DELPHI} 50 | {$ENDIF} 51 | {$H+} 52 | //old Delphi does not have MSWINDOWS define. 53 | {$IFDEF WIN32} 54 | {$IFNDEF MSWINDOWS} 55 | {$DEFINE MSWINDOWS} 56 | {$ENDIF} 57 | {$ENDIF} 58 | 59 | unit synafpc; 60 | 61 | interface 62 | 63 | uses 64 | {$IFDEF FPC} 65 | dynlibs, sysutils; 66 | {$ELSE} 67 | {$IFDEF MSWINDOWS} 68 | Windows; 69 | {$ELSE} 70 | SysUtils; 71 | {$ENDIF} 72 | {$ENDIF} 73 | 74 | {$IFDEF FPC} 75 | type 76 | TLibHandle = dynlibs.TLibHandle; 77 | 78 | function LoadLibrary(ModuleName: PChar): TLibHandle; 79 | function FreeLibrary(Module: TLibHandle): LongBool; 80 | function GetProcAddress(Module: TLibHandle; Proc: PChar): Pointer; 81 | function GetModuleFileName(Module: TLibHandle; Buffer: PChar; BufLen: Integer): Integer; 82 | {$ELSE} //not FPC 83 | type 84 | {$IFDEF CIL} 85 | TLibHandle = Integer; 86 | PtrInt = Integer; 87 | {$ELSE} 88 | TLibHandle = HModule; 89 | {$IFDEF WIN64} 90 | PtrInt = NativeInt; 91 | {$ELSE} 92 | PtrInt = Integer; 93 | {$ENDIF} 94 | {$ENDIF} 95 | {$IFDEF VER100} 96 | LongWord = DWord; 97 | {$ENDIF} 98 | {$ENDIF} 99 | 100 | procedure Sleep(milliseconds: Cardinal); 101 | 102 | 103 | implementation 104 | 105 | {==============================================================================} 106 | {$IFDEF FPC} 107 | function LoadLibrary(ModuleName: PChar): TLibHandle; 108 | begin 109 | Result := dynlibs.LoadLibrary(Modulename); 110 | end; 111 | 112 | function FreeLibrary(Module: TLibHandle): LongBool; 113 | begin 114 | Result := dynlibs.UnloadLibrary(Module); 115 | end; 116 | 117 | function GetProcAddress(Module: TLibHandle; Proc: PChar): Pointer; 118 | begin 119 | {$IFDEF OS2GCC} 120 | Result := dynlibs.GetProcedureAddress(Module, '_' + Proc); 121 | {$ELSE OS2GCC} 122 | Result := dynlibs.GetProcedureAddress(Module, Proc); 123 | {$ENDIF OS2GCC} 124 | end; 125 | 126 | function GetModuleFileName(Module: TLibHandle; Buffer: PChar; BufLen: Integer): Integer; 127 | begin 128 | Result := 0; 129 | end; 130 | 131 | {$ELSE} 132 | {$ENDIF} 133 | 134 | procedure Sleep(milliseconds: Cardinal); 135 | begin 136 | {$IFDEF MSWINDOWS} 137 | {$IFDEF FPC} 138 | sysutils.sleep(milliseconds); 139 | {$ELSE} 140 | windows.sleep(milliseconds); 141 | {$ENDIF} 142 | {$ELSE} 143 | sysutils.sleep(milliseconds); 144 | {$ENDIF} 145 | 146 | end; 147 | 148 | end. 149 | -------------------------------------------------------------------------------- /Source/Indy9/HproseHttpClient.pas: -------------------------------------------------------------------------------- 1 | { 2 | /**********************************************************\ 3 | | | 4 | | hprose | 5 | | | 6 | | Official WebSite: http://www.hprose.com/ | 7 | | http://www.hprose.org/ | 8 | | | 9 | \**********************************************************/ 10 | 11 | /**********************************************************\ 12 | * * 13 | * HproseHttpClient.pas * 14 | * * 15 | * hprose indy http client unit for delphi. * 16 | * * 17 | * LastModified: Dec 14, 2016 * 18 | * Author: Ma Bingyao * 19 | * * 20 | \**********************************************************/ 21 | } 22 | unit HproseHttpClient; 23 | 24 | interface 25 | 26 | uses Classes, HproseCommon, HproseClient, IdHeaderList, SysUtils; 27 | 28 | type 29 | 30 | THproseHttpClient = class(THproseClient) 31 | private 32 | FHttpPool: IList; 33 | FUserName: string; 34 | FPassword: string; 35 | FHeaders: IMap; 36 | FProxyHost: string; 37 | FProxyPort: Integer; 38 | FProxyUser: string; 39 | FProxyPass: string; 40 | FUserAgent: string; 41 | FKeepAlive: Boolean; 42 | FKeepAliveTimeout: Integer; 43 | FConnectionTimeout: Integer; 44 | protected 45 | function SendAndReceive(const Data: TBytes; 46 | const Context: TClientContext): TBytes; override; 47 | public 48 | constructor Create(AOwner: TComponent); override; 49 | destructor Destroy; override; 50 | published 51 | {:Before HTTP operation you may define any non-standard headers for HTTP 52 | request, except of: 'Expect: 100-continue', 'Content-Length', 'Content-Type', 53 | 'Connection', 'Authorization', 'Proxy-Authorization' and 'Host' headers.} 54 | property Headers: IMap read FHeaders; 55 | 56 | {:If @true (default value is @false), keepalives in HTTP protocol 1.1 is enabled.} 57 | property KeepAlive: Boolean read FKeepAlive write FKeepAlive; 58 | 59 | {:Define timeout for keepalives in seconds! Default value is 300.} 60 | property KeepAliveTimeout: integer read FKeepAliveTimeout write FKeepAliveTimeout; 61 | 62 | {:Address of proxy server (IP address or domain name).} 63 | property ProxyHost: string read FProxyHost Write FProxyHost; 64 | 65 | {:Port number for proxy connection. Default value is 8080.} 66 | property ProxyPort: Integer read FProxyPort Write FProxyPort; 67 | 68 | {:Username for connect to proxy server.} 69 | property ProxyUser: string read FProxyUser Write FProxyUser; 70 | 71 | {:Password for connect to proxy server.} 72 | property ProxyPass: string read FProxyPass Write FProxyPass; 73 | 74 | {:Here you can specify custom User-Agent indentification. By default is 75 | used: 'Hprose Http Client for Delphi (Indy9)'} 76 | property UserAgent: string read FUserAgent Write FUserAgent; 77 | 78 | {:UserName for user authorization.} 79 | property UserName: string read FUserName write FUserName; 80 | 81 | {:Password for user authorization.} 82 | property Password: string read FPassword write FPassword; 83 | 84 | {:Define timeout for ConnectionTimeout in milliseconds! Can't work in Indy9} 85 | property ConnectionTimeout: Integer read FConnectionTimeout write FConnectionTimeout; 86 | end; 87 | 88 | procedure Register; 89 | 90 | implementation 91 | 92 | uses IdHttp, IdCookieManager; 93 | 94 | var 95 | CookieManager: TIdCookieManager = nil; 96 | 97 | { THproseHttpClient } 98 | 99 | constructor THproseHttpClient.Create(AOwner: TComponent); 100 | begin 101 | inherited Create(AOwner); 102 | FHttpPool := TArrayList.Create(10); 103 | FHeaders := TCaseInsensitiveHashMap.Create; 104 | FUserName := ''; 105 | FPassword := ''; 106 | FKeepAlive := True; 107 | FKeepAliveTimeout := 300; 108 | FProxyHost := ''; 109 | FProxyPort := 8080; 110 | FProxyUser := ''; 111 | FProxyPass := ''; 112 | FUserAgent := 'Hprose Http Client for Delphi (Indy9)'; 113 | FConnectionTimeout := 10000; 114 | end; 115 | 116 | destructor THproseHttpClient.Destroy; 117 | var 118 | I: Integer; 119 | begin 120 | FHttpPool.Lock; 121 | try 122 | for I := FHttpPool.Count - 1 downto 0 do 123 | TIdHttp(VarToObj(FHttpPool.Delete(I))).Free; 124 | finally 125 | FHttpPool.Unlock; 126 | end; 127 | inherited; 128 | end; 129 | 130 | function THproseHttpClient.SendAndReceive(const Data: TBytes; 131 | const Context: TClientContext): TBytes; 132 | var 133 | IdHttp: TIdHttp; 134 | OutStream, InStream: TBytesStream; 135 | Header, HttpHeader: IMap; 136 | CustomHeaders, RawHeaders: TIdHeaderList; 137 | I: Integer; 138 | Key: string; 139 | begin 140 | FHttpPool.Lock; 141 | try 142 | if FHttpPool.Count > 0 then 143 | IdHttp := TIdHttp(VarToObj(FHttpPool.Delete(FHttpPool.Count - 1))) 144 | else begin 145 | IdHttp := TIdHttp.Create(nil); 146 | IdHttp.AllowCookies := True; 147 | IdHttp.CookieManager := CookieManager; 148 | IdHTTP.HTTPOptions := IdHTTP.HTTPOptions + [hoKeepOrigProtocol]; 149 | IdHttp.ProtocolVersion := pv1_1; 150 | end; 151 | finally 152 | FHttpPool.Unlock; 153 | end; 154 | IdHttp.ReadTimeout := Context.Settings.Timeout; 155 | IdHttp.Request.UserAgent := FUserAgent; 156 | if FProxyHost <> '' then begin 157 | IdHttp.ProxyParams.ProxyServer := FProxyHost; 158 | IdHttp.ProxyParams.ProxyPort := FProxyPort; 159 | IdHttp.ProxyParams.ProxyUsername := FProxyUser; 160 | IdHttp.ProxyParams.ProxyPassword := FProxyPass; 161 | end; 162 | CustomHeaders := IdHttp.Request.CustomHeaders; 163 | if KeepAlive then begin 164 | IdHttp.Request.Connection := 'keep-alive'; 165 | CustomHeaders.Values['Keep-Alive'] := IntToStr(FKeepAliveTimeout); 166 | end 167 | else IdHttp.Request.Connection := 'close'; 168 | if FUserName <> '' then begin 169 | IdHttp.Request.BasicAuthentication := True; 170 | IdHttp.Request.UserName := FUserName; 171 | IdHttp.Request.Password := FPassword; 172 | end; 173 | IdHttp.Request.ContentType := 'application/hprose'; 174 | Header := TCaseInsensitiveHashMap.Create; 175 | Header.PutAll(FHeaders); 176 | HttpHeader := VarToMap(Context['httpHeader']); 177 | if (Assigned(HttpHeader)) then 178 | Header.PutAll(HttpHeader) 179 | else 180 | HttpHeader := TCaseInsensitiveHashMap.Create; 181 | for I := 0 to Header.Count - 1 do 182 | CustomHeaders.Values[Header.Keys[I]] := Header.Values[I]; 183 | OutStream := TBytesStream.Create(Data); 184 | InStream := TBytesStream.Create; 185 | try 186 | IdHttp.Post(URI, OutStream, InStream); 187 | HttpHeader.Clear(); 188 | RawHeaders := IdHttp.Response.RawHeaders; 189 | for I := 0 to RawHeaders.Count - 1 do begin 190 | Key := RawHeaders.Names[I]; 191 | HttpHeader.Put(Key, RawHeaders.Values[Key]); 192 | end; 193 | Context['httpHeader'] := HttpHeader; 194 | Result := InStream.Bytes; 195 | SetLength(Result, InStream.Size); 196 | finally 197 | OutStream.Free; 198 | InStream.Free; 199 | end; 200 | IdHttp.Request.Clear; 201 | IdHttp.Request.CustomHeaders.Clear; 202 | IdHttp.Response.Clear; 203 | FHttpPool.Lock; 204 | try 205 | FHttpPool.Add(ObjToVar(IdHttp)); 206 | finally 207 | FHttpPool.Unlock; 208 | end; 209 | end; 210 | 211 | procedure Register; 212 | begin 213 | RegisterComponents('Hprose', [THproseHttpClient]); 214 | end; 215 | 216 | initialization 217 | CookieManager := TIdCookieManager.Create(nil); 218 | 219 | finalization 220 | FreeAndNil(CookieManager); 221 | end. 222 | -------------------------------------------------------------------------------- /Source/Indy10/HproseHttpClient.pas: -------------------------------------------------------------------------------- 1 | { 2 | /**********************************************************\ 3 | | | 4 | | hprose | 5 | | | 6 | | Official WebSite: http://www.hprose.com/ | 7 | | http://www.hprose.org/ | 8 | | | 9 | \**********************************************************/ 10 | 11 | /**********************************************************\ 12 | * * 13 | * HproseHttpClient.pas * 14 | * * 15 | * hprose indy http client unit for delphi. * 16 | * * 17 | * LastModified: Dec 9, 2016 * 18 | * Author: Ma Bingyao * 19 | * * 20 | \**********************************************************/ 21 | } 22 | unit HproseHttpClient; 23 | 24 | interface 25 | 26 | uses Classes, HproseCommon, HproseClient, IdHeaderList, SysUtils{$IFDEF FPC}, LResources{$ENDIF}; 27 | 28 | type 29 | 30 | THproseHttpClient = class(THproseClient) 31 | private 32 | FHttpPool: IList; 33 | FUserName: string; 34 | FPassword: string; 35 | FHeaders: IMap; 36 | FProxyHost: string; 37 | FProxyPort: Integer; 38 | FProxyUser: string; 39 | FProxyPass: string; 40 | FUserAgent: string; 41 | FKeepAlive: Boolean; 42 | FKeepAliveTimeout: Integer; 43 | FConnectionTimeout: Integer; 44 | protected 45 | function SendAndReceive(const Data: TBytes; 46 | const Context: TClientContext): TBytes; override; 47 | public 48 | constructor Create(AOwner: TComponent); override; 49 | destructor Destroy; override; 50 | published 51 | {:Before HTTP operation you may define any non-standard headers for HTTP 52 | request, except of: 'Expect: 100-continue', 'Content-Length', 'Content-Type', 53 | 'Connection', 'Authorization', 'Proxy-Authorization' and 'Host' headers.} 54 | property Headers: IMap read FHeaders; 55 | 56 | {:If @true (default value is @false), keepalives in HTTP protocol 1.1 is enabled.} 57 | property KeepAlive: Boolean read FKeepAlive write FKeepAlive; 58 | 59 | {:Define timeout for keepalives in seconds! Default value is 300.} 60 | property KeepAliveTimeout: integer read FKeepAliveTimeout write FKeepAliveTimeout; 61 | 62 | {:Address of proxy server (IP address or domain name).} 63 | property ProxyHost: string read FProxyHost Write FProxyHost; 64 | 65 | {:Port number for proxy connection. Default value is 8080.} 66 | property ProxyPort: Integer read FProxyPort Write FProxyPort; 67 | 68 | {:Username for connect to proxy server.} 69 | property ProxyUser: string read FProxyUser Write FProxyUser; 70 | 71 | {:Password for connect to proxy server.} 72 | property ProxyPass: string read FProxyPass Write FProxyPass; 73 | 74 | {:Here you can specify custom User-Agent indentification. By default is 75 | used: 'Hprose Http Client for Delphi (Indy10)'} 76 | property UserAgent: string read FUserAgent Write FUserAgent; 77 | 78 | {:UserName for user authorization.} 79 | property UserName: string read FUserName write FUserName; 80 | 81 | {:Password for user authorization.} 82 | property Password: string read FPassword write FPassword; 83 | 84 | {:Define timeout for ConnectionTimeout in milliseconds! Default value is 10000.} 85 | property ConnectionTimeout: Integer read FConnectionTimeout write FConnectionTimeout; 86 | end; 87 | 88 | procedure Register; 89 | 90 | implementation 91 | 92 | uses IdHttp, IdGlobalProtocols, IdCookieManager; 93 | 94 | var 95 | CookieManager: TIdCookieManager = nil; 96 | 97 | { THproseHttpClient } 98 | 99 | constructor THproseHttpClient.Create(AOwner: TComponent); 100 | begin 101 | inherited Create(AOwner); 102 | FHttpPool := TArrayList.Create(10); 103 | FHeaders := TCaseInsensitiveHashMap.Create; 104 | FUserName := ''; 105 | FPassword := ''; 106 | FKeepAlive := True; 107 | FKeepAliveTimeout := 300; 108 | FProxyHost := ''; 109 | FProxyPort := 8080; 110 | FProxyUser := ''; 111 | FProxyPass := ''; 112 | FUserAgent := 'Hprose Http Client for Delphi (Indy10)'; 113 | FConnectionTimeout := 10000; 114 | end; 115 | 116 | destructor THproseHttpClient.Destroy; 117 | var 118 | I: Integer; 119 | IdHttp: TIdHttp; 120 | begin 121 | FHttpPool.Lock; 122 | try 123 | for I := FHttpPool.Count - 1 downto 0 do begin 124 | IdHttp := TIdHttp(VarToObj(FHttpPool.Delete(I))); 125 | FreeAndNil(IdHttp); 126 | end; 127 | finally 128 | FHttpPool.Unlock; 129 | end; 130 | inherited; 131 | end; 132 | 133 | function THproseHttpClient.SendAndReceive(const Data: TBytes; 134 | const Context: TClientContext): TBytes; 135 | var 136 | IdHttp: TIdHttp; 137 | OutStream, InStream: TBytesStream; 138 | Header, HttpHeader: IMap; 139 | CustomHeaders, RawHeaders: TIdHeaderList; 140 | I: Integer; 141 | Key: string; 142 | begin 143 | FHttpPool.Lock; 144 | try 145 | if FHttpPool.Count > 0 then 146 | IdHttp := TIdHttp(VarToObj(FHttpPool.Delete(FHttpPool.Count - 1))) 147 | else begin 148 | IdHttp := TIdHttp.Create(nil); 149 | IdHttp.AllowCookies := True; 150 | IdHttp.CookieManager := CookieManager; 151 | IdHttp.HTTPOptions := IdHttp.HTTPOptions + [hoKeepOrigProtocol]; 152 | IdHttp.ProtocolVersion := pv1_1; 153 | end; 154 | finally 155 | FHttpPool.Unlock; 156 | end; 157 | IdHttp.ConnectTimeout := FConnectionTimeout; 158 | IdHttp.ReadTimeout := Context.Settings.Timeout; 159 | IdHttp.Request.UserAgent := FUserAgent; 160 | if FProxyHost <> '' then begin 161 | IdHttp.ProxyParams.ProxyServer := FProxyHost; 162 | IdHttp.ProxyParams.ProxyPort := FProxyPort; 163 | IdHttp.ProxyParams.ProxyUsername := FProxyUser; 164 | IdHttp.ProxyParams.ProxyPassword := FProxyPass; 165 | end; 166 | CustomHeaders := IdHttp.Request.CustomHeaders; 167 | if KeepAlive then begin 168 | IdHttp.Request.Connection := 'keep-alive'; 169 | CustomHeaders.Values['Keep-Alive'] := IntToStr(FKeepAliveTimeout); 170 | end 171 | else IdHttp.Request.Connection := 'close'; 172 | if FUserName <> '' then begin 173 | IdHttp.Request.BasicAuthentication := True; 174 | IdHttp.Request.UserName := FUserName; 175 | IdHttp.Request.Password := FPassword; 176 | end; 177 | IdHttp.Request.ContentType := 'application/hprose'; 178 | Header := TCaseInsensitiveHashMap.Create; 179 | Header.PutAll(FHeaders); 180 | HttpHeader := VarToMap(Context['httpHeader']); 181 | if (Assigned(HttpHeader)) then 182 | Header.PutAll(HttpHeader) 183 | else 184 | HttpHeader := TCaseInsensitiveHashMap.Create; 185 | for I := 0 to Header.Count - 1 do 186 | CustomHeaders.Values[Header.Keys[I]] := Header.Values[I]; 187 | OutStream := TBytesStream.Create(Data); 188 | InStream := TBytesStream.Create; 189 | try 190 | IdHttp.Post(URI, OutStream, InStream); 191 | HttpHeader.Clear(); 192 | RawHeaders := IdHttp.Response.RawHeaders; 193 | for I := 0 to RawHeaders.Count - 1 do begin 194 | Key := RawHeaders.Names[I]; 195 | HttpHeader.Put(Key, RawHeaders.Values[Key]); 196 | end; 197 | Context['httpHeader'] := HttpHeader; 198 | Result := InStream.Bytes; 199 | SetLength(Result, InStream.Size); 200 | finally 201 | OutStream.Free; 202 | InStream.Free; 203 | end; 204 | IdHttp.Request.Clear; 205 | IdHttp.Request.CustomHeaders.Clear; 206 | IdHttp.Response.Clear; 207 | FHttpPool.Lock; 208 | try 209 | FHttpPool.Add(ObjToVar(IdHttp)); 210 | finally 211 | FHttpPool.Unlock; 212 | end; 213 | end; 214 | 215 | procedure Register; 216 | begin 217 | RegisterComponents('Hprose', [THproseHttpClient]); 218 | end; 219 | 220 | initialization 221 | CookieManager := TIdCookieManager.Create(nil); 222 | {$IFDEF FPC} 223 | {$I Hprose.lrs} 224 | {$ENDIF} 225 | finalization 226 | FreeAndNil(CookieManager); 227 | end. 228 | -------------------------------------------------------------------------------- /Source/Indy10_5/HproseHttpClient.pas: -------------------------------------------------------------------------------- 1 | { 2 | /**********************************************************\ 3 | | | 4 | | hprose | 5 | | | 6 | | Official WebSite: http://www.hprose.com/ | 7 | | http://www.hprose.org/ | 8 | | | 9 | \**********************************************************/ 10 | 11 | /**********************************************************\ 12 | * * 13 | * HproseHttpClient.pas * 14 | * * 15 | * hprose indy http client unit for delphi. * 16 | * * 17 | * LastModified: Dec 9, 2016 * 18 | * Author: Ma Bingyao * 19 | * * 20 | \**********************************************************/ 21 | } 22 | unit HproseHttpClient; 23 | 24 | interface 25 | 26 | uses Classes, HproseCommon, HproseClient, IdHeaderList, SysUtils{$IFDEF FPC}, LResources{$ENDIF}; 27 | 28 | type 29 | 30 | THproseHttpClient = class(THproseClient) 31 | private 32 | FHttpPool: IList; 33 | FUserName: string; 34 | FPassword: string; 35 | FHeaders: IMap; 36 | FProxyHost: string; 37 | FProxyPort: Integer; 38 | FProxyUser: string; 39 | FProxyPass: string; 40 | FUserAgent: string; 41 | FKeepAlive: Boolean; 42 | FKeepAliveTimeout: Integer; 43 | FConnectionTimeout: Integer; 44 | protected 45 | function SendAndReceive(const Data: TBytes; 46 | const Context: TClientContext): TBytes; override; 47 | public 48 | constructor Create(AOwner: TComponent); override; 49 | destructor Destroy; override; 50 | published 51 | {:Before HTTP operation you may define any non-standard headers for HTTP 52 | request, except of: 'Expect: 100-continue', 'Content-Length', 'Content-Type', 53 | 'Connection', 'Authorization', 'Proxy-Authorization' and 'Host' headers.} 54 | property Headers: IMap read FHeaders; 55 | 56 | {:If @true (default value is @false), keepalives in HTTP protocol 1.1 is enabled.} 57 | property KeepAlive: Boolean read FKeepAlive write FKeepAlive; 58 | 59 | {:Define timeout for keepalives in seconds! Default value is 300.} 60 | property KeepAliveTimeout: integer read FKeepAliveTimeout write FKeepAliveTimeout; 61 | 62 | {:Address of proxy server (IP address or domain name).} 63 | property ProxyHost: string read FProxyHost Write FProxyHost; 64 | 65 | {:Port number for proxy connection. Default value is 8080.} 66 | property ProxyPort: Integer read FProxyPort Write FProxyPort; 67 | 68 | {:Username for connect to proxy server.} 69 | property ProxyUser: string read FProxyUser Write FProxyUser; 70 | 71 | {:Password for connect to proxy server.} 72 | property ProxyPass: string read FProxyPass Write FProxyPass; 73 | 74 | {:Here you can specify custom User-Agent indentification. By default is 75 | used: 'Hprose Http Client for Delphi (Indy10)'} 76 | property UserAgent: string read FUserAgent Write FUserAgent; 77 | 78 | {:UserName for user authorization.} 79 | property UserName: string read FUserName write FUserName; 80 | 81 | {:Password for user authorization.} 82 | property Password: string read FPassword write FPassword; 83 | 84 | {:Define timeout for ConnectionTimeout in milliseconds! Default value is 10000.} 85 | property ConnectionTimeout: Integer read FConnectionTimeout write FConnectionTimeout; 86 | end; 87 | 88 | procedure Register; 89 | 90 | implementation 91 | 92 | uses IdHttp, IdGlobalProtocols, IdCookieManager; 93 | 94 | var 95 | CookieManager: TIdCookieManager = nil; 96 | 97 | { THproseHttpClient } 98 | 99 | constructor THproseHttpClient.Create(AOwner: TComponent); 100 | begin 101 | inherited Create(AOwner); 102 | FHttpPool := TArrayList.Create(10); 103 | FHeaders := TCaseInsensitiveHashMap.Create; 104 | FUserName := ''; 105 | FPassword := ''; 106 | FKeepAlive := True; 107 | FKeepAliveTimeout := 300; 108 | FProxyHost := ''; 109 | FProxyPort := 8080; 110 | FProxyUser := ''; 111 | FProxyPass := ''; 112 | FUserAgent := 'Hprose Http Client for Delphi (Indy10)'; 113 | FConnectionTimeout := 10000; 114 | end; 115 | 116 | destructor THproseHttpClient.Destroy; 117 | var 118 | I: Integer; 119 | IdHttp: TIdHttp; 120 | begin 121 | FHttpPool.Lock; 122 | try 123 | for I := FHttpPool.Count - 1 downto 0 do begin 124 | IdHttp := TIdHttp(VarToObj(FHttpPool.Delete(I))); 125 | FreeAndNil(IdHttp); 126 | end; 127 | finally 128 | FHttpPool.Unlock; 129 | end; 130 | inherited; 131 | end; 132 | 133 | function THproseHttpClient.SendAndReceive(const Data: TBytes; 134 | const Context: TClientContext): TBytes; 135 | var 136 | IdHttp: TIdHttp; 137 | OutStream, InStream: TBytesStream; 138 | Header, HttpHeader: IMap; 139 | CustomHeaders, RawHeaders: TIdHeaderList; 140 | I: Integer; 141 | Key: string; 142 | begin 143 | FHttpPool.Lock; 144 | try 145 | if FHttpPool.Count > 0 then 146 | IdHttp := TIdHttp(VarToObj(FHttpPool.Delete(FHttpPool.Count - 1))) 147 | else begin 148 | IdHttp := TIdHttp.Create(nil); 149 | IdHttp.AllowCookies := True; 150 | IdHttp.CookieManager := CookieManager; 151 | IdHttp.HTTPOptions := IdHttp.HTTPOptions + [hoKeepOrigProtocol]; 152 | IdHttp.ProtocolVersion := pv1_1; 153 | end; 154 | finally 155 | FHttpPool.Unlock; 156 | end; 157 | IdHttp.ConnectTimeout := FConnectionTimeout; 158 | IdHttp.ReadTimeout := Context.Settings.Timeout; 159 | IdHttp.Request.UserAgent := FUserAgent; 160 | if FProxyHost <> '' then begin 161 | IdHttp.ProxyParams.ProxyServer := FProxyHost; 162 | IdHttp.ProxyParams.ProxyPort := FProxyPort; 163 | IdHttp.ProxyParams.ProxyUsername := FProxyUser; 164 | IdHttp.ProxyParams.ProxyPassword := FProxyPass; 165 | end; 166 | CustomHeaders := IdHttp.Request.CustomHeaders; 167 | if KeepAlive then begin 168 | IdHttp.Request.Connection := 'keep-alive'; 169 | CustomHeaders.Values['Keep-Alive'] := IntToStr(FKeepAliveTimeout); 170 | end 171 | else IdHttp.Request.Connection := 'close'; 172 | if FUserName <> '' then begin 173 | IdHttp.Request.BasicAuthentication := True; 174 | IdHttp.Request.UserName := FUserName; 175 | IdHttp.Request.Password := FPassword; 176 | end; 177 | IdHttp.Request.ContentType := 'application/hprose'; 178 | Header := TCaseInsensitiveHashMap.Create; 179 | Header.PutAll(FHeaders); 180 | HttpHeader := VarToMap(Context['httpHeader']); 181 | if (Assigned(HttpHeader)) then 182 | Header.PutAll(HttpHeader) 183 | else 184 | HttpHeader := TCaseInsensitiveHashMap.Create; 185 | for I := 0 to Header.Count - 1 do 186 | CustomHeaders.Values[Header.Keys[I]] := Header.Values[I]; 187 | OutStream := TBytesStream.Create(Data); 188 | InStream := TBytesStream.Create; 189 | try 190 | IdHttp.Post(URI, OutStream, InStream); 191 | HttpHeader.Clear(); 192 | RawHeaders := IdHttp.Response.RawHeaders; 193 | for I := 0 to RawHeaders.Count - 1 do begin 194 | Key := RawHeaders.Names[I]; 195 | HttpHeader.Put(Key, RawHeaders.Values[Key]); 196 | end; 197 | Context['httpHeader'] := HttpHeader; 198 | Result := InStream.Bytes; 199 | SetLength(Result, InStream.Size); 200 | finally 201 | OutStream.Free; 202 | InStream.Free; 203 | end; 204 | IdHttp.Request.Clear; 205 | IdHttp.Request.CustomHeaders.Clear; 206 | IdHttp.Response.Clear; 207 | FHttpPool.Lock; 208 | try 209 | FHttpPool.Add(ObjToVar(IdHttp)); 210 | finally 211 | FHttpPool.Unlock; 212 | end; 213 | end; 214 | 215 | procedure Register; 216 | begin 217 | RegisterComponents('Hprose', [THproseHttpClient]); 218 | end; 219 | 220 | initialization 221 | CookieManager := TIdCookieManager.Create(nil); 222 | {$IFDEF FPC} 223 | {$I Hprose.lrs} 224 | {$ENDIF} 225 | finalization 226 | FreeAndNil(CookieManager); 227 | end. 228 | -------------------------------------------------------------------------------- /Source/XE8/HproseHttpClient.pas: -------------------------------------------------------------------------------- 1 | { 2 | /**********************************************************\ 3 | | | 4 | | hprose | 5 | | | 6 | | Official WebSite: http://www.hprose.com/ | 7 | | http://www.hprose.org/ | 8 | | | 9 | \**********************************************************/ 10 | 11 | /**********************************************************\ 12 | * * 13 | * HproseHttpClient.pas * 14 | * * 15 | * hprose http client unit for delphi. * 16 | * * 17 | * LastModified: Dec 9, 2016 * 18 | * Author: Ma Bingyao * 19 | * * 20 | \**********************************************************/ 21 | } 22 | unit HproseHttpClient; 23 | 24 | interface 25 | 26 | uses Classes, HproseCommon, HproseClient, IdHeaderList, SysUtils, System.Net.HttpClient, System.Net.URLClient; 27 | 28 | type 29 | THproseHttpClient = class(THproseClient) 30 | private 31 | FHttpPool: IList; 32 | FUserName: string; 33 | FPassword: string; 34 | FHeaders: IMap; 35 | FProxyHost: string; 36 | FProxyPort: Integer; 37 | FProxyUser: string; 38 | FProxyPass: string; 39 | FUserAgent: string; 40 | FKeepAlive: Boolean; 41 | FKeepAliveTimeout: Integer; 42 | FConnectionTimeout: Integer; 43 | protected 44 | function SendAndReceive(const Data: TBytes; 45 | const Context: TClientContext): TBytes; override; 46 | public 47 | constructor Create(AOwner: TComponent); override; 48 | destructor Destroy; override; 49 | published 50 | {:Before HTTP operation you may define any non-standard headers for HTTP 51 | request, except of: 'Expect: 100-continue', 'Content-Length', 'Content-Type', 52 | 'Connection', 'Authorization', 'Proxy-Authorization' and 'Host' headers.} 53 | property Headers: IMap read FHeaders; 54 | 55 | {:If @true (default value is @false), keepalives in HTTP protocol 1.1 is enabled.} 56 | property KeepAlive: Boolean read FKeepAlive write FKeepAlive; 57 | 58 | {:Define timeout for keepalives in seconds! Default value is 300.} 59 | property KeepAliveTimeout: integer read FKeepAliveTimeout write FKeepAliveTimeout; 60 | 61 | {:Address of proxy server (IP address or domain name).} 62 | property ProxyHost: string read FProxyHost Write FProxyHost; 63 | 64 | {:Port number for proxy connection. Default value is 8080.} 65 | property ProxyPort: Integer read FProxyPort Write FProxyPort; 66 | 67 | {:Username for connect to proxy server.} 68 | property ProxyUser: string read FProxyUser Write FProxyUser; 69 | 70 | {:Password for connect to proxy server.} 71 | property ProxyPass: string read FProxyPass Write FProxyPass; 72 | 73 | {:Here you can specify custom User-Agent indentification. By default is 74 | used: 'Hprose Http Client for Delphi (Indy10)'} 75 | property UserAgent: string read FUserAgent Write FUserAgent; 76 | 77 | {:UserName for user authorization.} 78 | property UserName: string read FUserName write FUserName; 79 | 80 | {:Password for user authorization.} 81 | property Password: string read FPassword write FPassword; 82 | 83 | {:Define timeout for ConnectionTimeout in milliseconds! Default value is 10000.} 84 | property ConnectionTimeout: Integer read FConnectionTimeout write FConnectionTimeout; 85 | end; 86 | 87 | procedure Register; 88 | 89 | implementation 90 | 91 | var 92 | CookieManager: TCookieManager = nil; 93 | 94 | { THproseHttpClient } 95 | 96 | constructor THproseHttpClient.Create(AOwner: TComponent); 97 | begin 98 | inherited Create(AOwner); 99 | FHttpPool := TArrayList.Create(10); 100 | FHeaders := TCaseInsensitiveHashMap.Create; 101 | FUserName := ''; 102 | FPassword := ''; 103 | FKeepAlive := True; 104 | FKeepAliveTimeout := 300; 105 | FProxyHost := ''; 106 | FProxyPort := 8080; 107 | FProxyUser := ''; 108 | FProxyPass := ''; 109 | FUserAgent := 'Hprose Http Client for Delphi XE8+'; 110 | FConnectionTimeout := 10000; 111 | end; 112 | 113 | destructor THproseHttpClient.Destroy; 114 | var 115 | I: Integer; 116 | HttpClient: THTTPClient; 117 | begin 118 | FHttpPool.Lock; 119 | try 120 | for I := FHttpPool.Count - 1 downto 0 do begin 121 | HttpClient := THTTPClient(VarToObj(FHttpPool.Delete(I))); 122 | FreeAndNil(HttpClient); 123 | end; 124 | finally 125 | FHttpPool.Unlock; 126 | end; 127 | inherited; 128 | end; 129 | 130 | procedure ValidateServerCertificateCallback( 131 | const Sender: TObject; 132 | const ARequest: TURLRequest; 133 | const Certificate: TCertificate; 134 | var Accepted: Boolean); 135 | begin 136 | Accepted := True; 137 | end; 138 | 139 | function THproseHttpClient.SendAndReceive(const Data: TBytes; 140 | const Context: TClientContext): TBytes; 141 | var 142 | HttpClient: THTTPClient; 143 | ContentStream: TBytesStream; 144 | Header, HttpHeader: IMap; 145 | Request: IHTTPRequest; 146 | ResponseHeader: TNetHeaders; 147 | I: Integer; 148 | begin 149 | FHttpPool.Lock; 150 | try 151 | if FHttpPool.Count > 0 then 152 | HttpClient := THttpClient(VarToObj(FHttpPool.Delete(FHttpPool.Count - 1))) 153 | else begin 154 | HttpClient := THttpClient.Create(); 155 | HttpClient.AllowCookies := True; 156 | HttpClient.CookieManager := CookieManager; 157 | HttpClient.HandleRedirects := True; 158 | HttpClient.ValidateServerCertificateCallback := ValidateServerCertificateCallback; 159 | HttpClient.ContentType := 'application/hprose'; 160 | end; 161 | finally 162 | FHttpPool.Unlock; 163 | end; 164 | HttpClient.ConnectionTimeout := FConnectionTimeout; 165 | HttpClient.ResponseTimeout := Context.Settings.Timeout; 166 | if FProxyHost <> '' then begin 167 | HttpClient.ProxySettings := TProxySettings.Create(FProxyHost, FProxyPort, FProxyUser, FProxyPass); 168 | end; 169 | Request := HttpClient.GetRequest('POST', URI); 170 | Header := TCaseInsensitiveHashMap.Create; 171 | Header.PutAll(FHeaders); 172 | HttpHeader := VarToMap(Context['httpHeader']); 173 | if (Assigned(HttpHeader)) then 174 | Header.PutAll(HttpHeader) 175 | else 176 | HttpHeader := TCaseInsensitiveHashMap.Create; 177 | for I := 0 to Header.Count - 1 do 178 | Request.AddHeader(Header.Keys[I], Header.Values[I]); 179 | Request.UserAgent := FUserAgent; 180 | if KeepAlive then begin 181 | Request.HeaderValue['Connection'] := 'keep-alive'; 182 | Request.HeaderValue['Keep-Alive'] := IntToStr(FKeepAliveTimeout); 183 | end 184 | else begin 185 | Request.HeaderValue['Connection'] := 'close'; 186 | end; 187 | if FUserName <> '' then begin 188 | Request.SetCredential(FUserName, FPassword); 189 | end; 190 | Request.SourceStream := TBytesStream.Create(Data); 191 | Request.SourceStream.Position := 0; 192 | ContentStream := TBytesStream.Create; 193 | try 194 | ResponseHeader := HttpClient.Execute(Request, ContentStream).GetHeaders(); 195 | HttpHeader.Clear(); 196 | for I := 0 to Length(ResponseHeader) - 1 do begin 197 | HttpHeader.Put(ResponseHeader[I].Name, ResponseHeader[I].Value); 198 | end; 199 | Context['httpHeader'] := HttpHeader; 200 | Result := ContentStream.Bytes; 201 | SetLength(Result, ContentStream.Size); 202 | finally 203 | Request.SourceStream.Free; 204 | Request.SourceStream := nil; 205 | ContentStream.Free; 206 | end; 207 | FHttpPool.Lock; 208 | try 209 | FHttpPool.Add(ObjToVar(HttpClient)); 210 | finally 211 | FHttpPool.Unlock; 212 | end; 213 | end; 214 | 215 | procedure Register; 216 | begin 217 | RegisterComponents('Hprose', [THproseHttpClient]); 218 | end; 219 | 220 | initialization 221 | CookieManager := TCookieManager.Create(); 222 | 223 | finalization 224 | FreeAndNil(CookieManager); 225 | end. 226 | -------------------------------------------------------------------------------- /CppBuilder/HproseIndy9.cbproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | {9bc03013-2fe5-47df-9bf2-7285c81ebaba} 5 | HproseIndy9.cpp 6 | Release 7 | 8 | 9 | true 10 | 11 | 12 | true 13 | true 14 | Base 15 | 16 | 17 | true 18 | true 19 | Base 20 | 21 | 22 | bpl 23 | true 24 | JPHNE 25 | NO_STRICT 26 | true 27 | true 28 | true 29 | ..;..\Indy9;..\CppBuilder;..\..\delphi;..\Indy9 30 | true 31 | CppPackage 32 | false 33 | Hprose for C++ Builder with Indy9 34 | $(BDS)\include;$(BDS)\include\dinkumware;$(BDS)\include\vcl;..;..\Indy9;..\CppBuilder;..\..\delphi;..\Indy9 35 | $(BDS)\lib;$(BDS)\lib\obj;$(BDS)\lib\psdk;..;..\Indy9;..\CppBuilder;..\..\delphi;..\Indy9 36 | true 37 | 38 | 39 | false 40 | false 41 | true 42 | _DEBUG;$(Defines) 43 | true 44 | false 45 | true 46 | None 47 | DEBUG 48 | true 49 | Debug 50 | true 51 | true 52 | true 53 | $(BDS)\lib\debug;$(ILINK_LibraryPath) 54 | Full 55 | true 56 | 57 | 58 | NDEBUG;$(Defines) 59 | Release 60 | $(BDS)\lib\release;$(ILINK_LibraryPath) 61 | None 62 | 63 | 64 | CPlusPlusBuilder.Personality 65 | CppPackage 66 | 67 | HproseIndy9.cppTrueFalse1300FalseFalseFalseFalseFalse2052936HPRFC1.3.0.0Hprose1.0.0.0FalseFalseFalseTrueFalseFalseTrueTrue1$(BDS)\include;$(BDS)\include\dinkumware;$(BDS)\include\vcl;..;..\Indy9;..\CppBuilder;..\..\delphi;..\Indy91$(BDS)\lib\release;$(BDS)\lib;$(BDS)\lib\obj;$(BDS)\lib\psdk;..;..\Indy9;..\CppBuilder;..\..\delphi;..\Indy91NDEBUG;NO_STRICT1Release12501010x2001409610x0040000010x0000100010x0010000010x0000200010x0010000010181921121110 68 | 69 | 70 | 71 | 72 | 0 73 | 74 | 75 | 1 76 | 77 | 78 | 2 79 | 80 | 81 | 3 82 | 83 | 84 | 4 85 | 86 | 87 | 5 88 | 89 | 90 | 6 91 | 92 | 93 | 7 94 | 95 | 96 | 8 97 | 98 | 99 | Cfg_1 100 | 101 | 102 | Cfg_2 103 | 104 | 105 | -------------------------------------------------------------------------------- /CppBuilder/HproseIndy10.cbproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | {9bc03013-2fe5-47df-9bf2-7285c81ebaba} 5 | HproseIndy10.cpp 6 | Release 7 | 8 | 9 | true 10 | 11 | 12 | true 13 | true 14 | Base 15 | 16 | 17 | true 18 | true 19 | Base 20 | 21 | 22 | bpl 23 | true 24 | JPHNE 25 | NO_STRICT 26 | true 27 | true 28 | true 29 | ..;..\Indy10;..\CppBuilder;..\..\delphi;..\Indy10 30 | true 31 | CppPackage 32 | false 33 | Hprose for C++ Builder with Indy10 34 | $(BDS)\include;$(BDS)\include\dinkumware;$(BDS)\include\vcl;..;..\Indy10;..\CppBuilder;..\..\delphi;..\Indy10 35 | $(BDS)\lib;$(BDS)\lib\obj;$(BDS)\lib\psdk;..;..\Indy10;..\CppBuilder;..\..\delphi;..\Indy10 36 | true 37 | 38 | 39 | false 40 | false 41 | true 42 | _DEBUG;$(Defines) 43 | true 44 | false 45 | true 46 | None 47 | DEBUG 48 | true 49 | Debug 50 | true 51 | true 52 | true 53 | $(BDS)\lib\debug;$(ILINK_LibraryPath) 54 | Full 55 | true 56 | 57 | 58 | NDEBUG;$(Defines) 59 | Release 60 | $(BDS)\lib\release;$(ILINK_LibraryPath) 61 | None 62 | 63 | 64 | CPlusPlusBuilder.Personality 65 | CppPackage 66 | 67 | HproseIndy10.cppTrueFalse1300FalseFalseFalseFalseFalse2052936HPRFC1.3.0.0Hprose1.0.0.0FalseFalseFalseTrueFalseFalseTrueTrue1$(BDS)\include;$(BDS)\include\dinkumware;$(BDS)\include\vcl;..;..\Indy10;..\CppBuilder;..\..\delphi;..\Indy101$(BDS)\lib\release;$(BDS)\lib;$(BDS)\lib\obj;$(BDS)\lib\psdk;..;..\Indy10;..\CppBuilder;..\..\delphi;..\Indy101NDEBUG;NO_STRICT1Release12501010x2001409610x0040000010x0000100010x0010000010x0000200010x0010000010181921121110 68 | 69 | 70 | 71 | 72 | 0 73 | 74 | 75 | 1 76 | 77 | 78 | 2 79 | 80 | 81 | 3 82 | 83 | 84 | 4 85 | 86 | 87 | 5 88 | 89 | 90 | 6 91 | 92 | 93 | 7 94 | 95 | 96 | 8 97 | 98 | 99 | 9 100 | 101 | 102 | 10 103 | 104 | 105 | Cfg_1 106 | 107 | 108 | Cfg_2 109 | 110 | 111 | -------------------------------------------------------------------------------- /Source/Synapse/HproseHttpClient.pas: -------------------------------------------------------------------------------- 1 | { 2 | /**********************************************************\ 3 | | | 4 | | hprose | 5 | | | 6 | | Official WebSite: http://www.hprose.com/ | 7 | | http://www.hprose.org/ | 8 | | | 9 | \**********************************************************/ 10 | 11 | /**********************************************************\ 12 | * * 13 | * HproseHttpClient.pas * 14 | * * 15 | * hprose synapse http client unit for delphi. * 16 | * * 17 | * LastModified: Dec 9, 2016 * 18 | * Author: Ma Bingyao * 19 | * * 20 | \**********************************************************/ 21 | } 22 | unit HproseHttpClient; 23 | 24 | interface 25 | 26 | uses Classes, HproseCommon, HproseClient, SysUtils{$IFDEF FPC}, LResources{$ENDIF}; 27 | 28 | type 29 | 30 | { THproseHttpClient } 31 | 32 | THproseHttpClient = class(THproseClient) 33 | private 34 | FHttpPool: IList; 35 | FProtocol: string; 36 | FUser: string; 37 | FPassword: string; 38 | FHost: string; 39 | FPort: string; 40 | FPath: string; 41 | FPara: string; 42 | FHeaders: IMap; 43 | FKeepAlive: Boolean; 44 | FKeepAliveTimeout: Integer; 45 | FProxyHost: string; 46 | FProxyPort: Integer; 47 | FProxyUser: string; 48 | FProxyPass: string; 49 | FUserAgent: string; 50 | FConnectionTimeout: Integer; 51 | protected 52 | function SendAndReceive(const Data: TBytes; 53 | const Context: TClientContext): TBytes; override; 54 | procedure InitURI(const AValue: string); override; 55 | public 56 | constructor Create(AOwner: TComponent); override; 57 | destructor Destroy; override; 58 | published 59 | {:Before HTTP operation you may define any non-standard headers for HTTP 60 | request, except of: 'Expect: 100-continue', 'Content-Length', 'Content-Type', 61 | 'Connection', 'Authorization', 'Proxy-Authorization' and 'Host' headers.} 62 | property Headers: IMap read FHeaders; 63 | 64 | {:If @true (default value is @true), keepalives in HTTP protocol 1.1 is enabled.} 65 | property KeepAlive: Boolean read FKeepAlive write FKeepAlive; 66 | 67 | {:Define timeout for keepalives in seconds! Default value is 300.} 68 | property KeepAliveTimeout: Integer read FKeepAliveTimeout write FKeepAliveTimeout; 69 | 70 | {:Address of proxy server (IP address or domain name).} 71 | property ProxyHost: string read FProxyHost write FProxyHost; 72 | 73 | {:Port number for proxy connection. Default value is 8080.} 74 | property ProxyPort: Integer read FProxyPort write FProxyPort; 75 | 76 | {:Username for connect to proxy server.} 77 | property ProxyUser: string read FProxyUser write FProxyUser; 78 | 79 | {:Password for connect to proxy server.} 80 | property ProxyPass: string read FProxyPass write FProxyPass; 81 | 82 | {:Here you can specify custom User-Agent indentification. By default is 83 | used: 'Hprose Http Client for Delphi (Synapse)'} 84 | property UserAgent: string read FUserAgent write FUserAgent; 85 | 86 | {:UserName for user authorization.} 87 | property UserName: string read FUser write FUser; 88 | 89 | {:Password for user authorization.} 90 | property Password: string read FPassword write FPassword; 91 | 92 | {:Define timeout for ConnectionTimeout in milliseconds! Default value is 10000.} 93 | property ConnectionTimeout: Integer read FConnectionTimeout write FConnectionTimeout; 94 | end; 95 | 96 | procedure Register; 97 | 98 | implementation 99 | 100 | uses httpsend, synautil, Variants; 101 | 102 | var 103 | cookieManager: IMap; 104 | 105 | procedure SetCookie(Header: IMap; const Host: string); 106 | var 107 | I, Pos: Integer; 108 | Name, Value, CookieString, Path: string; 109 | Cookie: IMap; 110 | begin 111 | for I := 0 to Header.Count - 1 do begin 112 | Name := LowerCase(Header.Keys[I]); 113 | if (Name = 'set-cookie') or (Name = 'set-cookie2') then begin 114 | Value := Header.Values[I]; 115 | Pos := AnsiPos(';', Value); 116 | CookieString := Copy(Value, 1, Pos - 1); 117 | Value := Copy(Value, Pos + 1, MaxInt); 118 | Cookie := TCaseInsensitiveHashMap.Split(Value, ';', '=', 0, True, False, True); 119 | Pos := AnsiPos('=', CookieString); 120 | Cookie['name'] := Copy(CookieString, 1, Pos - 1); 121 | Cookie['value'] := Copy(CookieString, Pos + 1, MaxInt); 122 | if Cookie.ContainsKey('path') then begin 123 | Path := Cookie['path']; 124 | if (Length(Path) > 0) then begin 125 | if (Path[1] = '"') then Delete(Path, 1, 1); 126 | if (Path[Length(Path)] = '"') then SetLength(Path, Length(Path) - 1); 127 | end; 128 | if (Length(Path) > 0) then 129 | Cookie['path'] := Path 130 | else 131 | Cookie['path'] := '/'; 132 | end 133 | else 134 | Cookie['path'] := '/'; 135 | if Cookie.ContainsKey('expires') then begin 136 | Cookie['expires'] := DecodeRfcDateTime(Cookie['expires']); 137 | end; 138 | if Cookie.ContainsKey('domain') then 139 | Cookie['domain'] := LowerCase(Cookie['domain']) 140 | else 141 | Cookie['domain'] := Host; 142 | Cookie['secure'] := Cookie.ContainsKey('secure'); 143 | CookieManager.BeginWrite; 144 | try 145 | if not CookieManager.ContainsKey(Cookie['domain']) then 146 | CookieManager[Cookie['domain']] := THashMap.Create(False, True) as IMap; 147 | VarToMap(CookieManager[Cookie['domain']])[Cookie['name']] := Cookie; 148 | finally 149 | CookieManager.EndWrite; 150 | end; 151 | end; 152 | end; 153 | end; 154 | 155 | function GetCookie(const Host, Path: string; Secure: Boolean): string; 156 | var 157 | Cookies, CookieMap, Cookie: IMap; 158 | Names: IList; 159 | Domain: string; 160 | I, J: Integer; 161 | begin 162 | Cookies := THashMap.Create(False); 163 | CookieManager.BeginRead; 164 | try 165 | for I := 0 to CookieManager.Count - 1 do begin 166 | Domain := VarToStr(CookieManager.Keys[I]); 167 | if AnsiPos(Domain, Host) <> 0 then begin 168 | CookieMap := VarToMap(CookieManager.Values[I]); 169 | CookieMap.BeginRead; 170 | try 171 | Names := TArrayList.Create(False); 172 | for J := 0 to CookieMap.Count - 1 do begin 173 | Cookie := VarToMap(CookieMap.Values[J]); 174 | if Cookie.ContainsKey('expires') and (Cookie['expires'] < Now) then 175 | Names.Add(Cookie['name']) 176 | else if AnsiPos(Cookie['path'], Path) = 1 then begin 177 | if ((Secure and Cookie['secure']) or not Cookie['secure']) and 178 | (Cookie['value'] <> '') then 179 | Cookies[Cookie['name']] := Cookie['value']; 180 | end; 181 | end; 182 | finally 183 | CookieMap.EndRead; 184 | end; 185 | if Names.Count > 0 then begin 186 | CookieMap.BeginWrite; 187 | try 188 | for J := 0 to Names.Count - 1 do CookieMap.Delete(Names[J]); 189 | finally 190 | CookieMap.EndWrite; 191 | end; 192 | end; 193 | end; 194 | end; 195 | Result := Cookies.Join('; '); 196 | finally 197 | CookieManager.EndRead; 198 | end; 199 | end; 200 | 201 | { THproseHttpClient } 202 | 203 | function THproseHttpClient.SendAndReceive(const Data: TBytes; 204 | const Context: TClientContext): TBytes; 205 | var 206 | HttpSend: THttpSend; 207 | Cookie: string; 208 | Error: string; 209 | Header, HttpHeader: IMap; 210 | I: Integer; 211 | K, V: string; 212 | begin 213 | FHttpPool.Lock; 214 | try 215 | if FHttpPool.Count > 0 then 216 | HttpSend := THttpSend(VarToObj(FHttpPool.Delete(FHttpPool.Count - 1))) 217 | else 218 | HttpSend := THttpSend.Create; 219 | finally 220 | FHttpPool.Unlock; 221 | end; 222 | Header := TCaseInsensitiveHashMap.Create; 223 | Header.PutAll(FHeaders); 224 | HttpHeader := VarToMap(Context['httpHeader']); 225 | if (Assigned(HttpHeader)) then 226 | Header.PutAll(HttpHeader) 227 | else 228 | HttpHeader := TCaseInsensitiveHashMap.Create; 229 | for I := 0 to Header.Count - 1 do 230 | HttpSend.Headers.Values[Header.Keys[I]] := Header.Values[I]; 231 | HttpSend.KeepAlive := FKeepAlive; 232 | HttpSend.KeepAliveTimeout := FKeepAliveTimeout; 233 | HttpSend.UserName := FUser; 234 | HttpSend.Password := FPassword; 235 | HttpSend.ProxyHost := FProxyHost; 236 | if FProxyPort = 0 then 237 | HttpSend.ProxyPort := '' 238 | else 239 | HttpSend.ProxyPort := IntToStr(FProxyPort); 240 | HttpSend.ProxyUser := FProxyUser; 241 | HttpSend.ProxyPass := FProxyPass; 242 | HttpSend.UserAgent := FUserAgent; 243 | HttpSend.Sock.ConnectionTimeout := FConnectionTimeout; 244 | HttpSend.Timeout := Context.Settings.Timeout; 245 | HttpSend.Protocol := '1.1'; 246 | HttpSend.MimeType := 'application/hprose'; 247 | Cookie := GetCookie(FHost, 248 | FPath, 249 | LowerCase(FProtocol) = 'https'); 250 | if Cookie <> '' then HttpSend.Headers.Add('Cookie: ' + Cookie); 251 | HttpSend.Document.WriteBuffer(Data[0], Length(Data)); 252 | if (HttpSend.HTTPMethod('POST', URI)) then begin 253 | HttpHeader.Clear(); 254 | for I := 0 to HttpSend.Headers.Count - 1 do begin 255 | K := HttpSend.Headers.Names[I]; 256 | V := HttpSend.Headers.Values[K]; 257 | HttpHeader.Put(K, V); 258 | end; 259 | Context['httpHeader'] := HttpHeader; 260 | SetCookie(HttpHeader, FHost); 261 | SetLength(Result, HttpSend.Document.Size); 262 | Move(HttpSend.Document.Memory^, Result[0], Length(Result)); 263 | HttpSend.Clear; 264 | HttpSend.Cookies.Clear; 265 | FHttpPool.Lock; 266 | try 267 | FHttpPool.Add(ObjToVar(HttpSend)); 268 | finally 269 | FHttpPool.Unlock; 270 | end; 271 | end 272 | else begin 273 | Error := IntToStr(HttpSend.Sock.LastError) + ':' + HttpSend.Sock.LastErrorDesc; 274 | FreeAndNil(HttpSend); 275 | raise Exception.Create(Error); 276 | end; 277 | end; 278 | 279 | constructor THproseHttpClient.Create(AOwner: TComponent); 280 | begin 281 | inherited Create(AOwner); 282 | FHttpPool := TArrayList.Create(10); 283 | FHeaders := TCaseInsensitiveHashMap.Create; 284 | FUser := ''; 285 | FPassword := ''; 286 | FKeepAlive := True; 287 | FKeepAliveTimeout := 300; 288 | FProxyHost := ''; 289 | FProxyPort := 8080; 290 | FProxyUser := ''; 291 | FProxyPass := ''; 292 | FUserAgent := 'Hprose Http Client for Delphi (Synapse)'; 293 | FConnectionTimeout := 10000; 294 | end; 295 | 296 | destructor THproseHttpClient.Destroy; 297 | var 298 | I: Integer; 299 | begin 300 | FHttpPool.Lock; 301 | try 302 | for I := FHttpPool.Count - 1 downto 0 do 303 | THTTPSend(VarToObj(FHttpPool.Delete(I))).Free; 304 | finally 305 | FHttpPool.Unlock; 306 | end; 307 | inherited; 308 | end; 309 | 310 | procedure THproseHttpClient.InitURI(const AValue: string); 311 | begin 312 | inherited InitURI(AValue); 313 | ParseURL(URI, FProtocol, FUser, FPassword, FHost, FPort, FPath, FPara); 314 | end; 315 | 316 | procedure Register; 317 | begin 318 | RegisterComponents('Hprose',[THproseHttpClient]); 319 | end; 320 | 321 | initialization 322 | CookieManager := TCaseInsensitiveHashMap.Create(False, True); 323 | {$IFDEF FPC} 324 | {$I Hprose.lrs} 325 | {$ENDIF} 326 | end. 327 | -------------------------------------------------------------------------------- /Lazarus/Hprose.lrs: -------------------------------------------------------------------------------- 1 | LazarusResources.Add('THproseHttpClient','PNG',[ 2 | #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#3#0#0#0#215#169#205 3 | +#202#0#0#0#3'sBIT'#8#8#8#219#225'O'#224#0#0#1'5PLTE'#238#238#238#234#234#234 4 | +#233#233#233#229#229#229#226#226#226#225#225#225#222#222#222#221#221#221#220 5 | +#220#220#218#218#218#217#217#217#215#215#215#213#213#213#212#212#212#211#211 6 | +#211#210#210#210#209#209#209#208#208#208#207#207#207#206#206#206#205#205#205 7 | +#204#204#204#203#203#203#200#200#200#199#199#199#196#196#196#194#194#194'Q' 8 | +#234'b'#189#189#189#186#186#186#184#184#184#183#183#183#181#181#181#179#179 9 | +#179#176#176#176#175#175#175's'#186#238'f'#202's'#172#172#172#171#171#171'd' 10 | +#184#244#168#168#168#167#167#167'_'#178#238#164#164#164#162#162#162#161#161 11 | +#161'\'#174#234'3'#204'3'#159#159#159#158#158#158'Y'#172#232'T'#171#231'p' 12 | +#172'v'#153#153#153'Y'#165#225'O'#164#224'Q'#163#223#147#147#147'O'#155#215 13 | +'J'#157#217'H'#153#213#139#139#139'S'#150#202'I'#151#211'D'#150#210#135#135 14 | +#135'F'#146#206'D'#144#204'A'#145#205#132#132#132'I'#142#195#131#131#131'B' 15 | +#142#202#129#129#129'>'#138#198'='#138#198'<'#138#198'3'#153'<;'#137#197'3' 16 | +#151'@9'#133#193'6'#130#190'sss3'#127#187'.z'#182'.{'#183'nnn5x'#172'*v'#178 17 | +'jjj3p:\\\YYYXXXUUUTTTLLL>>>333'#0#0#128#0#0#0#255#255#255#136#245#238'n'#0#0 18 | +#0'gtRNS'#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 19 | +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 20 | +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 21 | +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 22 | +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 23 | +#255#255#255#255#255#255#255#255#255#0#20#22#186'x'#0#0#0#9'pHYs'#0#0#11#18#0 24 | +#0#11#18#1#210#221'~'#252#0#0#0#22'tEXtCreation Time'#0'05/29/14U[!u'#0#0#0 25 | +#28'tEXtSoftware'#0'Adobe Fireworks CS6'#232#188#178#140#0#0#1'#IDAT('#145'c' 26 | +'H'#195#1#24#210'R@0'#5#3'C%P`'#26#8'3 '#169'JC'#210#13'3*-'#13'E}J'#26#186#4 27 | +#178#29'8]'#149#10#132'H@L'#22#8#196#192#18#169'@'#9'QY'#24#144'cdff'#148#131 28 | +#235#0'q'#193#128'QAJBBJ'#1'$'#1#6#10','#17'!A'#129#222'.'#246',J,'#236#236 29 | +',Jp'#163#20#217'B'#205'A'#192#154'MMVFFV'#13#172#3'd'#183'2W'#164#179#167 30 | +#143#143#143#3#151#22'7??'#183#22'\B'#141'7'#204#213#209#198#194'D'#159'WWD' 31 | +#202'LD'#15'n'#135#150#144#187#173#165#177#182#134#138#144#153#184#140#128 32 | +#184#25#220#14#29#17#17'>nNN'#30'A'#193#216'x '#136#131#27'%odddhh'#8'$'#195 33 | +#195#163#12#194#195#225#18'@`'#165#174#174'n'#149#150#22#236#228#225#225#20 34 | +#12#183#3#8#188#156#156#156#188#210#210'bb'#18#19'cb'#224'v '#3'77'#172#129 35 | +#152#166#26#16#160#154#6#215#193#192'!'#169'i'#23#158#144#148#156#156#28'--' 36 | +#29#157#12#209#1#1'L'#172#156#188#194#162#162#162#166'~~'#166#162#200#150#163 37 | +#1#0'L'#219#182'h'#250#155#7#198#0#0#0#0'IEND'#174'B`'#130 38 | ]); 39 | LazarusResources.Add('THproseHttpServer','PNG',[ 40 | #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#3#0#0#0#215#169#205 41 | +#202#0#0#0#3'sBIT'#8#8#8#219#225'O'#224#0#0#1'5PLTE'#238#238#238#234#234#234 42 | +#233#233#233#229#229#229#226#226#226#225#225#225#222#222#222#221#221#221#220 43 | +#220#220#218#218#218#217#217#217#215#215#215#213#213#213#212#212#212#211#211 44 | +#211#210#210#210#209#209#209#208#208#208#207#207#207#206#206#206#205#205#205 45 | +#204#204#204#203#203#203#200#200#200#199#199#199#196#196#196#194#194#194'Q' 46 | +#234'b'#189#189#189#186#186#186#184#184#184#183#183#183#181#181#181#179#179 47 | +#179#176#176#176#175#175#175's'#186#238'f'#202's'#172#172#172#171#171#171'd' 48 | +#184#244#168#168#168#167#167#167'_'#178#238#164#164#164#162#162#162#161#161 49 | +#161'\'#174#234'3'#204'3'#159#159#159#158#158#158'Y'#172#232'T'#171#231'p' 50 | +#172'v'#153#153#153'Y'#165#225'O'#164#224'Q'#163#223#147#147#147'O'#155#215 51 | +'J'#157#217'H'#153#213#139#139#139'S'#150#202'I'#151#211'D'#150#210#135#135 52 | +#135'F'#146#206'D'#144#204'A'#145#205#132#132#132'I'#142#195#131#131#131'B' 53 | +#142#202#129#129#129'>'#138#198'='#138#198'<'#138#198'3'#153'<;'#137#197'3' 54 | +#151'@9'#133#193'6'#130#190'sss3'#127#187'.z'#182'.{'#183'nnn5x'#172'*v'#178 55 | +'jjj3p:\\\YYYXXXUUUTTTLLL>>>333'#0#0#128#0#0#0#255#255#255#136#245#238'n'#0#0 56 | +#0'gtRNS'#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 57 | +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 58 | +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 59 | +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 60 | +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 61 | +#255#255#255#255#255#255#255#255#255#0#20#22#186'x'#0#0#0#9'pHYs'#0#0#11#18#0 62 | +#0#11#18#1#210#221'~'#252#0#0#0#22'tEXtCreation Time'#0'05/29/14U[!u'#0#0#0 63 | +#28'tEXtSoftware'#0'Adobe Fireworks CS6'#232#188#178#140#0#0#1'''IDAT('#145 64 | +'cH'#195#1#24#210'R@0'#5#3'C%P`'#26#8'3 '#169'JC'#210#13'3*-'#13'E}J'#26#186 65 | +#4#178#29'8]'#133#4#196'd'#129'@,--'#21#8#129#18#162#178'0 '#199#200#204#204 66 | +'('#7#148'H'#5'K'#128#184'`'#192#168' %!!'#165#0#215#161#192#18#17#18#20#232 67 | +#237'b'#207#162#196#194#206#206#162#4#183'C'#145'-'#212#28#4#172#217#212'ded' 68 | +'d'#213#224'F)sE:{'#250#248#248'8piq'#243#243'sk'#165#129#204#2'I'#168#241 69 | +#134#185':'#218'X'#152#232#243#234#138'H'#153#137#232#193'%'#180#132#220'm-' 70 | +#141#181'5T'#132#204#196'e'#4#196#205#224'v'#232#136#136#240'qsr'#242#8#10 71 | +#198#198#3'A'#28#220#14'y###CCC '#25#30#30'e'#16#30#14'7'#10#8#172#212#213 72 | +#213#173#210#210#130#157'<<'#156#130#145'%'#188#156#156#156#188#210#210'bb' 73 | +#18#19'cb'#176#132'UZ'#154#155#27#136#132#218#129#4'T'#3#2'T'#211#224'A'#194 74 | +#192'!'#169'i'#23#158#144#148#156#156#28'--'#29#157#140#172#131#137#149#147 75 | +'WXTT'#212#212#207#207'T'#20'l7'#186#29#8#0#0#148#198#182'h'#151'6'#222#20#0 76 | +#0#0#0'IEND'#174'B`'#130 77 | ]); 78 | LazarusResources.Add('THproseTcpClient','PNG',[ 79 | #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#3#0#0#0#215#169#205 80 | +#202#0#0#0#3'sBIT'#8#8#8#219#225'O'#224#0#0#1'5PLTE'#238#238#238#234#234#234 81 | +#233#233#233#229#229#229#226#226#226#225#225#225#222#222#222#221#221#221#220 82 | +#220#220#218#218#218#217#217#217#215#215#215#213#213#213#212#212#212#211#211 83 | +#211#210#210#210#209#209#209#208#208#208#207#207#207#206#206#206#205#205#205 84 | +#204#204#204#203#203#203#200#200#200#199#199#199#196#196#196#194#194#194'Q' 85 | +#234'b'#189#189#189#186#186#186#184#184#184#183#183#183#181#181#181#179#179 86 | +#179#176#176#176#175#175#175's'#186#238'f'#202's'#172#172#172#171#171#171'd' 87 | +#184#244#168#168#168#167#167#167'_'#178#238#164#164#164#162#162#162#161#161 88 | +#161'\'#174#234'3'#204'3'#159#159#159#158#158#158'Y'#172#232'T'#171#231'p' 89 | +#172'v'#153#153#153'Y'#165#225'O'#164#224'Q'#163#223#147#147#147'O'#155#215 90 | +'J'#157#217'H'#153#213#139#139#139'S'#150#202'I'#151#211'D'#150#210#135#135 91 | +#135'F'#146#206'D'#144#204'A'#145#205#132#132#132'I'#142#195#131#131#131'B' 92 | +#142#202#129#129#129'>'#138#198'='#138#198'<'#138#198'3'#153'<;'#137#197'3' 93 | +#151'@9'#133#193'6'#130#190'sss3'#127#187'.z'#182'.{'#183'nnn5x'#172'*v'#178 94 | +'jjj3p:\\\YYYXXXUUUTTTLLL>>>333'#0#0#128#0#0#0#255#255#255#136#245#238'n'#0#0 95 | +#0'gtRNS'#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 96 | +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 97 | +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 98 | +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 99 | +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 100 | +#255#255#255#255#255#255#255#255#255#0#20#22#186'x'#0#0#0#9'pHYs'#0#0#11#18#0 101 | +#0#11#18#1#210#221'~'#252#0#0#0#22'tEXtCreation Time'#0'05/29/14U[!u'#0#0#0 102 | +#28'tEXtSoftware'#0'Adobe Fireworks CS6'#232#188#178#140#0#0#1'''IDAT('#145 103 | +'cH'#195#1#24#210'R@0'#5#3'C%P`'#26#8'3 '#169'JC'#210#13'3*-'#13'E}J'#26#186 104 | +#4#178#29'8]'#133#6#196'd'#129'@'#12'$'#145#154#154#154#150'&*'#11#3'r'#140 105 | +#204#204#140'r`'#29'@'#241'4'#16#23#12#24#21#164'$$'#164#20#224#18#10','#17 106 | +'!A'#129#222'.'#246',J,'#236#236',Jp'#9'E'#182'Ps'#16#176'fS'#147#149#145#145 107 | +'U'#131'['#174#204#21#233#236#233#227#227#227#192#165#197#205#207#207#173#5 108 | +#183'\'#141'7'#204#213#209#198#194'D'#159'WWD'#202'LD'#15','#1#210#161'%'#228 109 | +'nki'#172#173#161'"d&.# n'#6#151#208#17#17#225#227#230#228#228#17#20#140#141 110 | +#7#130'8'#184'Q'#242'FFF'#134#134#134'@2<<'#202' <'#28#217#231'V'#234#234#234 111 | +'Vii'#193'N'#30#30'N'#193'p'#29'@'#224#229#228#228#228#149#150#22#19#147#152 112 | +#24#19#3#177'#'#21'5'#180#220#220' '#129#8#211#1#3#170#1#1#170'ipW1pHj'#218 113 | +#133'''$%''''GKKG'''#195'%'#128#128#137#149#147'WXTT'#212#212#207#207'T'#20 114 | +'K|'#192#0#0'P'#161#182'j'#231'o/&'#0#0#0#0'IEND'#174'B`'#130 115 | ]); 116 | LazarusResources.Add('THproseTcpServer','PNG',[ 117 | #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#3#0#0#0#215#169#205 118 | +#202#0#0#0#3'sBIT'#8#8#8#219#225'O'#224#0#0#1'5PLTE'#238#238#238#234#234#234 119 | +#233#233#233#229#229#229#226#226#226#225#225#225#222#222#222#221#221#221#220 120 | +#220#220#218#218#218#217#217#217#215#215#215#213#213#213#212#212#212#211#211 121 | +#211#210#210#210#209#209#209#208#208#208#207#207#207#206#206#206#205#205#205 122 | +#204#204#204#203#203#203#200#200#200#199#199#199#196#196#196#194#194#194'Q' 123 | +#234'b'#189#189#189#186#186#186#184#184#184#183#183#183#181#181#181#179#179 124 | +#179#176#176#176#175#175#175's'#186#238'f'#202's'#172#172#172#171#171#171'd' 125 | +#184#244#168#168#168#167#167#167'_'#178#238#164#164#164#162#162#162#161#161 126 | +#161'\'#174#234'3'#204'3'#159#159#159#158#158#158'Y'#172#232'T'#171#231'p' 127 | +#172'v'#153#153#153'Y'#165#225'O'#164#224'Q'#163#223#147#147#147'O'#155#215 128 | +'J'#157#217'H'#153#213#139#139#139'S'#150#202'I'#151#211'D'#150#210#135#135 129 | +#135'F'#146#206'D'#144#204'A'#145#205#132#132#132'I'#142#195#131#131#131'B' 130 | +#142#202#129#129#129'>'#138#198'='#138#198'<'#138#198'3'#153'<;'#137#197'3' 131 | +#151'@9'#133#193'6'#130#190'sss3'#127#187'.z'#182'.{'#183'nnn5x'#172'*v'#178 132 | +'jjj3p:\\\YYYXXXUUUTTTLLL>>>333'#0#0#128#0#0#0#255#255#255#136#245#238'n'#0#0 133 | +#0'gtRNS'#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 134 | +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 135 | +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 136 | +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 137 | +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255 138 | +#255#255#255#255#255#255#255#255#255#0#20#22#186'x'#0#0#0#9'pHYs'#0#0#11#18#0 139 | +#0#11#18#1#210#221'~'#252#0#0#0#22'tEXtCreation Time'#0'05/29/14U[!u'#0#0#0 140 | +#28'tEXtSoftware'#0'Adobe Fireworks CS6'#232#188#178#140#0#0#1'#IDAT('#145'u' 141 | +#144#139'R'#130'@'#20'@!IC"'#211'@'#13#193#200#18#138#158'PR'#217#195#162'23' 142 | +#198#177#172#168#164#135#1#247#255'?!`rg'#181'<;'#187'3;'#231#190'v'#9#152#0 143 | +#1'~'#180#252'?'#251'W'#140','#136'6'#129'E'#1#150'=,'#5'0'#18#239#195#184 144 | +#192'{L'#156#10'#/'#133#228#145#224#165'!e2'#145' '#203#0'A'#16'D"'#186#198 145 | +#144#178'P,'#10'r'#24#30#196#25'2'#245#242#248'p'#127'w'#213#160'*T*EU'#144 146 | +'XN>'#29'D'#28''''#21'I'#20'%'#5#137#149#244#235#229#173'm'#219#231'i'#141 147 | +#201'd'#24#13'5W'#216#231#235#139#147#195#253#29'v'#139#19'Ln'#27'5'#215'r7' 148 | +#167'G{'#27'k'#171'9'#179' '#206#23#204#184'R$69n'#142#161#233#217'l'#246#253 149 | +'3'#228#3#137'%'#195'0t]'#15'O'#199'y'#219'u'#28'T*'#164#174#170'j'#29#160'g' 150 | +#181'ZV'#15#255#146#182'eYm'#0#215#29#12'\'#23#207'@4'#155#16'?c\T'#187#221 151 | +'*'#160#12'bfq'#253#204#249#250#246'<'#175'_*'#245'=4U'#200#212'4'#205'.'#240 152 | +'<_'#235'tj<.'#254#225#7#152'f'#182'j:c'#254#196#0#0#0#0'IEND'#174'B`'#130 153 | ]); 154 | -------------------------------------------------------------------------------- /Source/Indy8/HproseHttpClient.pas: -------------------------------------------------------------------------------- 1 | { 2 | /**********************************************************\ 3 | | | 4 | | hprose | 5 | | | 6 | | Official WebSite: http://www.hprose.com/ | 7 | | http://www.hprose.org/ | 8 | | | 9 | \**********************************************************/ 10 | 11 | /**********************************************************\ 12 | * * 13 | * HproseHttpClient.pas * 14 | * * 15 | * hprose indy http client unit for delphi. * 16 | * * 17 | * LastModified: Dec 9, 2016 * 18 | * Author: Ma Bingyao * 19 | * * 20 | \**********************************************************/ 21 | } 22 | unit HproseHttpClient; 23 | 24 | interface 25 | 26 | uses Classes, HproseCommon, HproseClient, IdHeaderList, IdURI, SysUtils; 27 | 28 | type 29 | 30 | THproseHttpClient = class(THproseClient) 31 | private 32 | FHttpPool: IList; 33 | FIdURI: TIdURI; 34 | FUserName: string; 35 | FPassword: string; 36 | FHeaders: IMap; 37 | FProxyHost: string; 38 | FProxyPort: Integer; 39 | FProxyUser: string; 40 | FProxyPass: string; 41 | FUserAgent: string; 42 | FKeepAlive: Boolean; 43 | FKeepAliveTimeout: Integer; 44 | FConnectionTimeout: Integer; 45 | protected 46 | function SendAndReceive(const Data: TBytes; 47 | const Context: TClientContext): TBytes; override; 48 | public 49 | constructor Create(AOwner: TComponent); override; 50 | destructor Destroy; override; 51 | procedure InitURI(const AValue: string); override; 52 | published 53 | {:Before HTTP operation you may define any non-standard headers for HTTP 54 | request, except of: 'Expect: 100-continue', 'Content-Length', 'Content-Type', 55 | 'Connection', 'Authorization', 'Proxy-Authorization' and 'Host' headers.} 56 | property Headers: IMap read FHeaders; 57 | 58 | {:If @true (default value is @false), keepalives in HTTP protocol 1.1 is enabled.} 59 | property KeepAlive: Boolean read FKeepAlive write FKeepAlive; 60 | 61 | {:Define timeout for keepalives in seconds! Default value is 300.} 62 | property KeepAliveTimeout: integer read FKeepAliveTimeout write FKeepAliveTimeout; 63 | 64 | {:Address of proxy server (IP address or domain name).} 65 | property ProxyHost: string read FProxyHost Write FProxyHost; 66 | 67 | {:Port number for proxy connection. Default value is 8080.} 68 | property ProxyPort: Integer read FProxyPort Write FProxyPort; 69 | 70 | {:Username for connect to proxy server.} 71 | property ProxyUser: string read FProxyUser Write FProxyUser; 72 | 73 | {:Password for connect to proxy server.} 74 | property ProxyPass: string read FProxyPass Write FProxyPass; 75 | 76 | {:Here you can specify custom User-Agent indentification. By default is 77 | used: 'Hprose Http Client for Delphi (Indy8)'} 78 | property UserAgent: string read FUserAgent Write FUserAgent; 79 | 80 | {:UserName for user authorization.} 81 | property UserName: string read FUserName write FUserName; 82 | 83 | {:Password for user authorization.} 84 | property Password: string read FPassword write FPassword; 85 | 86 | {:Define timeout for ConnectionTimeout in milliseconds! Can't work in Indy8} 87 | property ConnectionTimeout: Integer read FConnectionTimeout write FConnectionTimeout; 88 | end; 89 | 90 | procedure Register; 91 | 92 | implementation 93 | 94 | uses IdGlobal, IdHttp, Variants; 95 | 96 | var 97 | cookieManager: IMap; 98 | 99 | procedure SetCookie(Header: IMap; const Host: string); 100 | var 101 | I, Pos: Integer; 102 | Name, Value, CookieString, Path: string; 103 | Cookie: IMap; 104 | begin 105 | for I := 0 to Header.Count - 1 do begin 106 | Name := LowerCase(Header.Keys[I]); 107 | if (Name = 'set-cookie') or (Name = 'set-cookie2') then begin 108 | Value := Header.Values[I]; 109 | Pos := AnsiPos(';', Value); 110 | CookieString := Copy(Value, 1, Pos - 1); 111 | Value := Copy(Value, Pos + 1, MaxInt); 112 | Cookie := TCaseInsensitiveHashMap.Split(Value, ';', '=', 0, True, False, True); 113 | Pos := AnsiPos('=', CookieString); 114 | Cookie['name'] := Copy(CookieString, 1, Pos - 1); 115 | Cookie['value'] := Copy(CookieString, Pos + 1, MaxInt); 116 | if Cookie.ContainsKey('path') then begin 117 | Path := Cookie['path']; 118 | if (Length(Path) > 0) then begin 119 | if (Path[1] = '"') then Delete(Path, 1, 1); 120 | if (Path[Length(Path)] = '"') then SetLength(Path, Length(Path) - 1); 121 | end; 122 | if (Length(Path) > 0) then 123 | Cookie['path'] := Path 124 | else 125 | Cookie['path'] := '/'; 126 | end 127 | else 128 | Cookie['path'] := '/'; 129 | if Cookie.ContainsKey('expires') then begin 130 | // GMTToLocalDateTime of Indy 8 can't parse cookie expires directly. 131 | // Use StringReplace to fix this bug. 132 | Value := StringReplace(Cookie['expires'], '-', ' ', [rfReplaceAll]); 133 | Cookie['expires'] := GMTToLocalDateTime(Value); 134 | end; 135 | if Cookie.ContainsKey('domain') then 136 | Cookie['domain'] := LowerCase(Cookie['domain']) 137 | else 138 | Cookie['domain'] := Host; 139 | Cookie['secure'] := Cookie.ContainsKey('secure'); 140 | CookieManager.BeginWrite; 141 | try 142 | if not CookieManager.ContainsKey(Cookie['domain']) then 143 | CookieManager[Cookie['domain']] := THashMap.Create(False, True) as IMap; 144 | VarToMap(CookieManager[Cookie['domain']])[Cookie['name']] := Cookie; 145 | finally 146 | CookieManager.EndWrite; 147 | end; 148 | end; 149 | end; 150 | end; 151 | 152 | function GetCookie(const Host, Path: string; Secure: Boolean): string; 153 | var 154 | Cookies, CookieMap, Cookie: IMap; 155 | Names: IList; 156 | Domain: string; 157 | I, J: Integer; 158 | begin 159 | Cookies := THashMap.Create(False); 160 | CookieManager.BeginRead; 161 | try 162 | for I := 0 to CookieManager.Count - 1 do begin 163 | Domain := VarToStr(CookieManager.Keys[I]); 164 | if AnsiPos(Domain, Host) <> 0 then begin 165 | CookieMap := VarToMap(CookieManager.Values[I]); 166 | CookieMap.BeginRead; 167 | try 168 | Names := TArrayList.Create(False); 169 | for J := 0 to CookieMap.Count - 1 do begin 170 | Cookie := VarToMap(CookieMap.Values[J]); 171 | if Cookie.ContainsKey('expires') and (Cookie['expires'] < Now) then 172 | Names.Add(Cookie['name']) 173 | else if AnsiPos(Cookie['path'], Path) = 1 then begin 174 | if ((Secure and Cookie['secure']) or not Cookie['secure']) and 175 | (Cookie['value'] <> '') then 176 | Cookies[Cookie['name']] := Cookie['value']; 177 | end; 178 | end; 179 | finally 180 | CookieMap.EndRead; 181 | end; 182 | if Names.Count > 0 then begin 183 | CookieMap.BeginWrite; 184 | try 185 | for J := 0 to Names.Count - 1 do CookieMap.Delete(Names[J]); 186 | finally 187 | CookieMap.EndWrite; 188 | end; 189 | end; 190 | end; 191 | end; 192 | Result := Cookies.Join('; '); 193 | finally 194 | CookieManager.EndRead; 195 | end; 196 | end; 197 | 198 | { THproseHttpClient } 199 | 200 | constructor THproseHttpClient.Create(AOwner: TComponent); 201 | begin 202 | inherited Create(AOwner); 203 | FHttpPool := TArrayList.Create(10); 204 | FIdURI := nil; 205 | FHeaders := TCaseInsensitiveHashMap.Create; 206 | FUserName := ''; 207 | FPassword := ''; 208 | FKeepAlive := True; 209 | FKeepAliveTimeout := 300; 210 | FProxyHost := ''; 211 | FProxyPort := 8080; 212 | FProxyUser := ''; 213 | FProxyPass := ''; 214 | FUserAgent := 'Hprose Http Client for Delphi (Indy8)'; 215 | FConnectionTimeout := 10000; 216 | end; 217 | 218 | destructor THproseHttpClient.Destroy; 219 | var 220 | I: Integer; 221 | begin 222 | FHttpPool.Lock; 223 | try 224 | for I := FHttpPool.Count - 1 downto 0 do 225 | TIdHttp(VarToObj(FHttpPool.Delete(I))).Free; 226 | finally 227 | FHttpPool.Unlock; 228 | end; 229 | FreeAndNil(FIdURI); 230 | inherited; 231 | end; 232 | 233 | procedure THproseHttpClient.InitURI(const AValue: string); 234 | 235 | begin 236 | inherited InitURI(AValue); 237 | FreeAndNil(FIdURI); 238 | FIdURI := TIdURI.Create(URI); 239 | end; 240 | 241 | function THproseHttpClient.SendAndReceive(const Data: TBytes; 242 | const Context: TClientContext): TBytes; 243 | var 244 | IdHttp: TIdHttp; 245 | Cookie: string; 246 | OutStream, InStream: TBytesStream; 247 | Header, HttpHeader: IMap; 248 | ExtraHeaders: TIdHeaderList; 249 | I: Integer; 250 | Key: string; 251 | begin 252 | FHttpPool.Lock; 253 | try 254 | if FHttpPool.Count > 0 then 255 | IdHttp := TIdHttp(VarToObj(FHttpPool.Delete(FHttpPool.Count - 1))) 256 | else 257 | IdHttp := TIdHttp.Create(nil); 258 | finally 259 | FHttpPool.Unlock; 260 | end; 261 | IdHttp.Request.UserAgent := FUserAgent; 262 | if FProxyHost <> '' then begin 263 | IdHttp.Request.ProxyServer := FProxyHost; 264 | IdHttp.Request.ProxyPort := FProxyPort; 265 | IdHttp.Request.ProxyUsername := FProxyUser; 266 | IdHttp.Request.ProxyPassword := FProxyPass; 267 | end; 268 | ExtraHeaders := IdHttp.Request.ExtraHeaders; 269 | if KeepAlive then begin 270 | IdHttp.Request.Connection := 'keep-alive'; 271 | ExtraHeaders.Values['Keep-Alive'] := IntToStr(FKeepAliveTimeout); 272 | end 273 | else IdHttp.Request.Connection := 'close'; 274 | if FUserName <> '' then begin 275 | IdHttp.Request.UserName := FUserName; 276 | IdHttp.Request.Password := FPassword; 277 | end; 278 | IdHttp.Request.ContentType := 'application/hprose'; 279 | IdHttp.ProtocolVersion := pv1_1; 280 | Header := TCaseInsensitiveHashMap.Create; 281 | Header.PutAll(FHeaders); 282 | HttpHeader := VarToMap(Context['httpHeader']); 283 | if (Assigned(HttpHeader)) then 284 | Header.PutAll(HttpHeader) 285 | else 286 | HttpHeader := TCaseInsensitiveHashMap.Create; 287 | for I := 0 to Header.Count - 1 do 288 | ExtraHeaders.Values[Header.Keys[I]] := Header.Values[I]; 289 | Cookie := GetCookie(FIdURI.Host, 290 | FIdURI.Path, 291 | LowerCase(FIdURI.Protocol) = 'https'); 292 | if Cookie <> '' then ExtraHeaders.Values['Cookie'] := Cookie; 293 | OutStream := TBytesStream.Create(Data); 294 | InStream := TBytesStream.Create; 295 | try 296 | IdHttp.DoRequest(hmPost, URI, OutStream, InStream); 297 | HttpHeader.Clear(); 298 | ExtraHeaders := IdHttp.Response.ExtraHeaders; 299 | for I := 0 to ExtraHeaders.Count - 1 do begin 300 | Key := ExtraHeaders.Names[I]; 301 | HttpHeader.Put(Key, ExtraHeaders.Values[Key]); 302 | end; 303 | Context['httpHeader'] := HttpHeader; 304 | SetCookie(HttpHeader, FIdURI.Host); 305 | Result := InStream.Bytes; 306 | SetLength(Result, InStream.Size); 307 | finally 308 | OutStream.Free; 309 | InStream.Free; 310 | end; 311 | IdHttp.Request.Clear; 312 | IdHttp.Response.Clear; 313 | FHttpPool.Lock; 314 | try 315 | FHttpPool.Add(ObjToVar(IdHttp)); 316 | finally 317 | FHttpPool.Unlock; 318 | end; 319 | end; 320 | 321 | procedure Register; 322 | begin 323 | RegisterComponents('Hprose', [THproseHttpClient]); 324 | end; 325 | 326 | initialization 327 | CookieManager := TCaseInsensitiveHashMap.Create(False, True); 328 | 329 | end. 330 | -------------------------------------------------------------------------------- /Test/ArrayListTestCase.pas: -------------------------------------------------------------------------------- 1 | unit ArrayListTestCase; 2 | 3 | interface 4 | 5 | uses 6 | TestFrameWork, HproseCommon; 7 | 8 | type 9 | 10 | TArrayListTestCase = class(TTestCase) 11 | private 12 | procedure CheckEqualsList(Expected: IList; Actual: IList; Msg: string = ''); 13 | published 14 | procedure TestCreate; 15 | procedure TestAdd; 16 | procedure TestAddAll; 17 | procedure TestInsert; 18 | procedure TestInsertRange; 19 | procedure TestMove; 20 | procedure TestExchange; 21 | procedure TestContains; 22 | procedure TestIndexOf; 23 | procedure TestLastIndexOf; 24 | procedure TestDelete; 25 | procedure TestDeleteRange; 26 | procedure TestRemove; 27 | procedure TestClear; 28 | procedure TestAssign; 29 | procedure TestToArray; 30 | {$IF RTLVersion >= 17.00} // Delphi 2005 or later 31 | procedure TestForIn; 32 | {$IFEND} 33 | procedure TestSplit; 34 | procedure TestJoin; 35 | procedure TestItem; 36 | procedure TestPack; 37 | procedure TestReverse; 38 | procedure TestSort; 39 | procedure TestShuffle; 40 | procedure TestVariantPut; 41 | end; 42 | 43 | implementation 44 | 45 | uses Variants; 46 | 47 | { TArrayListTestCase } 48 | 49 | procedure TArrayListTestCase.CheckEqualsList(Expected: IList; Actual: IList; Msg: string); 50 | var 51 | I: Integer; 52 | begin 53 | Check(Expected.Count = Actual.Count, Msg); 54 | for I := 0 to Expected.Count - 1 do Check(Expected[I] = Actual[I], Msg); 55 | end; 56 | 57 | procedure TArrayListTestCase.TestCreate; 58 | var 59 | L: IArrayList; 60 | begin 61 | L := ArrayList([1, 2, 3]); 62 | Check(L[0] = 1); 63 | Check(L[1] = 2); 64 | Check(L[2] = 3); 65 | L := TArrayList.Create(L); 66 | Check(L[0] = 1); 67 | Check(L[1] = 2); 68 | Check(L[2] = 3); 69 | L := TArrayList.Create(L.ToArray); 70 | Check(L[0] = 1); 71 | Check(L[1] = 2); 72 | Check(L[2] = 3); 73 | L := TArrayList.Create(); 74 | Check(L.Count = 0); 75 | L := TArrayList.Create(False, True); 76 | L.BeginRead; 77 | L.EndRead; 78 | L.BeginWrite; 79 | L.EndWrite; 80 | end; 81 | 82 | procedure TArrayListTestCase.TestAdd; 83 | var 84 | L: IArrayList; 85 | begin 86 | L := ArrayList([1, 2, 3]); 87 | L.Add('Hello'); 88 | L.Add(3.14); 89 | L.Add(True); 90 | L.Add(ArrayList(['a', 'b', 'c'])); 91 | Check(L.Count = 7); 92 | Check(L[3] = 'Hello'); 93 | Check(L[4] = 3.14); 94 | Check(L[5] = True); 95 | Check(L[6].Get(0) = 'a'); 96 | Check(L[6].Get(1) = 'b'); 97 | Check(L[6].Get(2) = 'c'); 98 | end; 99 | 100 | procedure TArrayListTestCase.TestAddAll; 101 | var 102 | L: Variant; 103 | begin 104 | L := ArrayList([1, 2, 3]); 105 | Check(L.Count = 3); 106 | L.AddAll(ArrayList(['a', 'b', 'c'])); 107 | Check(L.Count = 6); 108 | L.AddAll(L); 109 | Check(L.Count = 12); 110 | Check(L.Get(3) = 'a'); 111 | Check(L.Get(4) = 'b'); 112 | Check(L.Get(5) = 'c'); 113 | Check(L.Get(6) = 1); 114 | Check(L.Get(7) = 2); 115 | Check(L.Get(8) = 3); 116 | end; 117 | 118 | procedure TArrayListTestCase.TestInsert; 119 | var 120 | L: Variant; 121 | L2: IArrayList; 122 | I: Integer; 123 | begin 124 | L := ArrayList([1, 'abc', 3.14, True]); 125 | L.Insert(0, 'top'); 126 | L.Insert(3, 'middle'); 127 | L.Insert(6, 'bottom'); 128 | L2 := ArrayList([1, 'abc', 3.14, True]); 129 | L2.Insert(0, 'top'); 130 | L2.Insert(3, 'middle'); 131 | L2.Insert(6, 'bottom'); 132 | for I := 0 to 6 do Check(L.Get(I) = L2[I]); 133 | end; 134 | 135 | procedure TArrayListTestCase.TestInsertRange; 136 | var 137 | L: Variant; 138 | L2: IArrayList; 139 | I: Integer; 140 | begin 141 | L := ArrayList([1, 'abc', 3.14, True]); 142 | L.InsertRange(2, ArrayList([1, 2, 3])); 143 | L2 := ArrayList([1, 'abc', 3.14, True]); 144 | L2.InsertRange(2, [1, 2, 3]); 145 | for I := 0 to 6 do Check(L.Get(I) = L2[I]); 146 | end; 147 | 148 | procedure TArrayListTestCase.TestMove; 149 | var 150 | L: Variant; 151 | L2: IArrayList; 152 | I: Integer; 153 | begin 154 | L := ArrayList([1, 'abc', 3.14, True]); 155 | L.Move(2, 0); 156 | L2 := ArrayList([3.14, 1, 'abc', True]); 157 | for I := 0 to 3 do Check(L.Get(I) = L2[I]); 158 | end; 159 | 160 | procedure TArrayListTestCase.TestExchange; 161 | var 162 | L: Variant; 163 | L2: IArrayList; 164 | I: Integer; 165 | begin 166 | L := ArrayList([1, 'abc', 3.14, True]); 167 | L.Exchange(2, 0); 168 | L2 := ArrayList([3.14, 'abc', 1, True]); 169 | for I := 0 to 3 do Check(L.Get(I) = L2[I]); 170 | end; 171 | 172 | procedure TArrayListTestCase.TestContains; 173 | var 174 | L: IList; 175 | begin 176 | L := ArrayList([1, 'abc', 3.14, True, 'abc']); 177 | Check(L.Contains('hello') = False); 178 | Check(L.Contains('abc') = True); 179 | end; 180 | 181 | procedure TArrayListTestCase.TestIndexOf; 182 | var 183 | L: IList; 184 | begin 185 | L := ArrayList([1, 'abc', 3.14, True, 'abc']); 186 | Check(L.IndexOf(1.0) = -1); 187 | Check(L.IndexOf(1) = 0); 188 | Check(L.IndexOf(3.14) = 2); 189 | Check(L.IndexOf(False) = -1); 190 | Check(L.IndexOf('abc') = 1); 191 | Check(L.IndexOf('abc', 1) = 1); 192 | Check(L.IndexOf('abc', 2) = 4); 193 | Check(L.IndexOf('abc', 2, 2) = -1); 194 | end; 195 | 196 | procedure TArrayListTestCase.TestLastIndexOf; 197 | var 198 | L: IList; 199 | begin 200 | L := ArrayList([1, 'abc', 3.14, True, 'abc']); 201 | Check(L.LastIndexOf(1) = 0); 202 | Check(L.LastIndexOf('hello') = -1); 203 | Check(L.LastIndexOf('abc') = 4); 204 | Check(L.LastIndexOf('abc', 3) = 1); 205 | Check(L.LastIndexOf('abc', 4) = 4); 206 | Check(L.LastIndexOf('abc', 3, 2) = -1); 207 | end; 208 | 209 | procedure TArrayListTestCase.TestDelete; 210 | var 211 | L: IList; 212 | begin 213 | L := ArrayList([1, 'abc', 3.14, True]); 214 | Check(L.Delete(2) = 3.14); 215 | Check(L.Delete(2) = True); 216 | end; 217 | 218 | procedure TArrayListTestCase.TestDeleteRange; 219 | var 220 | L: IList; 221 | begin 222 | L := ArrayList([1, 'abc', 3.14, True]); 223 | L.DeleteRange(1, 2); 224 | CheckEqualsList(L, ArrayList([1, True])); 225 | end; 226 | 227 | procedure TArrayListTestCase.TestRemove; 228 | var 229 | L: IList; 230 | begin 231 | L := ArrayList([1, 'abc', 3.14, True, 'abc']); 232 | Check(L.Remove('abc', FromEnd) = 4); 233 | Check(L.Remove('abc', FromBeginning) = 1); 234 | Check(L.Remove(True) = 2); 235 | end; 236 | 237 | procedure TArrayListTestCase.TestClear; 238 | var 239 | L: IList; 240 | begin 241 | L := ArrayList([1, 'abc', 3.14, True]); 242 | L.Clear; 243 | Check(L.Count = 0); 244 | end; 245 | 246 | procedure TArrayListTestCase.TestAssign; 247 | var 248 | L: IList; 249 | L2: Variant; 250 | I: Integer; 251 | begin 252 | L := ArrayList([1, 'abc', 3.14, True]); 253 | L2 := ArrayList([1, 2, 3]); 254 | Check(L2.Assign(L) = True); 255 | for I := 0 to 3 do Check(L[I] = L2.Get(I)); 256 | end; 257 | 258 | procedure TArrayListTestCase.TestToArray; 259 | var 260 | L: IList; 261 | A: array of Integer; 262 | I: Integer; 263 | begin 264 | L := ArrayList([1, 3, 4, 5, 9]); 265 | A := L.ToArray(varInteger); 266 | for I := 0 to Length(A) - 1 do Check(L[I] = A[I]); 267 | end; 268 | 269 | {$IF RTLVersion >= 17.00} // Delphi 2005 or later 270 | procedure TArrayListTestCase.TestForIn; 271 | var 272 | L, L2: IList; 273 | V: Variant; 274 | begin 275 | L := ArrayList([1, 'abc', 3.14, True]); 276 | L2 := TArrayList.Create; 277 | for V in L do L2.Add(V); 278 | CheckEqualsList(L, L2); 279 | end; 280 | {$IFEND} 281 | 282 | 283 | procedure TArrayListTestCase.TestSplit; 284 | var 285 | S: String; 286 | begin 287 | S := 'Monday, Tuesday, Wednesday, Thursday, Friday, Saturday, Sunday,'; 288 | CheckEqualsList( 289 | TArrayList.Split(S), 290 | ArrayList(['Monday', ' Tuesday', ' Wednesday', ' Thursday', ' Friday', ' Saturday', ' Sunday', '']), 291 | 'Split 1 failed' 292 | ); 293 | CheckEqualsList( 294 | TArrayList.Split(S, ', '), 295 | ArrayList(['Monday', 'Tuesday', 'Wednesday', 'Thursday', 'Friday', 'Saturday', 'Sunday,']), 296 | 'Split 2 failed' 297 | ); 298 | CheckEqualsList( 299 | TArrayList.Split(S, ',', 4), 300 | ArrayList(['Monday', ' Tuesday', ' Wednesday', ' Thursday, Friday, Saturday, Sunday,']), 301 | 'Split 3 failed' 302 | ); 303 | CheckEqualsList( 304 | TArrayList.Split(S, ',', 0, true), 305 | ArrayList(['Monday', 'Tuesday', 'Wednesday', 'Thursday', 'Friday', 'Saturday', 'Sunday', '']), 306 | 'Split 4 failed' 307 | ); 308 | CheckEqualsList( 309 | TArrayList.Split(S, ',', 0, true, true), 310 | ArrayList(['Monday', 'Tuesday', 'Wednesday', 'Thursday', 'Friday', 'Saturday', 'Sunday']), 311 | 'Split 5 failed' 312 | ); 313 | end; 314 | 315 | procedure TArrayListTestCase.TestJoin; 316 | var 317 | S: String; 318 | L: IList; 319 | begin 320 | S := 'Monday,Tuesday,Wednesday,Thursday,Friday,Saturday,Sunday'; 321 | L := TArrayList.Split(S); 322 | Check(L.Join('; ') = 'Monday; Tuesday; Wednesday; Thursday; Friday; Saturday; Sunday'); 323 | Check(L.Join('", "', '["', '"]') = '["Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Sunday"]'); 324 | end; 325 | 326 | procedure TArrayListTestCase.TestItem; 327 | var 328 | L: IList; 329 | begin 330 | L := ArrayList([1, 'abc', 3.14, True]); 331 | L[10] := 'test'; 332 | Check(VarIsEmpty(L[9])); 333 | Check(L[10] = 'test'); 334 | L.Put(12, 'hello'); 335 | Check(VarIsEmpty(L.Get(11))); 336 | Check(L.Get(12) = 'hello'); 337 | Check(VarIsEmpty(L.Get(-1))); 338 | end; 339 | 340 | procedure TArrayListTestCase.TestPack; 341 | var 342 | L: IList; 343 | N: Integer; 344 | begin 345 | L := ArrayList([1, 'abc', 3.14, True]); 346 | L[10] := 'test'; 347 | Check(L.Count = 11); 348 | Check(L[10] = 'test'); 349 | N := L.Capacity; 350 | L.Pack; 351 | Check(L.Count = 5); 352 | Check(L[4] = 'test'); 353 | Check(L.Capacity = N); 354 | L.TrimExcess; 355 | Check(L.Capacity <> N); 356 | Check(L.Count = L.Capacity); 357 | end; 358 | 359 | procedure TArrayListTestCase.TestReverse; 360 | var 361 | L: IList; 362 | begin 363 | L := ArrayList([1, 'abc', 3.14, True]); 364 | L.Reverse; 365 | CheckEqualsList(L, ArrayList([True, 3.14, 'abc', 1])); 366 | end; 367 | 368 | procedure TArrayListTestCase.TestSort; 369 | var 370 | L: IList; 371 | begin 372 | L := ArrayList([3, 5, 1, 2, 4, 9, 7, 6, 8]); 373 | L.Sort; 374 | CheckEqualsList(L, ArrayList([1, 2, 3, 4, 5, 6, 7, 8, 9])); 375 | end; 376 | 377 | procedure TArrayListTestCase.TestShuffle; 378 | var 379 | Src, Dest: IList; 380 | Statistics: IList; 381 | M: IMap; 382 | I, J, N: Integer; 383 | begin 384 | Src := ArrayList([0, 1, 2, 3, 4, 5, 6, 7, 8, 9]); 385 | Statistics := TArrayList.Create(Src.Count); 386 | for I := 0 to Src.Count - 1 do 387 | Statistics[I] := HashMap([0, 0, 1, 0, 2, 0, 3, 0, 4, 0, 5, 0, 6, 0, 7, 0, 8, 0, 9, 0]); 388 | for I := 0 to 99999 do begin 389 | Dest := TArrayList.Create(Src); 390 | Dest.Shuffle; 391 | for J := 0 to Statistics.Count - 1 do begin 392 | M := VarToMap(Statistics[J]); 393 | N := M.Get(Dest[J]); 394 | Inc(N); 395 | M.Put(Dest[J], N); 396 | end; 397 | end; 398 | for I := 0 to Statistics.Count - 1 do begin 399 | for J := 0 to Statistics[I].Count - 1 do begin 400 | N := Statistics[I].Values.Get(J); 401 | Check((9500 < N) and (N < 10500), Variant(N)); 402 | end; 403 | end; 404 | end; 405 | 406 | procedure TArrayListTestCase.TestVariantPut; 407 | var 408 | L: IList; 409 | N: Integer; 410 | V: Variant; 411 | begin 412 | L := ArrayList([1, 'abc', 3.14, True]); 413 | N := 10; 414 | L.Put(3, N); 415 | Check(L.Get(3) = 10); 416 | N := 11; 417 | Check(L.Get(3) = 10); 418 | 419 | N := 10; 420 | L.Put(3, Variant(N)); 421 | Check(L.Get(3) = 10); 422 | N := 11; 423 | Check(L.Get(3) = 10); 424 | 425 | V := 10; 426 | L.Put(3, V); 427 | Check(L.Get(3) = 10); 428 | V := 11; 429 | Check(L.Get(3) = 10); 430 | 431 | V := 10; 432 | L.Put(3, VarRef(V)); 433 | Check(L.Get(3) = 10); 434 | V := 11; 435 | Check(L.Get(3) = 11); 436 | end; 437 | 438 | initialization 439 | TestFramework.RegisterTest(TArrayListTestCase.Suite); 440 | 441 | end. 442 | -------------------------------------------------------------------------------- /Test/HashedListTestCase.pas: -------------------------------------------------------------------------------- 1 | unit HashedListTestCase; 2 | 3 | interface 4 | 5 | uses 6 | TestFrameWork, HproseCommon; 7 | 8 | type 9 | 10 | THashedListTestCase = class(TTestCase) 11 | private 12 | procedure CheckEqualsList(Expected: IList; Actual: IList; Msg: string = ''); 13 | published 14 | procedure TestCreate; 15 | procedure TestAdd; 16 | procedure TestAddAll; 17 | procedure TestInsert; 18 | procedure TestInsertRange; 19 | procedure TestMove; 20 | procedure TestExchange; 21 | procedure TestContains; 22 | procedure TestIndexOf; 23 | procedure TestLastIndexOf; 24 | procedure TestDelete; 25 | procedure TestDeleteRange; 26 | procedure TestRemove; 27 | procedure TestClear; 28 | procedure TestAssign; 29 | procedure TestToArray; 30 | {$IF RTLVersion >= 17.00} // Delphi 2005 or later 31 | procedure TestForIn; 32 | {$IFEND} 33 | procedure TestSplit; 34 | procedure TestJoin; 35 | procedure TestItem; 36 | procedure TestPack; 37 | procedure TestReverse; 38 | procedure TestSort; 39 | procedure TestShuffle; 40 | procedure TestVariantPut; 41 | end; 42 | 43 | implementation 44 | 45 | uses Variants; 46 | 47 | { THashedListTestCase } 48 | 49 | procedure THashedListTestCase.CheckEqualsList(Expected: IList; Actual: IList; Msg: string); 50 | var 51 | I: Integer; 52 | begin 53 | Check(Expected.Count = Actual.Count, Msg); 54 | for I := 0 to Expected.Count - 1 do Check(Expected[I] = Actual[I], Msg); 55 | end; 56 | 57 | procedure THashedListTestCase.TestCreate; 58 | var 59 | L: IHashedList; 60 | begin 61 | L := HashedList([1, 2, 3]); 62 | Check(L[0] = 1); 63 | Check(L[1] = 2); 64 | Check(L[2] = 3); 65 | L := THashedList.Create(L); 66 | Check(L[0] = 1); 67 | Check(L[1] = 2); 68 | Check(L[2] = 3); 69 | L := THashedList.Create(L.ToArray); 70 | Check(L[0] = 1); 71 | Check(L[1] = 2); 72 | Check(L[2] = 3); 73 | L := THashedList.Create(); 74 | Check(L.Count = 0); 75 | L := THashedList.Create(False, True); 76 | L.BeginRead; 77 | L.EndRead; 78 | L.BeginWrite; 79 | L.EndWrite; 80 | end; 81 | 82 | procedure THashedListTestCase.TestAdd; 83 | var 84 | L: IHashedList; 85 | begin 86 | L := HashedList([1, 2, 3]); 87 | L.Add('Hello'); 88 | L.Add(3.14); 89 | L.Add(True); 90 | L.Add(HashedList(['a', 'b', 'c'])); 91 | Check(L.Count = 7); 92 | Check(L[3] = 'Hello'); 93 | Check(L[4] = 3.14); 94 | Check(L[5] = True); 95 | Check(L[6].Get(0) = 'a'); 96 | Check(L[6].Get(1) = 'b'); 97 | Check(L[6].Get(2) = 'c'); 98 | end; 99 | 100 | procedure THashedListTestCase.TestAddAll; 101 | var 102 | L: Variant; 103 | begin 104 | L := HashedList([1, 2, 3]); 105 | Check(L.Count = 3); 106 | L.AddAll(HashedList(['a', 'b', 'c'])); 107 | Check(L.Count = 6); 108 | L.AddAll(L); 109 | Check(L.Count = 12); 110 | Check(L.Get(3) = 'a'); 111 | Check(L.Get(4) = 'b'); 112 | Check(L.Get(5) = 'c'); 113 | Check(L.Get(6) = 1); 114 | Check(L.Get(7) = 2); 115 | Check(L.Get(8) = 3); 116 | end; 117 | 118 | procedure THashedListTestCase.TestInsert; 119 | var 120 | L: Variant; 121 | L2: IHashedList; 122 | I: Integer; 123 | begin 124 | L := HashedList([1, 'abc', 3.14, True]); 125 | L.Insert(0, 'top'); 126 | L.Insert(3, 'middle'); 127 | L.Insert(6, 'bottom'); 128 | L2 := HashedList([1, 'abc', 3.14, True]); 129 | L2.Insert(0, 'top'); 130 | L2.Insert(3, 'middle'); 131 | L2.Insert(6, 'bottom'); 132 | for I := 0 to 6 do Check(L.Get(I) = L2[I]); 133 | end; 134 | 135 | procedure THashedListTestCase.TestInsertRange; 136 | var 137 | L: Variant; 138 | L2: IHashedList; 139 | I: Integer; 140 | begin 141 | L := HashedList([1, 'abc', 3.14, True]); 142 | L.InsertRange(2, HashedList([1, 2, 3])); 143 | L2 := HashedList([1, 'abc', 3.14, True]); 144 | L2.InsertRange(2, [1, 2, 3]); 145 | for I := 0 to 6 do Check(L.Get(I) = L2[I]); 146 | end; 147 | 148 | procedure THashedListTestCase.TestMove; 149 | var 150 | L: Variant; 151 | L2: IHashedList; 152 | I: Integer; 153 | begin 154 | L := HashedList([1, 'abc', 3.14, True]); 155 | L.Move(2, 0); 156 | L2 := HashedList([3.14, 1, 'abc', True]); 157 | for I := 0 to 3 do Check(L.Get(I) = L2[I]); 158 | end; 159 | 160 | procedure THashedListTestCase.TestExchange; 161 | var 162 | L: Variant; 163 | L2: IHashedList; 164 | I: Integer; 165 | begin 166 | L := HashedList([1, 'abc', 3.14, True]); 167 | L.Exchange(2, 0); 168 | L2 := HashedList([3.14, 'abc', 1, True]); 169 | for I := 0 to 3 do Check(L.Get(I) = L2[I]); 170 | end; 171 | 172 | procedure THashedListTestCase.TestContains; 173 | var 174 | L: IList; 175 | begin 176 | L := HashedList([1, 'abc', 3.14, True, 'abc']); 177 | Check(L.Contains('hello') = False); 178 | Check(L.Contains('abc') = True); 179 | end; 180 | 181 | procedure THashedListTestCase.TestIndexOf; 182 | var 183 | L: IList; 184 | 185 | begin 186 | L := HashedList([1, 'abc', 3.14, True, 'abc']); 187 | Check(L.IndexOf(1.0) = -1); 188 | Check(L.IndexOf(1) = 0); 189 | Check(L.IndexOf(3.14) = 2); 190 | Check(L.IndexOf(False) = -1); 191 | Check(L.IndexOf('abc') = 1); 192 | Check(L.IndexOf('abc', 1) = 1); 193 | Check(L.IndexOf('abc', 2) = 4); 194 | Check(L.IndexOf('abc', 2, 2) = -1); 195 | end; 196 | 197 | procedure THashedListTestCase.TestLastIndexOf; 198 | var 199 | L: IList; 200 | begin 201 | L := HashedList([1, 'abc', 3.14, True, 'abc']); 202 | Check(L.LastIndexOf(1) = 0); 203 | Check(L.LastIndexOf('hello') = -1); 204 | Check(L.LastIndexOf('abc') = 4); 205 | Check(L.LastIndexOf('abc', 3) = 1); 206 | Check(L.LastIndexOf('abc', 4) = 4); 207 | Check(L.LastIndexOf('abc', 3, 2) = -1); 208 | end; 209 | 210 | procedure THashedListTestCase.TestDelete; 211 | var 212 | L: IList; 213 | begin 214 | L := HashedList([1, 'abc', 3.14, True]); 215 | Check(L.Delete(2) = 3.14); 216 | Check(L.Delete(2) = True); 217 | end; 218 | 219 | procedure THashedListTestCase.TestDeleteRange; 220 | var 221 | L: IList; 222 | begin 223 | L := HashedList([1, 'abc', 3.14, True]); 224 | L.DeleteRange(1, 2); 225 | CheckEqualsList(L, HashedList([1, True])); 226 | end; 227 | 228 | procedure THashedListTestCase.TestRemove; 229 | var 230 | L: IList; 231 | begin 232 | L := HashedList([1, 'abc', 3.14, True, 'abc']); 233 | Check(L.Remove('abc', FromEnd) = 4); 234 | Check(L.Remove('abc', FromBeginning) = 1); 235 | Check(L.Remove(True) = 2); 236 | end; 237 | 238 | procedure THashedListTestCase.TestClear; 239 | var 240 | L: IList; 241 | begin 242 | L := HashedList([1, 'abc', 3.14, True]); 243 | L.Clear; 244 | Check(L.Count = 0); 245 | end; 246 | 247 | procedure THashedListTestCase.TestAssign; 248 | var 249 | L: IList; 250 | L2: Variant; 251 | I: Integer; 252 | begin 253 | L := HashedList([1, 'abc', 3.14, True]); 254 | L2 := HashedList([1, 2, 3]); 255 | Check(L2.Assign(L) = True); 256 | for I := 0 to 3 do Check(L[I] = L2.Get(I)); 257 | end; 258 | 259 | procedure THashedListTestCase.TestToArray; 260 | var 261 | L: IList; 262 | A: array of Integer; 263 | I: Integer; 264 | begin 265 | L := HashedList([1, 3, 4, 5, 9]); 266 | A := L.ToArray(varInteger); 267 | for I := 0 to Length(A) - 1 do Check(L[I] = A[I]); 268 | end; 269 | 270 | {$IF RTLVersion >= 17.00} // Delphi 2005 or later 271 | procedure THashedListTestCase.TestForIn; 272 | var 273 | L, L2: IList; 274 | V: Variant; 275 | begin 276 | L := HashedList([1, 'abc', 3.14, True]); 277 | L2 := THashedList.Create; 278 | for V in L do L2.Add(V); 279 | CheckEqualsList(L, L2); 280 | end; 281 | {$IFEND} 282 | 283 | 284 | procedure THashedListTestCase.TestSplit; 285 | var 286 | S: String; 287 | begin 288 | S := 'Monday, Tuesday, Wednesday, Thursday, Friday, Saturday, Sunday,'; 289 | CheckEqualsList( 290 | THashedList.Split(S), 291 | HashedList(['Monday', ' Tuesday', ' Wednesday', ' Thursday', ' Friday', ' Saturday', ' Sunday', '']), 292 | 'Split 1 failed' 293 | ); 294 | CheckEqualsList( 295 | THashedList.Split(S, ', '), 296 | HashedList(['Monday', 'Tuesday', 'Wednesday', 'Thursday', 'Friday', 'Saturday', 'Sunday,']), 297 | 'Split 2 failed' 298 | ); 299 | CheckEqualsList( 300 | THashedList.Split(S, ',', 4), 301 | HashedList(['Monday', ' Tuesday', ' Wednesday', ' Thursday, Friday, Saturday, Sunday,']), 302 | 'Split 3 failed' 303 | ); 304 | CheckEqualsList( 305 | THashedList.Split(S, ',', 0, true), 306 | HashedList(['Monday', 'Tuesday', 'Wednesday', 'Thursday', 'Friday', 'Saturday', 'Sunday', '']), 307 | 'Split 4 failed' 308 | ); 309 | CheckEqualsList( 310 | THashedList.Split(S, ',', 0, true, true), 311 | HashedList(['Monday', 'Tuesday', 'Wednesday', 'Thursday', 'Friday', 'Saturday', 'Sunday']), 312 | 'Split 5 failed' 313 | ); 314 | end; 315 | 316 | procedure THashedListTestCase.TestJoin; 317 | var 318 | S: String; 319 | L: IList; 320 | begin 321 | S := 'Monday,Tuesday,Wednesday,Thursday,Friday,Saturday,Sunday'; 322 | L := THashedList.Split(S); 323 | Check(L.Join('; ') = 'Monday; Tuesday; Wednesday; Thursday; Friday; Saturday; Sunday'); 324 | Check(L.Join('", "', '["', '"]') = '["Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Sunday"]'); 325 | end; 326 | 327 | procedure THashedListTestCase.TestItem; 328 | var 329 | L: IList; 330 | begin 331 | L := HashedList([1, 'abc', 3.14, True]); 332 | L[10] := 'test'; 333 | Check(VarIsEmpty(L[9])); 334 | Check(L[10] = 'test'); 335 | L.Put(12, 'hello'); 336 | Check(VarIsEmpty(L.Get(11))); 337 | Check(L.Get(12) = 'hello'); 338 | Check(VarIsEmpty(L.Get(-1))); 339 | end; 340 | 341 | procedure THashedListTestCase.TestPack; 342 | var 343 | L: IList; 344 | N: Integer; 345 | begin 346 | L := HashedList([1, 'abc', 3.14, True]); 347 | L[10] := 'test'; 348 | Check(L.Count = 11); 349 | Check(L[10] = 'test'); 350 | N := L.Capacity; 351 | L.Pack; 352 | Check(L.Count = 5); 353 | Check(L[4] = 'test'); 354 | Check(L.Capacity = N); 355 | L.TrimExcess; 356 | Check(L.Capacity <> N); 357 | Check(L.Count = L.Capacity); 358 | end; 359 | 360 | procedure THashedListTestCase.TestReverse; 361 | var 362 | L: IList; 363 | begin 364 | L := HashedList([1, 'abc', 3.14, True]); 365 | L.Reverse; 366 | CheckEqualsList(L, HashedList([True, 3.14, 'abc', 1])); 367 | end; 368 | 369 | procedure THashedListTestCase.TestSort; 370 | var 371 | L: IList; 372 | begin 373 | L := HashedList([3, 5, 1, 2, 4, 9, 7, 6, 8]); 374 | L.Sort; 375 | CheckEqualsList(L, HashedList([1, 2, 3, 4, 5, 6, 7, 8, 9])); 376 | end; 377 | 378 | procedure THashedListTestCase.TestShuffle; 379 | var 380 | Src, Dest: IList; 381 | Statistics: IList; 382 | M: IMap; 383 | I, J, N: Integer; 384 | begin 385 | Src := HashedList([0, 1, 2, 3, 4, 5, 6, 7, 8, 9]); 386 | Statistics := THashedList.Create(Src.Count); 387 | for I := 0 to Src.Count - 1 do 388 | Statistics[I] := HashMap([0, 0, 1, 0, 2, 0, 3, 0, 4, 0, 5, 0, 6, 0, 7, 0, 8, 0, 9, 0]); 389 | for I := 0 to 99999 do begin 390 | Dest := THashedList.Create(Src); 391 | Dest.Shuffle; 392 | for J := 0 to Statistics.Count - 1 do begin 393 | M := VarToMap(Statistics[J]); 394 | N := M.Get(Dest[J]); 395 | Inc(N); 396 | M.Put(Dest[J], N); 397 | end; 398 | end; 399 | for I := 0 to Statistics.Count - 1 do begin 400 | for J := 0 to Statistics[I].Count - 1 do begin 401 | N := Statistics[I].Values.Get(J); 402 | Check((9500 < N) and (N < 10500), Variant(N)); 403 | end; 404 | end; 405 | end; 406 | 407 | procedure THashedListTestCase.TestVariantPut; 408 | var 409 | L: IList; 410 | N: Integer; 411 | V: Variant; 412 | begin 413 | L := HashedList([1, 'abc', 3.14, True]); 414 | N := 10; 415 | L.Put(3, N); 416 | Check(L.Get(3) = 10); 417 | N := 11; 418 | Check(L.Get(3) = 10); 419 | 420 | N := 10; 421 | L.Put(3, Variant(N)); 422 | Check(L.Get(3) = 10); 423 | N := 11; 424 | Check(L.Get(3) = 10); 425 | 426 | V := 10; 427 | L.Put(3, V); 428 | Check(L.Get(3) = 10); 429 | V := 11; 430 | Check(L.Get(3) = 10); 431 | 432 | V := 10; 433 | L.Put(3, VarRef(V)); 434 | Check(L.Get(3) = 10); 435 | V := 11; 436 | Check(L.Get(3) = 11); 437 | end; 438 | 439 | initialization 440 | TestFramework.RegisterTest(THashedListTestCase.Suite); 441 | 442 | end. 443 | -------------------------------------------------------------------------------- /CppBuilder/HproseIndy10_5.cbproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | {3550A5A5-D89B-4588-B286-AAC33C884312} 4 | HproseIndy10_5.cpp 5 | 15.4 6 | Release 7 | True 8 | Library 9 | None 10 | 1 11 | Win32 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 | Cfg_1 40 | true 41 | true 42 | 43 | 44 | true 45 | Base 46 | true 47 | 48 | 49 | true 50 | Cfg_2 51 | true 52 | true 53 | 54 | 55 | true 56 | Cfg_2 57 | true 58 | true 59 | 60 | 61 | 2052 62 | true 63 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 64 | HproseIndy10_5 65 | System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) 66 | Hprose for C++ Builder with Indy10.5 67 | CppPackage 68 | true 69 | true 70 | true 71 | JPHNE 72 | true 73 | true 74 | ..\Source\Indy10_5\;..\Source\;$(BDS)\include;$(IncludePath) 75 | ..\Source\Indy10_5\;..\Source\;$(BDS)\lib;$(BDS)\lib\obj;$(BDS)\lib\psdk;$(ILINK_LibraryPath) 76 | false 77 | true 78 | true 79 | $(BDS)\lib\$(LANGDIR) 80 | 81 | 82 | $(BDS)\bin\default_app.manifest 83 | HproseIndy10_5_Icon.ico 84 | .dll 85 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 86 | 1033 87 | true 88 | 89 | 90 | HproseIndy10_5_Icon.ico 91 | $(BDS)\bin\default_app.manifest 92 | 93 | 94 | false 95 | true 96 | false 97 | true 98 | false 99 | Debug 100 | None 101 | DEBUG 102 | true 103 | true 104 | true 105 | $(BDS)\lib\debug;$(ILINK_LibraryPath) 106 | true 107 | Full 108 | true 109 | $(BDS)\lib\$(LANGDIR)\debug;$(ILINK_TranslatedLibraryPath) 110 | 111 | 112 | _DEBUG;$(Defines) 113 | 114 | 115 | _DEBUG;$(Defines) 116 | 117 | 118 | Release 119 | $(BDS)\lib\release;$(ILINK_LibraryPath) 120 | None 121 | $(BDS)\lib\$(LANGDIR)\release;$(ILINK_TranslatedLibraryPath) 122 | 123 | 124 | 1033 125 | NDEBUG;$(Defines) 126 | 127 | 128 | NDEBUG;$(Defines) 129 | 130 | 131 | 132 | 0 133 | 134 | 135 | 2 136 | 137 | 138 | 3 139 | 140 | 141 | 8 142 | 143 | 144 | 9 145 | 146 | 147 | 1 148 | 149 | 150 | 11 151 | 152 | 153 | 7 154 | 155 | 156 | 8 157 | 158 | 159 | 9 160 | 161 | 162 | 10 163 | 164 | 165 | 9 166 | 167 | 168 | Cfg_2 169 | Base 170 | 171 | 172 | Base 173 | 174 | 175 | Cfg_1 176 | Base 177 | 178 | 179 | 180 | 181 | 182 | CPlusPlusBuilder.Personality.12 183 | CppPackage 184 | 185 | 186 | 187 | HproseIndy10_5.cpp 188 | 189 | 190 | True 191 | False 192 | 1 193 | 0 194 | 0 195 | 0 196 | False 197 | False 198 | False 199 | False 200 | False 201 | 2052 202 | 936 203 | 204 | 205 | 206 | 207 | 1.0.0.0 208 | 209 | 210 | 211 | 212 | 213 | 1.0.0.0 214 | 215 | 216 | 217 | 218 | 219 | 220 | 221 | 222 | 223 | 224 | False 225 | 226 | False 227 | 228 | 229 | False 230 | True 231 | True 232 | False 233 | 234 | 235 | Embarcadero C++Builder Office 2000 Servers Package 236 | Embarcadero C++Builder Office XP Servers Package 237 | Microsoft Office 2000 Sample Automation Server Wrapper Components 238 | Microsoft Office XP Sample Automation Server Wrapper Components 239 | 240 | 241 | 242 | False 243 | True 244 | False 245 | 246 | 247 | 12 248 | 249 | 250 | -------------------------------------------------------------------------------- /Source/Synapse/synaip.pas: -------------------------------------------------------------------------------- 1 | {==============================================================================| 2 | | Project : Ararat Synapse | 001.002.001 | 3 | |==============================================================================| 4 | | Content: IP address support procedures and functions | 5 | |==============================================================================| 6 | | Copyright (c)2006-2010, Lukas Gebauer | 7 | | All rights reserved. | 8 | | | 9 | | Redistribution and use in source and binary forms, with or without | 10 | | modification, are permitted provided that the following conditions are met: | 11 | | | 12 | | Redistributions of source code must retain the above copyright notice, this | 13 | | list of conditions and the following disclaimer. | 14 | | | 15 | | Redistributions in binary form must reproduce the above copyright notice, | 16 | | this list of conditions and the following disclaimer in the documentation | 17 | | and/or other materials provided with the distribution. | 18 | | | 19 | | Neither the name of Lukas Gebauer nor the names of its contributors may | 20 | | be used to endorse or promote products derived from this software without | 21 | | specific prior written permission. | 22 | | | 23 | | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | 24 | | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | 25 | | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | 26 | | ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR | 27 | | ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL | 28 | | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR | 29 | | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER | 30 | | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT | 31 | | LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY | 32 | | OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH | 33 | | DAMAGE. | 34 | |==============================================================================| 35 | | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).| 36 | | Portions created by Lukas Gebauer are Copyright (c) 2006-2010. | 37 | | All Rights Reserved. | 38 | |==============================================================================| 39 | | Contributor(s): | 40 | |==============================================================================| 41 | | History: see HISTORY.HTM from distribution package | 42 | | (Found at URL: http://www.ararat.cz/synapse/) | 43 | |==============================================================================} 44 | 45 | {:@abstract(IP adress support procedures and functions)} 46 | 47 | {$IFDEF FPC} 48 | {$MODE DELPHI} 49 | {$ENDIF} 50 | {$Q-} 51 | {$R-} 52 | {$H+} 53 | 54 | {$IFNDEF FPC} 55 | {$IFDEF UNICODE} 56 | {$WARN IMPLICIT_STRING_CAST OFF} 57 | {$WARN IMPLICIT_STRING_CAST_LOSS OFF} 58 | {$WARN SUSPICIOUS_TYPECAST OFF} 59 | {$ENDIF} 60 | {$ENDIF} 61 | 62 | unit synaip; 63 | 64 | interface 65 | 66 | uses 67 | SysUtils, SynaUtil; 68 | 69 | type 70 | {:binary form of IPv6 adress (for string conversion routines)} 71 | TIp6Bytes = array [0..15] of Byte; 72 | {:binary form of IPv6 adress (for string conversion routines)} 73 | TIp6Words = array [0..7] of Word; 74 | 75 | {:Returns @TRUE, if "Value" is a valid IPv4 address. Cannot be a symbolic Name!} 76 | function IsIP(const Value: string): Boolean; 77 | 78 | {:Returns @TRUE, if "Value" is a valid IPv6 address. Cannot be a symbolic Name!} 79 | function IsIP6(const Value: string): Boolean; 80 | 81 | {:Returns a string with the "Host" ip address converted to binary form.} 82 | function IPToID(Host: string): Ansistring; 83 | 84 | {:Convert IPv6 address from their string form to binary byte array.} 85 | function StrToIp6(value: string): TIp6Bytes; 86 | 87 | {:Convert IPv6 address from binary byte array to string form.} 88 | function Ip6ToStr(value: TIp6Bytes): string; 89 | 90 | {:Convert IPv4 address from their string form to binary.} 91 | function StrToIp(value: string): integer; 92 | 93 | {:Convert IPv4 address from binary to string form.} 94 | function IpToStr(value: integer): string; 95 | 96 | {:Convert IPv4 address to reverse form.} 97 | function ReverseIP(Value: AnsiString): AnsiString; 98 | 99 | {:Convert IPv6 address to reverse form.} 100 | function ReverseIP6(Value: AnsiString): AnsiString; 101 | 102 | {:Expand short form of IPv6 address to long form.} 103 | function ExpandIP6(Value: AnsiString): AnsiString; 104 | 105 | 106 | implementation 107 | 108 | {==============================================================================} 109 | 110 | function IsIP(const Value: string): Boolean; 111 | var 112 | TempIP: string; 113 | function ByteIsOk(const Value: string): Boolean; 114 | var 115 | x, n: integer; 116 | begin 117 | x := StrToIntDef(Value, -1); 118 | Result := (x >= 0) and (x < 256); 119 | // X may be in correct range, but value still may not be correct value! 120 | // i.e. "$80" 121 | if Result then 122 | for n := 1 to length(Value) do 123 | if not (AnsiChar(Value[n]) in ['0'..'9']) then 124 | begin 125 | Result := False; 126 | Break; 127 | end; 128 | end; 129 | begin 130 | TempIP := Value; 131 | Result := False; 132 | if not ByteIsOk(Fetch(TempIP, '.')) then 133 | Exit; 134 | if not ByteIsOk(Fetch(TempIP, '.')) then 135 | Exit; 136 | if not ByteIsOk(Fetch(TempIP, '.')) then 137 | Exit; 138 | if ByteIsOk(TempIP) then 139 | Result := True; 140 | end; 141 | 142 | {==============================================================================} 143 | 144 | function IsIP6(const Value: string): Boolean; 145 | var 146 | TempIP: string; 147 | s,t: string; 148 | x: integer; 149 | partcount: integer; 150 | zerocount: integer; 151 | First: Boolean; 152 | begin 153 | TempIP := Value; 154 | Result := False; 155 | if Value = '::' then 156 | begin 157 | Result := True; 158 | Exit; 159 | end; 160 | partcount := 0; 161 | zerocount := 0; 162 | First := True; 163 | while tempIP <> '' do 164 | begin 165 | s := fetch(TempIP, ':'); 166 | if not(First) and (s = '') then 167 | Inc(zerocount); 168 | First := False; 169 | if zerocount > 1 then 170 | break; 171 | Inc(partCount); 172 | if s = '' then 173 | Continue; 174 | if partCount > 8 then 175 | break; 176 | if tempIP = '' then 177 | begin 178 | t := SeparateRight(s, '%'); 179 | s := SeparateLeft(s, '%'); 180 | x := StrToIntDef('$' + t, -1); 181 | if (x < 0) or (x > $ffff) then 182 | break; 183 | end; 184 | x := StrToIntDef('$' + s, -1); 185 | if (x < 0) or (x > $ffff) then 186 | break; 187 | if tempIP = '' then 188 | if not((PartCount = 1) and (ZeroCount = 0)) then 189 | Result := True; 190 | end; 191 | end; 192 | 193 | {==============================================================================} 194 | function IPToID(Host: string): Ansistring; 195 | var 196 | s: string; 197 | i, x: Integer; 198 | begin 199 | Result := ''; 200 | for x := 0 to 3 do 201 | begin 202 | s := Fetch(Host, '.'); 203 | i := StrToIntDef(s, 0); 204 | Result := Result + AnsiChar(i); 205 | end; 206 | end; 207 | 208 | {==============================================================================} 209 | 210 | function StrToIp(value: string): integer; 211 | var 212 | s: string; 213 | i, x: Integer; 214 | begin 215 | Result := 0; 216 | for x := 0 to 3 do 217 | begin 218 | s := Fetch(value, '.'); 219 | i := StrToIntDef(s, 0); 220 | Result := (256 * Result) + i; 221 | end; 222 | end; 223 | 224 | {==============================================================================} 225 | 226 | function IpToStr(value: integer): string; 227 | var 228 | x1, x2: word; 229 | y1, y2: byte; 230 | begin 231 | Result := ''; 232 | x1 := value shr 16; 233 | x2 := value and $FFFF; 234 | y1 := x1 div $100; 235 | y2 := x1 mod $100; 236 | Result := inttostr(y1) + '.' + inttostr(y2) + '.'; 237 | y1 := x2 div $100; 238 | y2 := x2 mod $100; 239 | Result := Result + inttostr(y1) + '.' + inttostr(y2); 240 | end; 241 | 242 | {==============================================================================} 243 | 244 | function ExpandIP6(Value: AnsiString): AnsiString; 245 | var 246 | n: integer; 247 | s: ansistring; 248 | x: integer; 249 | begin 250 | Result := ''; 251 | if value = '' then 252 | exit; 253 | x := countofchar(value, ':'); 254 | if x > 7 then 255 | exit; 256 | if value[1] = ':' then 257 | value := '0' + value; 258 | if value[length(value)] = ':' then 259 | value := value + '0'; 260 | x := 8 - x; 261 | s := ''; 262 | for n := 1 to x do 263 | s := s + ':0'; 264 | s := s + ':'; 265 | Result := replacestring(value, '::', s); 266 | end; 267 | {==============================================================================} 268 | 269 | function StrToIp6(Value: string): TIp6Bytes; 270 | var 271 | IPv6: TIp6Words; 272 | Index: Integer; 273 | n: integer; 274 | b1, b2: byte; 275 | s: string; 276 | x: integer; 277 | begin 278 | for n := 0 to 15 do 279 | Result[n] := 0; 280 | for n := 0 to 7 do 281 | Ipv6[n] := 0; 282 | Index := 0; 283 | Value := ExpandIP6(value); 284 | if value = '' then 285 | exit; 286 | while Value <> '' do 287 | begin 288 | if Index > 7 then 289 | Exit; 290 | s := fetch(value, ':'); 291 | if s = '@' then 292 | break; 293 | if s = '' then 294 | begin 295 | IPv6[Index] := 0; 296 | end 297 | else 298 | begin 299 | x := StrToIntDef('$' + s, -1); 300 | if (x > 65535) or (x < 0) then 301 | Exit; 302 | IPv6[Index] := x; 303 | end; 304 | Inc(Index); 305 | end; 306 | for n := 0 to 7 do 307 | begin 308 | b1 := ipv6[n] div 256; 309 | b2 := ipv6[n] mod 256; 310 | Result[n * 2] := b1; 311 | Result[(n * 2) + 1] := b2; 312 | end; 313 | end; 314 | 315 | {==============================================================================} 316 | //based on routine by the Free Pascal development team 317 | function Ip6ToStr(value: TIp6Bytes): string; 318 | var 319 | i, x: byte; 320 | zr1,zr2: set of byte; 321 | zc1,zc2: byte; 322 | have_skipped: boolean; 323 | ip6w: TIp6words; 324 | begin 325 | zr1 := []; 326 | zr2 := []; 327 | zc1 := 0; 328 | zc2 := 0; 329 | for i := 0 to 7 do 330 | begin 331 | x := i * 2; 332 | ip6w[i] := value[x] * 256 + value[x + 1]; 333 | if ip6w[i] = 0 then 334 | begin 335 | include(zr2, i); 336 | inc(zc2); 337 | end 338 | else 339 | begin 340 | if zc1 < zc2 then 341 | begin 342 | zc1 := zc2; 343 | zr1 := zr2; 344 | zc2 := 0; 345 | zr2 := []; 346 | end; 347 | end; 348 | end; 349 | if zc1 < zc2 then 350 | begin 351 | zr1 := zr2; 352 | end; 353 | SetLength(Result, 8*5-1); 354 | SetLength(Result, 0); 355 | have_skipped := false; 356 | for i := 0 to 7 do 357 | begin 358 | if not(i in zr1) then 359 | begin 360 | if have_skipped then 361 | begin 362 | if Result = '' then 363 | Result := '::' 364 | else 365 | Result := Result + ':'; 366 | have_skipped := false; 367 | end; 368 | Result := Result + IntToHex(Ip6w[i], 1) + ':'; 369 | end 370 | else 371 | begin 372 | have_skipped := true; 373 | end; 374 | end; 375 | if have_skipped then 376 | if Result = '' then 377 | Result := '::0' 378 | else 379 | Result := Result + ':'; 380 | 381 | if Result = '' then 382 | Result := '::0'; 383 | if not (7 in zr1) then 384 | SetLength(Result, Length(Result)-1); 385 | Result := LowerCase(result); 386 | end; 387 | 388 | {==============================================================================} 389 | function ReverseIP(Value: AnsiString): AnsiString; 390 | var 391 | x: Integer; 392 | begin 393 | Result := ''; 394 | repeat 395 | x := LastDelimiter('.', Value); 396 | Result := Result + '.' + Copy(Value, x + 1, Length(Value) - x); 397 | Delete(Value, x, Length(Value) - x + 1); 398 | until x < 1; 399 | if Length(Result) > 0 then 400 | if Result[1] = '.' then 401 | Delete(Result, 1, 1); 402 | end; 403 | 404 | {==============================================================================} 405 | function ReverseIP6(Value: AnsiString): AnsiString; 406 | var 407 | ip6: TIp6bytes; 408 | n: integer; 409 | x, y: integer; 410 | begin 411 | ip6 := StrToIP6(Value); 412 | x := ip6[15] div 16; 413 | y := ip6[15] mod 16; 414 | Result := IntToHex(y, 1) + '.' + IntToHex(x, 1); 415 | for n := 14 downto 0 do 416 | begin 417 | x := ip6[n] div 16; 418 | y := ip6[n] mod 16; 419 | Result := Result + '.' + IntToHex(y, 1) + '.' + IntToHex(x, 1); 420 | end; 421 | end; 422 | 423 | {==============================================================================} 424 | end. 425 | --------------------------------------------------------------------------------