00001 {*********************************************************}
00002 { }
00003 { Zeos Database Objects }
00004 { Core classes and interfaces }
00005 { }
00006 { Originally written by Sergey Seroukhov }
00007 { }
00008 {*********************************************************}
00009
00010 {@********************************************************}
00011 { Copyright (c) 1999-2006 Zeos Development Group }
00012 { }
00013 { License Agreement: }
00014 { }
00015 { This library is distributed in the hope that it will be }
00016 { useful, but WITHOUT ANY WARRANTY; without even the }
00017 { implied warranty of MERCHANTABILITY or FITNESS FOR }
00018 { A PARTICULAR PURPOSE. See the GNU Lesser General }
00019 { Public License for more details. }
00020 { }
00021 { The source code of the ZEOS Libraries and packages are }
00022 { distributed under the Library GNU General Public }
00023 { License (see the file COPYING / COPYING.ZEOS) }
00024 { with the following modification: }
00025 { As a special exception, the copyright holders of this }
00026 { library give you permission to link this library with }
00027 { independent modules to produce an executable, }
00028 { regardless of the license terms of these independent }
00029 { modules, and to copy and distribute the resulting }
00030 { executable under terms of your choice, provided that }
00031 { you also meet, for each linked independent module, }
00032 { the terms and conditions of the license of that module. }
00033 { An independent module is a module which is not derived }
00034 { from or based on this library. If you modify this }
00035 { library, you may extend this exception to your version }
00036 { of the library, but you are not obligated to do so. }
00037 { If you do not wish to do so, delete this exception }
00038 { statement from your version. }
00039 { }
00040 { }
00041 { The project web site is located on: }
00042 { http:
00043 { http:
00044 { svn:
00045 { }
00046 { http:
00047 { http:
00048 { }
00049 { }
00050 { }
00051 { Zeos Development Group. }
00052 {********************************************************@}
00053
00054 unit ZClasses;
00055
00056 interface
00057
00058 {$I ZCore.inc}
00059
00060 uses
00061 SysUtils, Classes;
00062
00063 const
00064 ZEOS_VERSION = '6.6.6-stable';
00065
00066 type
00067 { Lazarus/FreePascal Support }
00068 {$IFDEF FPC}
00069 PDateTime = ^TDateTime;
00070
00071 TAggregatedObject = class(TObject)
00072 private
00073 FController: Pointer;
00074 function GetController: IInterface;
00075 protected
00076 function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
00077 function _AddRef: Integer; stdcall;
00078 function _Release: Integer; stdcall;
00079 public
00080 constructor Create(const Controller: IInterface);
00081 property Controller: IInterface read GetController;
00082 end;
00083
00084 TContainedObject = class(TAggregatedObject, IInterface)
00085 protected
00086 function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
00087 end;
00088 {$ENDIF}
00089
00090 {** Replacement for generic interface type. }
00091 IZInterface = IUnknown;
00092
00093 {** Represents an interface for all abstract object. }
00094 IZObject = interface(IZInterface)
00095 ['{EF46E5F7-00CF-4DDA-BED0-057D6686AEE0}']
00096 function Equals(const Value: IZInterface): Boolean;
00097 function Hash: LongInt;
00098 function Clone: IZInterface;
00099 function ToString: string;
00100 function InstanceOf(const IId: TGUID): Boolean;
00101 end;
00102
00103 {** Represents a fake interface for coparable objects. }
00104 IZComparable = interface(IZObject)
00105 ['{04112081-F07B-4BBF-A757-817816EB67C1}']
00106 end;
00107
00108 {** Represents an interface to clone objects. }
00109 IZClonnable = interface(IZObject)
00110 ['{ECB7F3A4-7B2E-4130-BA66-54A2D43C0149}']
00111 end;
00112
00113 {** Represents a generic collection iterator interface. }
00114 IZIterator = interface(IZObject)
00115 ['{D964DDD0-2308-4D9B-BD36-5810632512F7}']
00116 function HasNext: Boolean;
00117 function Next: IZInterface;
00118 end;
00119
00120 {** Represents a collection of object interfaces. }
00121 IZCollection = interface(IZClonnable)
00122 ['{51417C87-F992-4CAD-BC53-CF3925DD6E4C}']
00123
00124 function Get(Index: Integer): IZInterface;
00125 procedure Put(Index: Integer; const Item: IZInterface);
00126 function IndexOf(const Item: IZInterface): Integer;
00127 function GetCount: Integer;
00128 function GetIterator: IZIterator;
00129
00130 function First: IZInterface;
00131 function Last: IZInterface;
00132
00133 function Add(const Item: IZInterface): Integer;
00134 procedure Insert(Index: Integer; const Item: IZInterface);
00135 function Remove(const Item: IZInterface): Integer;
00136
00137 procedure Exchange(Index1, Index2: Integer);
00138 procedure Delete(Index: Integer);
00139 procedure Clear;
00140
00141 function Contains(const Item: IZInterface): Boolean;
00142 function ContainsAll(const Col: IZCollection): Boolean;
00143 function AddAll(const Col: IZCollection): Boolean;
00144 function RemoveAll(const Col: IZCollection): Boolean;
00145
00146 property Count: Integer read GetCount;
00147 property Items[Index: Integer]: IZInterface read Get write Put; default;
00148 end;
00149
00150 {** Represents a hash map interface. }
00151 IZHashMap = interface(IZClonnable)
00152 ['{782C64F4-AD09-4F56-AF2B-E4193A05BBCE}']
00153
00154 function Get(const Key: IZInterface): IZInterface;
00155 procedure Put(const Key: IZInterface; const Value: IZInterface);
00156 function GetKeys: IZCollection;
00157 function GetValues: IZCollection;
00158 function GetCount: Integer;
00159
00160 function Remove(Key: IZInterface): Boolean;
00161 procedure Clear;
00162
00163 property Count: Integer read GetCount;
00164 property Keys: IZCollection read GetKeys;
00165 property Values: IZCollection read GetValues;
00166 end;
00167
00168 {** Represents a stack interface. }
00169 IZStack = interface(IZClonnable)
00170 ['{8FEA0B3F-0C02-4E70-BD8D-FB0F42D4497B}']
00171
00172 function Peek: IZInterface;
00173 function Pop: IZInterface;
00174 procedure Push(Value: IZInterface);
00175 function GetCount: Integer;
00176
00177 property Count: Integer read GetCount;
00178 end;
00179
00180 {** Implements an abstract interfaced object. }
00181 TZAbstractObject = class(TInterfacedObject, IZObject)
00182 public
00183 function Equals(const Value: IZInterface): Boolean; virtual;
00184 function Hash: LongInt;
00185 function Clone: IZInterface; virtual;
00186 function ToString: string; virtual;
00187 function InstanceOf(const IId: TGUID): Boolean;
00188 end;
00189
00190 implementation
00191
00192 uses ZMessages, ZCompatibility;
00193
00194 {$IFDEF FPC}
00195
00196 { TAggregatedObject }
00197
00198 constructor TAggregatedObject.Create(const Controller: IInterface);
00199 begin
00200 FController := Pointer(Controller);
00201 end;
00202
00203 function TAggregatedObject.GetController: IInterface;
00204 begin
00205 Result := IInterface(FController);
00206 end;
00207
00208 function TAggregatedObject.QueryInterface(const IID: TGUID; out Obj): HResult;
00209 begin
00210 Result := IInterface(FController).QueryInterface(IID, Obj);
00211 end;
00212
00213 function TAggregatedObject._AddRef: Integer;
00214 begin
00215 Result := IInterface(FController)._AddRef;
00216 end;
00217
00218 function TAggregatedObject._Release: Integer; stdcall;
00219 begin
00220 Result := IInterface(FController)._Release;
00221 end;
00222
00223 { TContainedObject }
00224
00225 function TContainedObject.QueryInterface(const IID: TGUID; out Obj): HResult;
00226 begin
00227 if GetInterface(IID, Obj) then
00228 Result := S_OK
00229 else
00230 Result := E_NOINTERFACE;
00231 end;
00232
00233 {$ENDIF}
00234
00235 { TZAbstractObject }
00236
00237 {**
00238 Checks is the specified value equals to this object.
00239 @param Value an interface to some object.
00240 @return <code>True</code> if the objects are identical.
00241 }
00242 function TZAbstractObject.Equals(const Value: IZInterface): Boolean;
00243 begin
00244 if Value <> nil then
00245 begin
00246 Result := (IZInterface(Self) = Value)
00247 or ((Self as IZInterface) = (Value as IZInterface));
00248 end else
00249 Result := False;
00250 end;
00251
00252 {**
00253 Gets a unique hash for this object.
00254 @return a unique hash for this object.
00255 }
00256 function TZAbstractObject.Hash: LongInt;
00257 begin
00258 Result := LongInt(Self);
00259 end;
00260
00261 {**
00262 Clones an object instance.
00263 @return a clonned object instance.
00264 }
00265 function TZAbstractObject.Clone: IZInterface;
00266 begin
00267 raise Exception.Create(SClonningIsNotSupported);
00268 result := nil;
00269 end;
00270
00271 {**
00272 Checks is this object implements a specified interface.
00273 @param IId an interface id.
00274 @return <code>True</code> if this object support the interface.
00275 }
00276 function TZAbstractObject.InstanceOf(const IId: TGUID): Boolean;
00277 begin
00278 Result := GetInterfaceEntry(IId) <> nil;
00279 end;
00280
00281 {**
00282 Converts this object into the string representation.
00283 @return a string representation for this object.
00284 }
00285 function TZAbstractObject.ToString: string;
00286 begin
00287 Result := Format('%s <%p>', [ClassName, Pointer(Self)])
00288 end;
00289
00290 end.
00291