├── .gitignore ├── README.md ├── SimpleIoC.inc ├── SimpleIoC.pas ├── SimpleIoCTests.dpr ├── SimpleIoCTests.dproj └── Tests └── IoCTests.pas /.gitignore: -------------------------------------------------------------------------------- 1 | # Compiled source # 2 | ################### 3 | *.dcu 4 | *.obj 5 | *.exe 6 | *.bpl 7 | *.lib 8 | *.bpi 9 | *.res 10 | 11 | # Other generated files 12 | ################### 13 | *.rsm 14 | *.map 15 | 16 | # Backup files # 17 | ################### 18 | *.~* 19 | 20 | # IDE Files # 21 | ################### 22 | *.dproj.local 23 | *.groupproj.local 24 | *.identcache 25 | *.dsk 26 | *.tvsconfig 27 | *.otares 28 | 29 | # DUnit # 30 | dunit.ini 31 | 32 | # Output Folders # 33 | ################### 34 | /Win32 35 | /Win64 36 | /__history 37 | /Tests/__history 38 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Simple-IoC 2 | ========== 3 | 4 | A Simple IoC Container for Delphi 2010 or later 5 | 6 | -------------------------------------------------------------------------------- /SimpleIoC.inc: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { SimpleIoC } 4 | { } 5 | { Copyright (C) 2013 Vincent Parrett } 6 | { } 7 | { vincent@finalbuilder.com } 8 | { http://www.finalbuilder.com } 9 | { } 10 | { } 11 | {***************************************************************************} 12 | { } 13 | { Licensed under the Apache License, Version 2.0 (the "License"); } 14 | { you may not use this file except in compliance with the License. } 15 | { You may obtain a copy of the License at } 16 | { } 17 | { http://www.apache.org/licenses/LICENSE-2.0 } 18 | { } 19 | { Unless required by applicable law or agreed to in writing, software } 20 | { distributed under the License is distributed on an "AS IS" BASIS, } 21 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 22 | { See the License for the specific language governing permissions and } 23 | { limitations under the License. } 24 | { } 25 | {***************************************************************************} 26 | 27 | {$DEFINE UNSUPPORTED_COMPILER_VERSION} 28 | 29 | {$DEFINE DELPHI_BERLIN_DOWN} 30 | {$DEFINE DELPHI_SEATTLE_DOWN} 31 | {$DEFINE DELPHI_XE8_DOWN} 32 | {$DEFINE DELPHI_XE7_DOWN} 33 | {$DEFINE DELPHI_XE6_DOWN} 34 | {$DEFINE DELPHI_XE5_DOWN} 35 | {$DEFINE DELPHI_XE4_DOWN} 36 | {$DEFINE DELPHI_XE3_DOWN} 37 | {$DEFINE DELPHI_XE2_DOWN} 38 | {$DEFINE DELPHI_XE_DOWN} 39 | {$DEFINE DELPHI_2010_DOWN} 40 | 41 | {$IFDEF VER210} // RAD Studio 2010 42 | {$DEFINE DELPHI_2010} 43 | {$DEFINE DELPHI_2010_UP} 44 | {$DEFINE CPUX86} 45 | {$UNDEF UNSUPPORTED_COMPILER_VERSION} 46 | {$ENDIF VER210} 47 | 48 | {$IFDEF VER220} // RAD Studio XE 49 | {$DEFINE DELPHI_2010_UP} 50 | {$DEFINE DELPHI_XE} 51 | {$DEFINE DELPHI_XE_UP} 52 | {$DEFINE SUPPORTS_REGEX} 53 | {$DEFINE CPUX86} 54 | {$UNDEF UNSUPPORTED_COMPILER_VERSION} 55 | {$UNDEF DELPHI_2010_DOWN} 56 | {$ENDIF VER220} 57 | 58 | {$IFDEF VER230} // RAD Studio XE2 59 | {$DEFINE DELPHI_2010_UP} 60 | {$DEFINE DELPHI_XE_UP} 61 | {$DEFINE DELPHI_XE2} 62 | {$DEFINE DELPHI_XE2_UP} 63 | {$DEFINE SUPPORTS_REGEX} 64 | {$UNDEF UNSUPPORTED_COMPILER_VERSION} 65 | {$UNDEF DELPHI_2010_DOWN} 66 | {$UNDEF DELPHI_XE_DOWN} 67 | {$ENDIF VER230} 68 | 69 | {$IFDEF VER240} // RAD Studio XE3 70 | {$DEFINE DELPHI_2010_UP} 71 | {$DEFINE DELPHI_XE_UP} 72 | {$DEFINE DELPHI_XE2_UP} 73 | {$DEFINE DELPHI_XE3} 74 | {$DEFINE DELPHI_XE3_UP} 75 | {$DEFINE SUPPORTS_REGEX} 76 | {$UNDEF UNSUPPORTED_COMPILER_VERSION} 77 | {$UNDEF DELPHI_2010_DOWN} 78 | {$UNDEF DELPHI_XE_DOWN} 79 | {$UNDEF DELPHI_XE2_DOWN} 80 | {$ENDIF VER240} 81 | 82 | {$IFDEF VER250} // RAD Studio XE4 83 | {$DEFINE DELPHI_2010_UP} 84 | {$DEFINE DELPHI_XE_UP} 85 | {$DEFINE DELPHI_XE2_UP} 86 | {$DEFINE DELPHI_XE3_UP} 87 | {$DEFINE DELPHI_XE4} 88 | {$DEFINE DELPHI_XE4_UP} 89 | {$DEFINE SUPPORTS_REGEX} 90 | {$UNDEF UNSUPPORTED_COMPILER_VERSION} 91 | {$UNDEF DELPHI_2010_DOWN} 92 | {$UNDEF DELPHI_XE_DOWN} 93 | {$UNDEF DELPHI_XE2_DOWN} 94 | {$UNDEF DELPHI_XE3_DOWN} 95 | {$ENDIF VER250} 96 | 97 | {$IFDEF VER260} // RAD Studio XE5 98 | {$DEFINE DELPHI_2010_UP} 99 | {$DEFINE DELPHI_XE_UP} 100 | {$DEFINE DELPHI_XE2_UP} 101 | {$DEFINE DELPHI_XE3_UP} 102 | {$DEFINE DELPHI_XE4} 103 | {$DEFINE DELPHI_XE4_UP} 104 | {$DEFINE DELPHI_XE5} 105 | {$DEFINE DELPHI_XE5_UP} 106 | {$DEFINE SUPPORTS_REGEX} 107 | {$UNDEF UNSUPPORTED_COMPILER_VERSION} 108 | {$UNDEF DELPHI_2010_DOWN} 109 | {$UNDEF DELPHI_XE_DOWN} 110 | {$UNDEF DELPHI_XE2_DOWN} 111 | {$UNDEF DELPHI_XE3_DOWN} 112 | {$UNDEF DELPHI_XE4_DOWN} 113 | {$ENDIF VER260} 114 | 115 | {$IFDEF VER270} // RAD Studio XE6 116 | {$DEFINE DELPHI_2010_UP} 117 | {$DEFINE DELPHI_XE_UP} 118 | {$DEFINE DELPHI_XE2_UP} 119 | {$DEFINE DELPHI_XE3_UP} 120 | {$DEFINE DELPHI_XE4} 121 | {$DEFINE DELPHI_XE4_UP} 122 | {$DEFINE DELPHI_XE5} 123 | {$DEFINE DELPHI_XE5_UP} 124 | {$DEFINE DELPHI_XE6} 125 | {$DEFINE DELPHI_XE6_UP} 126 | {$DEFINE SUPPORTS_REGEX} 127 | {$UNDEF UNSUPPORTED_COMPILER_VERSION} 128 | {$UNDEF DELPHI_2010_DOWN} 129 | {$UNDEF DELPHI_XE_DOWN} 130 | {$UNDEF DELPHI_XE2_DOWN} 131 | {$UNDEF DELPHI_XE3_DOWN} 132 | {$UNDEF DELPHI_XE4_DOWN} 133 | {$UNDEF DELPHI_XE5_DOWN} 134 | {$ENDIF VER270} 135 | 136 | {$IFDEF VER280} // RAD Studio XE7 137 | {$DEFINE DELPHI_2010_UP} 138 | {$DEFINE DELPHI_XE_UP} 139 | {$DEFINE DELPHI_XE2_UP} 140 | {$DEFINE DELPHI_XE3_UP} 141 | {$DEFINE DELPHI_XE4} 142 | {$DEFINE DELPHI_XE4_UP} 143 | {$DEFINE DELPHI_XE5} 144 | {$DEFINE DELPHI_XE5_UP} 145 | {$DEFINE DELPHI_XE6} 146 | {$DEFINE DELPHI_XE6_UP} 147 | {$DEFINE DELPHI_XE7} 148 | {$DEFINE DELPHI_XE7_UP} 149 | {$DEFINE SUPPORTS_REGEX} 150 | {$UNDEF UNSUPPORTED_COMPILER_VERSION} 151 | {$UNDEF DELPHI_2010_DOWN} 152 | {$UNDEF DELPHI_XE_DOWN} 153 | {$UNDEF DELPHI_XE2_DOWN} 154 | {$UNDEF DELPHI_XE3_DOWN} 155 | {$UNDEF DELPHI_XE4_DOWN} 156 | {$UNDEF DELPHI_XE5_DOWN} 157 | {$UNDEF DELPHI_XE6_DOWN} 158 | {$ENDIF VER280} 159 | 160 | {$IFDEF VER290} // RAD Studio XE8 161 | {$DEFINE DELPHI_2010_UP} 162 | {$DEFINE DELPHI_XE_UP} 163 | {$DEFINE DELPHI_XE2_UP} 164 | {$DEFINE DELPHI_XE3_UP} 165 | {$DEFINE DELPHI_XE4} 166 | {$DEFINE DELPHI_XE4_UP} 167 | {$DEFINE DELPHI_XE5} 168 | {$DEFINE DELPHI_XE5_UP} 169 | {$DEFINE DELPHI_XE6} 170 | {$DEFINE DELPHI_XE6_UP} 171 | {$DEFINE DELPHI_XE7} 172 | {$DEFINE DELPHI_XE7_UP} 173 | {$DEFINE DELPHI_XE8} 174 | {$DEFINE DELPHI_XE8_UP} 175 | {$DEFINE SUPPORTS_REGEX} 176 | {$UNDEF UNSUPPORTED_COMPILER_VERSION} 177 | {$UNDEF DELPHI_2010_DOWN} 178 | {$UNDEF DELPHI_XE_DOWN} 179 | {$UNDEF DELPHI_XE2_DOWN} 180 | {$UNDEF DELPHI_XE3_DOWN} 181 | {$UNDEF DELPHI_XE4_DOWN} 182 | {$UNDEF DELPHI_XE5_DOWN} 183 | {$UNDEF DELPHI_XE6_DOWN} 184 | {$UNDEF DELPHI_XE7_DOWN} 185 | {$ENDIF VER290} 186 | 187 | {$IFDEF VER300} // RAD Studio Seattle 188 | {$DEFINE DELPHI_2010_UP} 189 | {$DEFINE DELPHI_XE_UP} 190 | {$DEFINE DELPHI_XE2_UP} 191 | {$DEFINE DELPHI_XE3_UP} 192 | {$DEFINE DELPHI_XE4} 193 | {$DEFINE DELPHI_XE4_UP} 194 | {$DEFINE DELPHI_XE5} 195 | {$DEFINE DELPHI_XE5_UP} 196 | {$DEFINE DELPHI_XE6} 197 | {$DEFINE DELPHI_XE6_UP} 198 | {$DEFINE DELPHI_XE7} 199 | {$DEFINE DELPHI_XE7_UP} 200 | {$DEFINE DELPHI_XE8} 201 | {$DEFINE DELPHI_XE8_UP} 202 | {$DEFINE DELPHI_SEATTLE} 203 | {$DEFINE DELPHI_SEATTLE_UP} 204 | {$DEFINE SUPPORTS_REGEX} 205 | {$UNDEF UNSUPPORTED_COMPILER_VERSION} 206 | {$UNDEF DELPHI_2010_DOWN} 207 | {$UNDEF DELPHI_XE_DOWN} 208 | {$UNDEF DELPHI_XE2_DOWN} 209 | {$UNDEF DELPHI_XE3_DOWN} 210 | {$UNDEF DELPHI_XE4_DOWN} 211 | {$UNDEF DELPHI_XE5_DOWN} 212 | {$UNDEF DELPHI_XE6_DOWN} 213 | {$UNDEF DELPHI_XE7_DOWN} 214 | {$UNDEF DELPHI_XE8_DOWN} 215 | {$ENDIF VER300} 216 | 217 | {$IFDEF VER310} // RAD Studio Berling 218 | {$DEFINE DELPHI_2010_UP} 219 | {$DEFINE DELPHI_XE_UP} 220 | {$DEFINE DELPHI_XE2_UP} 221 | {$DEFINE DELPHI_XE3_UP} 222 | {$DEFINE DELPHI_XE4} 223 | {$DEFINE DELPHI_XE4_UP} 224 | {$DEFINE DELPHI_XE5} 225 | {$DEFINE DELPHI_XE5_UP} 226 | {$DEFINE DELPHI_XE6} 227 | {$DEFINE DELPHI_XE6_UP} 228 | {$DEFINE DELPHI_XE7} 229 | {$DEFINE DELPHI_XE7_UP} 230 | {$DEFINE DELPHI_XE8} 231 | {$DEFINE DELPHI_XE8_UP} 232 | {$DEFINE DELPHI_SEATTLE} 233 | {$DEFINE DELPHI_SEATTLE_UP} 234 | {$DEFINE DELPHI_BERLIN} 235 | {$DEFINE DELPHI_BERLIN_UP} 236 | {$DEFINE SUPPORTS_REGEX} 237 | {$UNDEF UNSUPPORTED_COMPILER_VERSION} 238 | {$UNDEF DELPHI_2010_DOWN} 239 | {$UNDEF DELPHI_XE_DOWN} 240 | {$UNDEF DELPHI_XE2_DOWN} 241 | {$UNDEF DELPHI_XE3_DOWN} 242 | {$UNDEF DELPHI_XE4_DOWN} 243 | {$UNDEF DELPHI_XE5_DOWN} 244 | {$UNDEF DELPHI_XE6_DOWN} 245 | {$UNDEF DELPHI_XE7_DOWN} 246 | {$UNDEF DELPHI_XE8_DOWN} 247 | {$UNDEF DELPHI_SEATTLE_DOWN} 248 | {$ENDIF VER310} 249 | 250 | {$IFDEF VER320} // RAD Studio Tokyo 251 | {$DEFINE DELPHI_2010_UP} 252 | {$DEFINE DELPHI_XE_UP} 253 | {$DEFINE DELPHI_XE2_UP} 254 | {$DEFINE DELPHI_XE3_UP} 255 | {$DEFINE DELPHI_XE4} 256 | {$DEFINE DELPHI_XE4_UP} 257 | {$DEFINE DELPHI_XE5} 258 | {$DEFINE DELPHI_XE5_UP} 259 | {$DEFINE DELPHI_XE6} 260 | {$DEFINE DELPHI_XE6_UP} 261 | {$DEFINE DELPHI_XE7} 262 | {$DEFINE DELPHI_XE7_UP} 263 | {$DEFINE DELPHI_XE8} 264 | {$DEFINE DELPHI_XE8_UP} 265 | {$DEFINE DELPHI_SEATTLE} 266 | {$DEFINE DELPHI_SEATTLE_UP} 267 | {$DEFINE DELPHI_BERLIN} 268 | {$DEFINE DELPHI_BERLIN_UP} 269 | {$DEFINE DELPHI_TOKYO} 270 | {$DEFINE DELPHI_TOKYO_UP} 271 | {$DEFINE SUPPORTS_REGEX} 272 | {$UNDEF UNSUPPORTED_COMPILER_VERSION} 273 | {$UNDEF DELPHI_2010_DOWN} 274 | {$UNDEF DELPHI_XE_DOWN} 275 | {$UNDEF DELPHI_XE2_DOWN} 276 | {$UNDEF DELPHI_XE3_DOWN} 277 | {$UNDEF DELPHI_XE4_DOWN} 278 | {$UNDEF DELPHI_XE5_DOWN} 279 | {$UNDEF DELPHI_XE6_DOWN} 280 | {$UNDEF DELPHI_XE7_DOWN} 281 | {$UNDEF DELPHI_XE8_DOWN} 282 | {$UNDEF DELPHI_SEATTLE_DOWN} 283 | {$ENDIF VER320} 284 | 285 | 286 | {$IFDEF UNSUPPORTED_COMPILER_VERSION} 287 | Unsupported Compiler Version (Delphi 2010 or later required!) 288 | {$ENDIF} 289 | -------------------------------------------------------------------------------- /SimpleIoC.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { Simple.IoC } 4 | { } 5 | { Copyright (C) 2013 Vincent Parrett } 6 | { } 7 | { http://www.finalbuilder.com } 8 | { } 9 | { } 10 | {***************************************************************************} 11 | { } 12 | { Licensed under the Apache License, Version 2.0 (the "License"); } 13 | { you may not use this file except in compliance with the License. } 14 | { You may obtain a copy of the License at } 15 | { } 16 | { http://www.apache.org/licenses/LICENSE-2.0 } 17 | { } 18 | { Unless required by applicable law or agreed to in writing, software } 19 | { distributed under the License is distributed on an "AS IS" BASIS, } 20 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 21 | { See the License for the specific language governing permissions and } 22 | { limitations under the License. } 23 | { } 24 | {***************************************************************************} 25 | 26 | unit SimpleIoC; 27 | 28 | 29 | /// A Simple IoC container. Does not do Dependency Injects. 30 | 31 | interface 32 | 33 | uses 34 | Generics.Collections, 35 | TypInfo, 36 | Rtti, 37 | SysUtils; 38 | 39 | {$I 'SimpleIoC.inc'} 40 | 41 | type 42 | TResolveResult = (Unknown, Success, InterfaceNotRegistered, ImplNotRegistered, DeletegateFailedCreate); 43 | 44 | TActivatorDelegate = reference to function: TInterface; 45 | 46 | 47 | 48 | TSimpleIoC = class 49 | private 50 | FRaiseIfNotFound : boolean; 51 | FContainerInfo : TDictionary; 52 | type 53 | TIoCRegistration = class 54 | IInterface : PTypeInfo; 55 | ImplClass : TClass; 56 | ActivatorDelegate : TActivatorDelegate; 57 | IsSingleton : boolean; 58 | Instance : IInterface; 59 | end; 60 | 61 | private 62 | class var FDefault : TSimpleIoC; 63 | class destructor ClassDestroy; 64 | protected 65 | function GetInterfaceKey(const AName: string = ''): string; 66 | function InternalResolve(out AInterface: TInterface; const AName: string = ''): TResolveResult; 67 | procedure InternalRegisterType(const singleton : boolean; const AImplementation : TClass; const delegate : TActivatorDelegate; const name : string = ''); 68 | public 69 | constructor Create; 70 | destructor Destroy;override; 71 | //Default Container 72 | class function DefaultContainer : TSimpleIoC; 73 | {$IFDEF DELPHI_XE_UP} 74 | //Exe's compiled with D2010 will crash when these are used. 75 | //NOTES: The issue is due to the two generics included in the functions. The constaints also seem to be an issue. 76 | procedure RegisterType(const name : string = '');overload; 77 | procedure RegisterType(const singleton : boolean;const name : string = '');overload; 78 | {$ENDIF} 79 | procedure RegisterType(const delegate : TActivatorDelegate; const name : string = '' );overload; 80 | procedure RegisterType(const singleton : boolean;const delegate : TActivatorDelegate; const name : string = '');overload; 81 | 82 | //Register an instance as a signleton. If there is more than one instance that implements the interface 83 | //then use the name parameter 84 | procedure RegisterSingleton(const instance : TInterface; const name : string = ''); 85 | 86 | //Resolution 87 | function Resolve(const name: string = ''): TInterface; 88 | 89 | //Returns true if we have such a service. 90 | function HasService : boolean; 91 | 92 | //Empty the Container.. usefull for testing only! 93 | procedure Clear; 94 | 95 | property RaiseIfNotFound : boolean read FRaiseIfNotFound write FRaiseIfNotFound; 96 | 97 | 98 | 99 | end; 100 | 101 | EIoCException = class(Exception); 102 | EIoCRegistrationException = class(EIoCException); 103 | EIoCResolutionException = class(EIoCException); 104 | 105 | 106 | //Makes sure virtual constructors are called correctly. Just using a class reference will not call the overriden constructor! 107 | //See http://stackoverflow.com/questions/791069/how-can-i-create-an-delphi-object-from-a-class-reference-and-ensure-constructor 108 | TClassActivator = class 109 | private 110 | class var 111 | FRttiCtx : TRttiContext; 112 | class constructor Create; 113 | public 114 | class function CreateInstance(const AClass : TClass) : IInterface; 115 | end; 116 | 117 | 118 | implementation 119 | 120 | 121 | { TActivator } 122 | 123 | class constructor TClassActivator.Create; 124 | begin 125 | TClassActivator.FRttiCtx := TRttiContext.Create; 126 | end; 127 | 128 | class function TClassActivator.CreateInstance(const AClass : TClass): IInterface; 129 | var 130 | rType : TRttiType; 131 | method: TRttiMethod; 132 | begin 133 | result := nil; 134 | 135 | rType := FRttiCtx.GetType(AClass); 136 | if not (rType is TRttiInstanceType) then 137 | exit; 138 | 139 | for method in TRttiInstanceType(rType).GetMethods do 140 | begin 141 | if method.IsConstructor and (Length(method.GetParameters) = 0) then 142 | begin 143 | Result := method.Invoke(TRttiInstanceType(rtype).MetaclassType, []).AsInterface; 144 | Break; 145 | end; 146 | end; 147 | 148 | end; 149 | 150 | 151 | 152 | 153 | function TSimpleIoC.HasService: boolean; 154 | begin 155 | result := Resolve <> nil; 156 | end; 157 | 158 | {$IFDEF DELPHI_XE_UP} 159 | 160 | procedure TSimpleIoC.RegisterType(const name: string); 161 | begin 162 | InternalRegisterType(false,TImplementation,nil,name); 163 | end; 164 | 165 | procedure TSimpleIoC.RegisterType(const singleton: boolean; const name: string); 166 | begin 167 | InternalRegisterType(singleton,TImplementation,nil,name); 168 | end; 169 | {$ENDIF} 170 | 171 | 172 | procedure TSimpleIoC.RegisterType(const delegate: TActivatorDelegate; const name: string); 173 | begin 174 | InternalRegisterType(false, nil,delegate, name); 175 | end; 176 | 177 | procedure TSimpleIoC.InternalRegisterType(const singleton : boolean; const AImplementation : TClass; const delegate : TActivatorDelegate; const name : string = ''); 178 | var 179 | key : string; 180 | pInfo : PTypeInfo; 181 | rego : TIoCRegistration; 182 | o : TObject; 183 | newName : string; 184 | newSingleton : boolean; 185 | begin 186 | newSingleton := singleton; 187 | newName := name; 188 | 189 | pInfo := TypeInfo(TInterface); 190 | if newName = '' then 191 | {$IFDEF NEXTGEN} 192 | key := pInfo.Name.ToString 193 | {$ELSE} 194 | key := string(pInfo.Name) 195 | {$ENDIF} 196 | else 197 | {$IFDEF NEXTGEN} 198 | key := pInfo.Name.ToString + '_' + newName; 199 | {$ELSE} 200 | key := pInfo.Name + '_' + newName; 201 | {$ENDIF} 202 | key := LowerCase(key); 203 | 204 | if not FContainerInfo.TryGetValue(key,o) then 205 | begin 206 | rego := TIoCRegistration.Create; 207 | rego.IInterface := pInfo; 208 | rego.ActivatorDelegate := delegate; 209 | rego.ImplClass := AImplementation; 210 | rego.IsSingleton := newSingleton; 211 | FContainerInfo.Add(key,rego); 212 | end 213 | else 214 | begin 215 | rego := TIoCRegistration(o); 216 | //cannot replace a singleton that has already been instanciated. 217 | if rego.IsSingleton and (rego.Instance <> nil) then 218 | raise EIoCException.Create(Format('An implementation for type %s with name %s is already registered with IoC',[pInfo.Name, newName])); 219 | rego.IInterface := pInfo; 220 | rego.ActivatorDelegate := delegate; 221 | rego.ImplClass := AImplementation; 222 | rego.IsSingleton := newSingleton; 223 | FContainerInfo.AddOrSetValue(key,rego); 224 | end; 225 | end; 226 | 227 | 228 | class destructor TSimpleIoC.ClassDestroy; 229 | begin 230 | if FDefault <> nil then 231 | FDefault.Free; 232 | end; 233 | 234 | procedure TSimpleIoC.Clear; 235 | begin 236 | FContainerInfo.Clear; 237 | end; 238 | 239 | constructor TSimpleIoC.Create; 240 | begin 241 | FContainerInfo := TDictionary.Create; 242 | FRaiseIfNotFound := false; 243 | end; 244 | 245 | class function TSimpleIoC.DefaultContainer: TSimpleIoC; 246 | begin 247 | if FDefault = nil then 248 | FDefault := TSimpleIoC.Create; 249 | 250 | result := FDefault; 251 | end; 252 | 253 | destructor TSimpleIoC.Destroy; 254 | var 255 | o : TObject; 256 | begin 257 | if FContainerInfo <> nil then 258 | begin 259 | for o in FContainerInfo.Values do 260 | if o <> nil then 261 | o.Free; 262 | 263 | FContainerInfo.Free; 264 | end; 265 | inherited; 266 | end; 267 | 268 | 269 | function TSimpleIoC.GetInterfaceKey(const AName: string): string; 270 | var 271 | pInfo : PTypeInfo; 272 | begin 273 | //By default the key is the interface name unless otherwise found. 274 | pInfo := TypeInfo(TInterface); 275 | {$IFDEF NEXTGEN} 276 | result := pInfo.Name.ToString; 277 | {$ELSE} 278 | result := string(pInfo.Name); 279 | {$ENDIF} 280 | 281 | if (AName <> '') then 282 | result := result + '_' + AName; 283 | 284 | //All keys are stored in lower case form. 285 | result := LowerCase(result); 286 | end; 287 | 288 | function TSimpleIoC.InternalResolve(out AInterface: TInterface; const AName: string): TResolveResult; 289 | var 290 | key : string; 291 | errorMsg : string; 292 | container : TDictionary; 293 | registrationObj : TObject; 294 | registration : TIoCRegistration; 295 | resolvedInf : IInterface; 296 | resolvedObj : TInterface; 297 | bIsSingleton: Boolean; 298 | bInstanciate: Boolean; 299 | begin 300 | AInterface := Default(TInterface); 301 | Result := TResolveResult.Unknown; 302 | 303 | //Get the key for the interace we are resolving and locate the container for that key. 304 | key := GetInterfaceKey(AName); 305 | container := FContainerInfo; 306 | 307 | if not container.TryGetValue(key, registrationObj) then 308 | begin 309 | result := TResolveResult.InterfaceNotRegistered; 310 | Exit; 311 | end; 312 | 313 | //Get the interface registration class correctly. 314 | registration := TIoCRegistration(registrationObj); 315 | bIsSingleton := registration.IsSingleton; 316 | 317 | bInstanciate := true; 318 | 319 | if bIsSingleton then 320 | begin 321 | //If a singleton was registered with this interface then check if it's already been instanciated. 322 | if registration.Instance <> nil then 323 | begin 324 | //Get AInterface as TInterface 325 | if registration.Instance.QueryInterface(GetTypeData(TypeInfo(TInterface)).Guid, AInterface) <> 0 then 326 | begin 327 | result := TResolveResult.ImplNotRegistered; 328 | Exit; 329 | end; 330 | 331 | bInstanciate := False; 332 | end; 333 | end; 334 | 335 | if bInstanciate then 336 | begin 337 | //If the instance hasn't been instanciated then we need to lock and instanciate 338 | MonitorEnter(container); 339 | try 340 | //If we have a implementing class then used this to activate. 341 | if registration.ImplClass <> nil then 342 | resolvedInf := TClassActivator.CreateInstance(registration.ImplClass) 343 | //Otherwise if there is a activate delegate use this to activate. 344 | else if registration.ActivatorDelegate <> nil then 345 | begin 346 | resolvedInf := registration.ActivatorDelegate(); 347 | 348 | if resolvedInf = nil then 349 | begin 350 | result := TResolveResult.DeletegateFailedCreate; 351 | Exit; 352 | end; 353 | end; 354 | 355 | //Get AInterface as TInterface 356 | if resolvedInf.QueryInterface(GetTypeData(TypeInfo(TInterface)).Guid, resolvedObj) <> 0 then 357 | begin 358 | result := TResolveResult.ImplNotRegistered; 359 | Exit; 360 | end; 361 | 362 | AInterface := resolvedObj; 363 | 364 | if bIsSingleton then 365 | begin 366 | registration.Instance := resolvedObj; 367 | 368 | //Reset the registration to show the instance which was created. 369 | container.AddOrSetValue(key, registration); 370 | end; 371 | finally 372 | MonitorExit(container); 373 | end; 374 | end; 375 | end; 376 | 377 | procedure TSimpleIoC.RegisterSingleton(const instance: TInterface; const name: string); 378 | var 379 | key : string; 380 | pInfo : PTypeInfo; 381 | rego : TIoCRegistration; 382 | o : TObject; 383 | begin 384 | pInfo := TypeInfo(TInterface); 385 | key := GetInterfaceKey(name); 386 | 387 | if not FContainerInfo.TryGetValue(key,o) then 388 | begin 389 | rego := TIoCRegistration.Create; 390 | rego.IInterface := pInfo; 391 | rego.ActivatorDelegate := nil; 392 | rego.ImplClass := nil; 393 | rego.IsSingleton := true; 394 | rego.Instance := instance; 395 | FContainerInfo.Add(key,rego); 396 | end 397 | else 398 | raise EIoCException.Create(Format('An implementation for type %s with name %s is already registered with IoC',[pInfo.Name, name])); 399 | end; 400 | 401 | procedure TSimpleIoC.RegisterType(const singleton: boolean; const delegate: TActivatorDelegate; const name: string); 402 | begin 403 | InternalRegisterType(singleton,nil,delegate,name); 404 | end; 405 | 406 | function TSimpleIoC.Resolve(const name: string = ''): TInterface; 407 | var 408 | resolveResult: TResolveResult; 409 | errorMsg : string; 410 | pInfo : PTypeInfo; 411 | begin 412 | pInfo := TypeInfo(TInterface); 413 | resolveResult := InternalResolve(result, name); 414 | 415 | //If we don't have a resolution and the caller wants an exception then throw one. 416 | if (result = nil) and (FRaiseIfNotFound) then 417 | begin 418 | case resolveResult of 419 | TResolveResult.Success : ; 420 | TResolveResult.InterfaceNotRegistered : errorMsg := Format('No implementation registered for type %s', [pInfo.Name]); 421 | TResolveResult.ImplNotRegistered : errorMsg := Format('The Implementation registered for type %s does not actually implement %s', [pInfo.Name, pInfo.Name]); 422 | TResolveResult.DeletegateFailedCreate : errorMsg := Format('The Implementation registered for type %s does not actually implement %s', [pInfo.Name, pInfo.Name]); 423 | else 424 | //All other error types are treated as unknown until defined here. 425 | errorMsg := Format('An Unknown Error has occurred for the resolution of the interface %s %s. This is either because a new error type isn''t being handled, ' + 426 | 'or it''s an bug.', [pInfo.Name, name]); 427 | end; 428 | 429 | raise EIoCResolutionException.Create(errorMsg); 430 | end; 431 | end; 432 | 433 | end. 434 | -------------------------------------------------------------------------------- /SimpleIoCTests.dpr: -------------------------------------------------------------------------------- 1 | program SimpleIoCTests; 2 | 3 | {.$APPTYPE CONSOLE} 4 | 5 | uses 6 | Forms, 7 | TestFramework, 8 | GUITestRunner, 9 | TextTestRunner, 10 | SysUtils, 11 | SimpleIoC in 'SimpleIoC.pas', 12 | IoCTests in 'Tests\IoCTests.pas'; 13 | 14 | begin 15 | Application.Initialize; 16 | if IsConsole then 17 | begin 18 | with TextTestRunner.RunRegisteredTests do 19 | Free; 20 | end 21 | else 22 | GUITestRunner.RunRegisteredTests; 23 | end. 24 | 25 | -------------------------------------------------------------------------------- /SimpleIoCTests.dproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {0A1122E1-CF53-4E5E-A1D6-7117B7026DAE} 4 | SimpleIoCTests.dpr 5 | Debug 6 | DCC32 7 | 13.4 8 | VCL 9 | True 10 | Win32 11 | 1 12 | Application 13 | 14 | 15 | true 16 | 17 | 18 | true 19 | Base 20 | true 21 | 22 | 23 | true 24 | Base 25 | true 26 | 27 | 28 | true 29 | Base 30 | true 31 | 32 | 33 | Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;DUnitX;$(DCC_Namespace) 34 | 3081 35 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 36 | SimpleIoCTests.exe 37 | 00400000 38 | x86 39 | 40 | 41 | 1033 42 | true 43 | $(BDS)\bin\default_app.manifest 44 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 45 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 46 | 47 | 48 | false 49 | RELEASE;$(DCC_Define) 50 | 0 51 | false 52 | 53 | 54 | DEBUG;$(DCC_Define) 55 | 56 | 57 | 58 | MainSource 59 | 60 | 61 | 62 | 63 | Cfg_2 64 | Base 65 | 66 | 67 | Base 68 | 69 | 70 | Cfg_1 71 | Base 72 | 73 | 74 | 75 | 76 | Delphi.Personality.12 77 | VCLApplication 78 | 79 | 80 | 81 | SimpleIoCTests.dpr 82 | 83 | 84 | False 85 | True 86 | False 87 | 88 | 89 | False 90 | False 91 | 1 92 | 0 93 | 0 94 | 0 95 | False 96 | False 97 | False 98 | False 99 | False 100 | 3081 101 | 1252 102 | 103 | 104 | 105 | 106 | 1.0.0.0 107 | 108 | 109 | 110 | 111 | 112 | 1.0.0.0 113 | 114 | 115 | 116 | 117 | False 118 | True 119 | 120 | 121 | 12 122 | 123 | 124 | 125 | 126 | 130 | -------------------------------------------------------------------------------- /Tests/IoCTests.pas: -------------------------------------------------------------------------------- 1 | unit IoCTests; 2 | 3 | interface 4 | 5 | uses 6 | TestFramework; 7 | type 8 | ITest1 = interface 9 | ['{5623E79D-7AE3-48A6-9B8E-2CB48F3D50AA}'] 10 | 11 | end; 12 | 13 | ITest2 = interface 14 | ['{5623E79D-7AE3-48A6-9B8E-2CB48F3D50AA}'] 15 | end; 16 | 17 | 18 | TSimpleIoCTests = class(TTestCase) 19 | published 20 | procedure TestDefault; 21 | procedure TestSingleton; 22 | procedure TestNamedSingletons; 23 | procedure TestSingletonInstance; 24 | procedure TestNotResolve; 25 | 26 | end; 27 | 28 | implementation 29 | 30 | uses 31 | SimpleIoC; 32 | 33 | type 34 | TTest1 = class(TInterfacedObject,ITest1) 35 | end; 36 | 37 | TTest11 = class(TInterfacedObject,ITest1) 38 | end; 39 | 40 | 41 | TTest2 = class(TInterfacedObject,ITest1) 42 | end; 43 | 44 | 45 | { TSimpleIoCTests } 46 | 47 | //Test if the Default container is created. 48 | procedure TSimpleIoCTests.TestDefault; 49 | var 50 | t1 : ITest1; 51 | t2 : ITest1; 52 | begin 53 | TSimpleIoC.DefaultContainer.Clear; //so we can run tests multiple times when debugging. 54 | TSimpleIoC.DefaultContainer.RegisterType; 55 | 56 | t1 := TSimpleIoC.DefaultContainer.Resolve; 57 | t2 := TSimpleIoC.DefaultContainer.Resolve; 58 | Check(t1 <> nil); 59 | Check(t2 <> nil); 60 | Check(t1 <> t2); 61 | 62 | end; 63 | 64 | 65 | procedure TSimpleIoCTests.TestNamedSingletons; 66 | var 67 | t1 : ITest1; 68 | t2 : ITest1; 69 | t3 : ITest2; 70 | c : TSimpleIoC; 71 | begin 72 | c := TSimpleIoC.Create; 73 | try 74 | c.RegisterType(true,'One'); 75 | c.RegisterType(true,'OneOne'); 76 | //test that key = type + name 77 | c.RegisterType(true,'One'); 78 | 79 | //name is not case sensitive 80 | t1 := c.Resolve('one'); 81 | t2 := c.Resolve('oneone'); 82 | t3 := c.Resolve('ONE'); 83 | 84 | Check(t1 <> nil); 85 | Check(t2 <> nil); 86 | Check(t1 <> t2); 87 | Check(t3 <> nil); 88 | finally 89 | c.Free; 90 | end; 91 | end; 92 | 93 | procedure TSimpleIoCTests.TestNotResolve; 94 | var 95 | t1 : ITest1; 96 | c : TSimpleIoC; 97 | begin 98 | c := TSimpleIoC.Create; 99 | try 100 | c.RaiseIfNotFound := False; 101 | t1 := c.Resolve; 102 | Check(t1 = nil); 103 | finally 104 | c.Free; 105 | end; 106 | end; 107 | 108 | procedure TSimpleIoCTests.TestSingleton; 109 | var 110 | t1 : ITest1; 111 | t2 : ITest1; 112 | c : TSimpleIoC; 113 | begin 114 | c := TSimpleIoC.Create; 115 | try 116 | c.RegisterType(true); 117 | t1 := c.Resolve; 118 | t2 := c.Resolve; 119 | Check(t1 <> nil); 120 | Check(t2 <> nil); 121 | Check(t1 = t2); 122 | finally 123 | c.Free; 124 | end; 125 | 126 | end; 127 | 128 | procedure TSimpleIoCTests.TestSingletonInstance; 129 | var 130 | t1 : ITest1; 131 | t2 : ITest1; 132 | c : TSimpleIoC; 133 | begin 134 | c := TSimpleIoC.Create; 135 | try 136 | t1 := TTest1.Create; 137 | c.RegisterSingleton(t1); 138 | t2 := c.Resolve; 139 | Check(t2 <> nil); 140 | Check(t1 = t2); 141 | finally 142 | c.Free; 143 | end; 144 | end; 145 | 146 | initialization 147 | TestFramework.RegisterTest(TSimpleIoCTests.Suite); 148 | 149 | end. 150 | --------------------------------------------------------------------------------