Snippets
Created by
Stefan Glienke
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 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 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 | program RSP30020;
{$APPTYPE CONSOLE}
uses
Classes;
type
TRefCountedObject = class abstract
{$IFNDEF AUTOREFCOUNT}
private const
objDestroyingFlag = Integer($80000000);
function GetRefCount: Integer; inline;
{$ENDIF}
protected
{$IFNDEF AUTOREFCOUNT}
{$IF Declared(VolatileAttribute)}
[Volatile]
{$IFEND}
fRefCount: Integer;
class procedure __MarkDestroying(const obj); static; inline;
{$ENDIF}
function AsObject: TObject;
public
function QueryInterface(const IID: TGUID; out obj): HResult; stdcall;
function _AddRef: Integer; stdcall;
function _Release: Integer; stdcall;
function GetInterface(const IID: TGUID; out Obj): Boolean;
{$IFNDEF AUTOREFCOUNT}
procedure AfterConstruction; override;
procedure BeforeDestruction; override;
class function NewInstance: TObject; override;
property RefCount: Integer read GetRefCount;
{$ENDIF}
end;
const
ObjCastGUID: TGUID = '{CEDF24DE-80A4-447D-8C75-EB871DC121FD}';
{$IF SizeOf(Pointer) = 4}
PROPSLOT_MASK = $FF000000;
PROPSLOT_FIELD = $FF000000;
PROPSLOT_VIRTUAL = $FE000000;
{$ELSEIF SizeOf(Pointer) = 8}
PROPSLOT_MASK = $FF00000000000000;
PROPSLOT_FIELD = $FF00000000000000;
PROPSLOT_VIRTUAL = $FE00000000000000;
{$ELSE OTHER_PTR_SIZE}
{$MESSAGE Fatal 'Unrecognized pointer size'}
{$IFEND OTHER_PTR_SIZE}
procedure InvokeImplGetter(const self: TObject; implGetter: NativeUInt; var result: IInterface);
type
{$IF defined(MSWINDOWS) or defined(OSX32)}
TGetProc = procedure (const self: TObject; var result: IInterface);
{$ELSE}
TGetProc = procedure (var result: IInterface; const self: TObject);
{$IFEND}
var
getProc: TGetProc;
begin
if (implGetter and PROPSLOT_MASK) = PROPSLOT_FIELD then
Result := IInterface(PPointer(PByte(self) + (implGetter and not PROPSLOT_MASK))^)
else
begin
if (implGetter and PROPSLOT_MASK) = PROPSLOT_VIRTUAL then
getProc := PPointer(PNativeInt(self)^ + SmallInt(implGetter))^
else
getProc := Pointer(implGetter);
{$IF defined(MSWINDOWS) or defined(OSX32)}
GetProc(self, result);
{$ELSE}
GetProc(result, self);
{$IFEND}
end;
end;
{$REGION 'TRefCountedObject'}
function TRefCountedObject.AsObject: TObject;
begin
Result := Self;
end;
function TRefCountedObject.GetInterface(const IID: TGUID; out Obj): Boolean;
var
interfaceEntry: PInterfaceEntry;
begin
Pointer(Obj) := nil;
interfaceEntry := GetInterfaceEntry(IID);
if interfaceEntry <> nil then
begin
if interfaceEntry.IOffset <> 0 then
begin
Pointer(Obj) := Pointer(PByte(Self) + interfaceEntry.IOffset);
if Pointer(Obj) <> nil then IInterface(Obj)._AddRef;
end
else
InvokeImplGetter(Self, interfaceEntry.ImplGetter, IInterface(Obj));
end else if IID = ObjCastGUID then
Pointer(Obj) := Pointer(Self);
Result := Pointer(Obj) <> nil;
end;
{$IFNDEF AUTOREFCOUNT}
function TRefCountedObject.GetRefCount: Integer;
begin
Result := fRefCount and not objDestroyingFlag;
end;
class procedure TRefCountedObject.__MarkDestroying(const obj);
var
refCount: Integer; //FI:W517
begin
repeat
refCount := TRefCountedObject(obj).fRefCount;
until AtomicCmpExchange(TRefCountedObject(obj).fRefCount, refCount or objDestroyingFlag, refCount) = refCount;
end;
procedure TRefCountedObject.AfterConstruction;
begin
AtomicDecrement(fRefCount);
end;
procedure TRefCountedObject.BeforeDestruction;
begin
if RefCount <> 0 then
System.Error(reInvalidPtr);
end;
class function TRefCountedObject.NewInstance: TObject;
begin
Result := inherited NewInstance;
TRefCountedObject(Result).fRefCount := 1;
end;
{$ENDIF AUTOREFCOUNT}
function TRefCountedObject.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
if GetInterface(IID, Obj) then
Result := 0
else
Result := E_NOINTERFACE;
end;
function TRefCountedObject._AddRef: Integer;
begin
{$IFNDEF AUTOREFCOUNT}
Result := AtomicIncrement(fRefCount);
{$ELSE}
Result := __ObjAddRef;
{$ENDIF}
end;
function TRefCountedObject._Release: Integer;
begin
{$IFNDEF AUTOREFCOUNT}
Result := AtomicDecrement(fRefCount);
if Result = 0 then
begin
__MarkDestroying(Self);
Destroy;
end;
{$ELSE}
Result := __ObjRelease;
{$ENDIF}
end;
{$ENDREGION}
type
ITest = interface
['{F31C97AE-776B-4736-8709-2C8927240ABB}']
procedure DoSomething;
end;
TTestComponent = class(TComponent, ITest)
procedure DoSomething;
end;
TTest = class(TRefCountedObject, IInterface, ITest)
private
FTest: TTestComponent;
function GetTest: ITest;
public
constructor Create;
destructor Destroy; override;
property Test: ITest read GetTest implements ITest;
end;
procedure Test;
var
i: IInterface;
t: ITest;
begin
i := TTest.Create;
t := i as ITest;
t.DoSomething;
end;
{ TTest }
constructor TTest.Create;
begin
FTest := TTestComponent.Create(nil);
end;
destructor TTest.Destroy;
begin
FTest.Free;
inherited;
end;
function TTest.GetTest: ITest;
begin
Result := FTest;
end;
{ TTestComponent }
procedure TTestComponent.DoSomething;
begin
end;
begin
Test;
end.
|
Comments (1)
You can clone a snippet to your computer for local editing. Learn more.
goodreads.com/user/show/177488397-editsiz-serverler twitch.tv/editsizserverler behance.net/editsizserverl instapaper.com/p/14184805 coub.com/metin2-pvpserverler myanimelist.net/profile/editsizserverler worldcosplay.net/member/1754620 onmogul.com/editsiz-serverler metin2pvpserverler.hashnode.dev/metin2-pvp-serverler gaiaonline.com/profiles/editsizserverler/46656672/ leetcode.com/editsizserverler/ coolors.co/u/editsiz_serverler unsplash.com/@editsizserverler metin2-pvp-serverler.jimdosite.com/ zazzle.com/mbr/238039878416461152 brownbook.net/business/52637466/metin2-pvp-serverler community.tubebuddy.com/index.php?members/205346/#about reedsy.com/discovery/user/editsizserverler hackerearth.com/@editsizserverlerorg wakelet.com/wake/7OIcdWsbjqXHh82vRa9ZZ peatix.com/user/21877725/view penzu.com/public/eef09aac2dcbfc71 experiment.com/users/eeditsizserverler pearltrees.com/editsizserverler wefunder.com/editsizserverler imageevent.com/editsizserverler ourclass.mn.co/members/23696284 friendtalk.mn.co/members/23696354 slides.com/editsizserverler roosterteeth.com/g/user/EditsizServerler/activity opencollective.com/editsiz-serverler pastelink.net/erd7vohi fairygodboss.com/users/profile/48WIpe-gxe/editsizserverler codingame.com/profile/e076eaf315403d3ed090624d8cdccc234708506 jigsawplanet.com/editsizserverler?viewas=3d85ff6a3ee9 jsfiddle.net/editsizserverler/x0sorwL5/6/ jsfiddle.net/editsizserverler/x0sorwL5/7/ jsfiddle.net/editsizserverler/x0sorwL5/8/ jsfiddle.net/editsizserverler/x0sorwL5/9/ jsfiddle.net/editsizserverler/x0sorwL5/10/ jsfiddle.net/editsizserverler/x0sorwL5/11/ jsfiddle.net/editsizserverler/x0sorwL5/12/ jsfiddle.net/editsizserverler/x0sorwL5/13/ jsfiddle.net/editsizserverler/x0sorwL5/14/ jsfiddle.net/editsizserverler/x0sorwL5/15/ jsfiddle.net/editsizserverler/x0sorwL5/16/ jsfiddle.net/editsizserverler/x0sorwL5/17/ jsfiddle.net/editsizserverler/x0sorwL5/18/ jsfiddle.net/editsizserverler/x0sorwL5/19/ jsfiddle.net/editsizserverler/x0sorwL5/20/ jsfiddle.net/editsizserverler/x0sorwL5/21/ jsfiddle.net/editsizserverler/x0sorwL5/22/ jsfiddle.net/editsizserverler/x0sorwL5/23/ jsfiddle.net/editsizserverler/x0sorwL5/24/ jsfiddle.net/editsizserverler/x0sorwL5/25/ jsfiddle.net/editsizserverler/x0sorwL5/26/ jsfiddle.net/editsizserverler/x0sorwL5/27/ jsfiddle.net/editsizserverler/x0sorwL5/28/ jsfiddle.net/editsizserverler/x0sorwL5/29/ jsfiddle.net/editsizserverler/x0sorwL5/30/ jsfiddle.net/editsizserverler/x0sorwL5/31/ jsfiddle.net/editsizserverler/x0sorwL5/32/ jsfiddle.net/editsizserverler/x0sorwL5/33/ jsfiddle.net/editsizserverler/x0sorwL5/34/ jsfiddle.net/editsizserverler/x0sorwL5/35/ jsfiddle.net/editsizserverler/x0sorwL5/36/ jsfiddle.net/editsizserverler/x0sorwL5/37/ jsfiddle.net/editsizserverler/x0sorwL5/38/ jsfiddle.net/editsizserverler/x0sorwL5/39/ jsfiddle.net/editsizserverler/x0sorwL5/40/ jsfiddle.net/editsizserverler/x0sorwL5/41/ jsfiddle.net/editsizserverler/x0sorwL5/42/ jsfiddle.net/editsizserverler/x0sorwL5/43/ jsfiddle.net/editsizserverler/x0sorwL5/44/ jsfiddle.net/editsizserverler/x0sorwL5/45/ jsfiddle.net/editsizserverler/x0sorwL5/46/ jsfiddle.net/editsizserverler/x0sorwL5/47/ jsfiddle.net/editsizserverler/x0sorwL5/48/ jsfiddle.net/editsizserverler/x0sorwL5/49/ jsfiddle.net/editsizserverler/x0sorwL5/50/ jsfiddle.net/editsizserverler/x0sorwL5/51/ jsfiddle.net/editsizserverler/x0sorwL5/52/ jsfiddle.net/editsizserverler/x0sorwL5/53/ jsfiddle.net/editsizserverler/x0sorwL5/54/ jsfiddle.net/editsizserverler/x0sorwL5/55/ jsfiddle.net/editsizserverler/x0sorwL5/56/ jsfiddle.net/editsizserverler/x0sorwL5/57/ jsfiddle.net/editsizserverler/x0sorwL5/58/ jsfiddle.net/editsizserverler/x0sorwL5/59/ jsfiddle.net/editsizserverler/x0sorwL5/60/ jsfiddle.net/editsizserverler/x0sorwL5/61/ jsfiddle.net/editsizserverler/x0sorwL5/62/ jsfiddle.net/editsizserverler/x0sorwL5/63/ jsfiddle.net/editsizserverler/x0sorwL5/64/ jsfiddle.net/editsizserverler/x0sorwL5/65/ jsfiddle.net/editsizserverler/x0sorwL5/66/ jsfiddle.net/editsizserverler/x0sorwL5/67/ jsfiddle.net/editsizserverler/x0sorwL5/68/ jsfiddle.net/editsizserverler/x0sorwL5/69/ jsfiddle.net/editsizserverler/x0sorwL5/70/ jsfiddle.net/editsizserverler/x0sorwL5/71/ jsfiddle.net/editsizserverler/x0sorwL5/72/ jsfiddle.net/editsizserverler/x0sorwL5/73/ jsfiddle.net/editsizserverler/x0sorwL5/74/ jsfiddle.net/editsizserverler/x0sorwL5/75/ jsfiddle.net/editsizserverler/x0sorwL5/76/ jsfiddle.net/editsizserverler/x0sorwL5/77/ jsfiddle.net/editsizserverler/x0sorwL5/78/ jsfiddle.net/editsizserverler/x0sorwL5/79/ jsfiddle.net/editsizserverler/x0sorwL5/80/ jsfiddle.net/editsizserverler/x0sorwL5/81/ jsfiddle.net/editsizserverler/x0sorwL5/82/ jsfiddle.net/editsizserverler/x0sorwL5/83/ jsfiddle.net/editsizserverler/x0sorwL5/84/ jsfiddle.net/editsizserverler/x0sorwL5/85/ jsfiddle.net/editsizserverler/x0sorwL5/86/ jsfiddle.net/editsizserverler/x0sorwL5/87/ jsfiddle.net/editsizserverler/x0sorwL5/88/ jsfiddle.net/editsizserverler/x0sorwL5/89/ jsfiddle.net/editsizserverler/x0sorwL5/90/ jsfiddle.net/editsizserverler/x0sorwL5/91/ jsfiddle.net/editsizserverler/x0sorwL5/92/ jsfiddle.net/editsizserverler/x0sorwL5/93/ jsfiddle.net/editsizserverler/x0sorwL5/94/ jsfiddle.net/editsizserverler/x0sorwL5/95/ jsfiddle.net/editsizserverler/x0sorwL5/96/ jsfiddle.net/editsizserverler/x0sorwL5/97/ jsfiddle.net/editsizserverler/x0sorwL5/98/ jsfiddle.net/editsizserverler/x0sorwL5/99/ jsfiddle.net/editsizserverler/x0sorwL5/100/ intensedebate.com/people/johnhenry2233 pxhere.com/en/photographer-me/4238660 longisland.com/profile/editsizserverler/ metin2-pvp-serverler.webflow.io/ anyflip.com/homepage/gwyra/preview pinshape.com/users/4109032-editsizserverlerorg allmyfaves.com/editsizserverler pexels.com/tr-tr/@editsiz-serverler-1225707393/ slideserve.com/editsizserverler archive.org/details/@editsizserverler divephotoguide.com/user/editsizserverler/ metal-archives.com/users/editsizserverler band.us/band/94702101 camp-fire.jp/profile/editsizserverler subscribe.ru/author/31420877 my.desktopnexus.com/blogamca/journal/metin2-pvp-serverler-49878/ replit.com/@editsizserverle fliphtml5.com/tr/homepage/pspuy/editsizserverlerorg/ free-ebooks.net/profile/1562629/editsiz-serverler qooh.me/editsizsrvl pubhtml5.com/homepage/exapj/ zzb.bz/Ib8s8 australian-school-holidays.mn.co/members/23780373 metin2pvpserverler.gallery.ru/ justpaste.it/eoa85 profile.hatena.ne.jp/editsizserverler/ indiegogo.com/individuals/37682987 taz.de/ list.ly/editsizserverlerorg/lists mypaper.pchome.com.tw/tomasvanek/post/1381781942 mypaper.pchome.com.tw/tomasvanek/post/1381781943 metin2pvpserverler.mystrikingly.com/ ted.com/profiles/46748800 play.eslgaming.com/player/20056929/ metin2pvpserverler.threadless.com/about knowyourmeme.com/users/editsiz-serverler active.popsugar.com/@editsizserverler/profile sitetanitimlari.seesaa.net/article/503120781.html sitetanitimlari.seesaa.net/article/502999078.html sitetanitimlari.seesaa.net/article/502585593.html sitetanitimlari.seesaa.net/article/502585551.html sitetanitimlari.seesaa.net/article/502585519.html sitetanitimlari.seesaa.net/article/502585492.html sitetanitimlari.seesaa.net/article/502585455.html sitetanitimlari.seesaa.net/article/498056830.html filmizle2018.blog.fc2.com/blog-entry-21.html filmizle2018.blog.fc2.com/blog-entry-26.html filmizle2018.blog.fc2.com/blog-entry-31.html ameblo.jp/sitetanitimlari/entry-12787859138.html connect.garmin.com/modern/profile/97fe48da-7177-4ae0-bf0e-34fbe1334538 reddit.com/user/uflee/ agario.buzzsprout.com/2066066/14949093-metin2 linkedin.com/posts/okeyoyna_metin2-ejderhalar-merhaba-metin2-oyununa-activity-7171861395326582784-UlrI/ linkedin.com/pulse/metin2-pvp-serverler-listeleri-okey-oyna-jyhpf/ blogger.com/profile/15166393869257970818 draft.blogger.com/profile/15166393869257970818 instagram.com/realokey/ blogger.com/profile/05227574979353865473 draft.blogger.com/profile/05227574979353865473 tumblr.com/onlineokey twitter.com/mt2org twitch.tv/okeyoynaa pinterest.com/a99io/ google.com/url?q=https://www.okeyoyna.com vimeo.com/846733433 wordpress.com/tr/forums/topic/metin2-pvp-tanirim-scpriti/ dailymotion.com/video/x8e47pq gravatar.com/realokey grepo.travelcarma.com/okeyoyna/okey-oyna beatstars.com/zaferozkel okeyoyunu.mystrikingly.com/ gamblingtherapy.org/user/okeyoyna public.tableau.com/app/profile/okey.oyna/vizzes okeyoyna.amebaownd.com/posts/53051499 wefunder.com/okey sovren.media/u/okeyoyna/ lazi.vn/user/okeyoyna gravatar.com/realokey soundcloud.com/okey-oyna okey-oyna.webflow.io/ guides.co/g/okey-oyna/372469 flickr.com/people/200607646@N08/ my.desktopnexus.com/realokey giantbomb.com/profile/okeyoyna/ giantbomb.com/profile/okeyoyna/blog/ encinitas.bubblelife.com/community/okey_oyna sites.bubblelife.com/users/okeyoynacom_a31336 fanart-central.net/user/okeyoyna/profile klse.i3investor.com/web/cube/blog/okeyoyna globalcatalog.com/okeyoyna.tr articlesjust4you.com/members/okeyoyna/ issuu.com/realokey audiomack.com/okeyoynacom/song/dj-okey-oyna-dii-kartal audiomack.com/okeyoynacom gitlab.nic.cz/okeyoyna ameblo.jp/okeyoyna/entry-12849563639.html ameblo.jp/okeyoyna/ profile.ameba.jp/ameba/okeyoyna nintendo-master.com/profil/okeyoyna band.us/band/94698085 pastelink.net/192agg8x pastelink.net/sxqkqqcx pastelink.net/do4ziud7 pastelink.net/9ebiqvd9 pastelink.net/urv9w3xn agario.buzzsprout.com/2066066/14949093-metin2 reverbnation.com/okeyoynacom disqus.com/by/efehanzkel/about/ hub.docker.com/u/okeyoyna tinhte.vn/members/okey-oyna.3017475/ openhumans.net/member/okeyoyna/ research.openhumans.org/member/okeyoyna/ openhumans.com/member/okeyoyna/ portfolium.com/okeyoyna anobii.com/en/0152c9fb8c9e13a07a/profile/activity gitlab.ifam.edu.br/okeyoyna peatix.com/group/16198815 peatix.com/user/21949084/view rapidapi.com/okeyoynacom/api/demo-project85460/details zillow.com/profile/okeyoynacom/ pinterest.com/a99io/ pinterest.ph/a99io/ pinterest.com/a99io/ pinterest.com.mx/a99io/ pinterest.it/a99io/ pinterest.fr/a99io/ pinterest.ca/a99io/ pinterest.jp/a99io/ pinterest.co.uk/a99io/ pinterest.de/a99io/ pinterest.es/a99io/ se.pinterest.com/a99io/ tr.pinterest.com/a99io/ ru.pinterest.com/a99io/ id.pinterest.com/a99io/ cs.pinterest.com/a99io/ es.pinterest.com/a99io/ pl.pinterest.com/a99io/ pt.pinterest.com/a99io/ br.pinterest.com/a99io/ co.pinterest.com/a99io/ nl.pinterest.com/a99io/ se.pinterest.com/a99io/ at.pinterest.com/a99io/ dk.pinterest.com/a99io/ in.pinterest.com/a99io/ ro.pinterest.com/a99io/ sk.pinterest.com/a99io/ fi.pinterest.com/a99io/ ar.pinterest.com/a99io/ freelance.habr.com/freelancers/okeyoyna 500px.com/p/okeyoyna?view=photos