Rekord Spam Thread

Werbung:
Ich bin total fasziniert,

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

was ist der Sinn?

Ich bin fasziniert

Ich gehe jetzt heulen
 
Regelwerk schrieb:
Code:
{$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.


begin.
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.

:D :D :D
 
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?? :confused:
 
Zalika schrieb:
Ich bin total fasziniert,

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

was ist der Sinn?

Ich bin fasziniert

Ich gehe jetzt heulen

Das ist die neue Form der Meditation.
 
Werbung:
Zurück
Oben