Du verwendest einen veralteten Browser. Es ist möglich, dass diese oder andere Websites nicht korrekt angezeigt werden. Du solltest ein Upgrade durchführen oder einen alternativen Browser verwenden.
wir leben tatsächlich in einer Gesellschaft
wo Menschen
in einem interaktiven Forum
über mehr oder weniger sinnlose esoterische Belange
einen Spamthread öffnen
um völlig sinnlos zu sein
{$mode objfpc}{$H+}
unit unames;
interface
uses Classes,basics,sysutils;
type tnames=class;
tname=class
procedure dec;
procedure inc;
private
next,last : tname;
iid : integer;
refcount : integer;
istr : string;
public
property id : integer read iid;
property str : string read istr;
end;
tnames=class
constructor create;
destructor destroy;override;
function add(name:string):tname;
function get(name:string):tname;
function get(id:integer):tname;
function add(id:integer):tname;
procedure clear;
procedure tidyup;
procedure giveids;
procedure negids;
function count:integer;
procedure savetostream(stream:testream);
procedure loadfromstream(stream:testream);
procedure writedebuginfo;
private
lock : tlock;
names : tname;
end;
implementation
procedure tnames.writedebuginfo;
var p:tname;
begin
writeln('names:');
p:=names;
while p<>nil do
begin
writeln(p.str,'<->',p.id,'(',p.refcount,')');
p:=p.next;
end;
writeln('names/');
end;
function tnames.add(id:integer):tname;
var p : tname;
begin
p := names;
while p<>nil do
begin
if p.iid=id then
begin
p.inc;
add:=p;
exit;
end;
p:=p.next;
end;
add:=nil;
end;
function tnames.get(id:integer):tname;
var p:tname;
begin
p:=names;
while p<>nil do
begin
if p.iid=id then
begin
get:=p;
exit;
end;
p:=p.next;
end;
get:=nil;
end;
procedure tnames.negids;
var p:tname;
begin
p:=names;
while p<>nil do
begin
p.iid:=-1;
p:=p.next;
end;
end;
function tnames.count:integer;
var p:tname;
begin
p:=names;
count:=0;
while p<>nil do
begin
inc(count);
p:=p.next;
end;
end;
{$NOTES OFF}
procedure tnames.loadfromstream(stream:testream);
var cnt,id:integer;
p:tname;
str:string;
begin
negids;
cnt:=stream.readint;
writeln(cnt);
id:=0;
while cnt<>0 do
begin
str:=stream.readstr;
p:=add(str);
p.iid:=id;
dec(cnt);
inc(id);
end;
end;
{$NOTES ON}
procedure tnames.savetostream(stream:testream);
var p:tname;
begin
tidyup;
giveids;
stream.writeint(count);
p:=names;
while p<>nil do
begin
stream.writestr(p.istr);
p:=p.next;
end;
end;
procedure tnames.giveids;
var p : tname;
id : integer;
begin
p:=names;
id:=0;
while p<>nil do
begin
p.iid:=id;
p:=p.next;
inc(id);
end;
end;
procedure tnames.tidyup;
var p,p2:tname;
begin
p:=names;
while p<>nil do
begin
p2:=p.next;
if p.refcount=0 then
begin
if p=names then names:=p2;
p.free;
end;
p:=p2;
end;
end;
procedure tname.inc;
begin
interlockedincrement(refcount);
end;
procedure tname.dec;
begin
interlockedincrement(refcount);
end;
function tnames.add(name:string):tname;
var p:tname;
begin
lock.acquire;
p:=names;
while p<>nil do
begin
if p.istr=name then
begin
add:=p;
inc(p.refcount);
lock.release;
exit;
end;
p:=p.next;
end;
p:=tname.create;
p.last:=nil;
p.istr:=name;
p.refcount:=1;
p.next:=names;
if names<>nil then names.last:=p;
names:=p;
lock.release;
add:=p;
end;
function tnames.get(name:string):tname;
var p:tname;
begin
lock.acquire;
p:=names;
while p<>nil do
begin
if p.istr=name then
begin
get:=p;
lock.release;
exit;
end;
p:=p.next;
end;
p:=tname.create;
p.last:=nil;
p.istr:=name;
p.refcount:=0;
p.next:=names;
if names<>nil then names.last:=p;
names:=p;
lock.release;
get:=p;
end;
constructor tnames.create;
begin
inherited create;
names:=nil;
lock:=tlock.create;
end;
{ Not thread safe ! }
procedure tnames.clear;
var p,p2:tname;
begin
p:=names;
while p<>nil do
begin
p2:=p.next;
p.free;
p:=p2;
end;
names:=nil;
end;
destructor tnames.destroy;
begin
clear;
lock.destroy;
inherited destroy;
end;
end.
zalika sieh es als eine form der kreativität und die geht nun mal gern mit soiritualismus hand in hans
grüßli
silvia
p.s.:
unction tnames.get(name:string):tname;
var p:tname;
begin
lock.acquire;
p:=names;
while p<>nil do
begin
if p.istr=name then
begin
get:=p;
lock.release;
exit;
end;
p:=p.next;
end;
p:=tname.create;
p.last:=nil;
p.istr:=name;
p.refcount:=0;
p.next:=names;
if names<>nil then names.last:=p;
names:=p;
lock.release;
get:=p;
end.
ich kenne spamthreads mehr so als thread, der so ähnlich wie ein chat funktioniert... quasi das, was wir hier im forum bei den murmelianern haben... deswegen find ich das hier total sinnlos... in einer art chatthread lernt man sich ja irgendwo noch besser kennen... aber hier??
wir leben tatsächlich in einer Gesellschaft
wo Menschen
in einem interaktiven Forum
über mehr oder weniger sinnlose esoterische Belange
einen Spamthread öffnen
um völlig sinnlos zu sein
Diese Seite verwendet Cookies, um Inhalte zu personalisieren und dich nach der Registrierung angemeldet zu halten. Durch die Nutzung unserer Webseite erklärst du dich damit einverstanden.