User blog:Rgetar/Program

I wrote program I was going to write. I tried to upload it to Googology Wiki, but I did not succeed, since exe is not permitted file type here. Then I tried to change its extension to jpg and upload, but it also did not work, and a message appeared: "Cannot upload this file because Internet Explorer would detect it as "application/x-msdownload", which is a disallowed and potentially dangerous file type". Then I googled "free file hosting", and first link was filedropper.com. I successfully uploaded the program there, here is the link:

http://www.filedropper.com/project2

Manual
1. Download the program Project2 (link above).

2. Run file Project2.exe.

3. Click Start button.

4. Open your web browser.

5. Type localhost.

6. Click ordinal to add its fundamental sequence to the list. Click reset to reset the list.

Source code
Current source code:

unit Ord;

interface

uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, StrUtils, Math, ScktComp;

type TForm1 = class(TForm) Button1: TButton; Label1: TLabel; ServerSocket1: TServerSocket; procedure Button1Click(Sender: TObject); procedure Serversocket1ClientRead(Sender: TObject; Socket: TCustomWinSocket); procedure Form1Destroy(Sender: TObject);

private { Private declarations } public { Public declarations } end;

var Form1: TForm1; st,st1,cin,cout,qm,qurl,qhost,qc: string; e,i,m,fsc,c1,li,lic: integer; b,mo,clested,h,ec,g,links:boolean; s: array of string; l,j: array of boolean; c: array of integer; k: array of byte; f: textfile; fss,si: byte; implementation

{$R *.dfm}

// get position of last symbol p of string st (if l=true then first) function getls(st,p:string;l:boolean=false):integer; var e,na,np: integer; begin if length(st)<2 then result:=ifthen(l,length(st)+1,0) else begin if l then e:=0 else e:=length(st)+1; if p='>' then na:=-1 else na:=0; np:=0; repeat if l then inc(e) else dec(e); if st[e]='<' then dec(na); if st[e]='>' then inc(na); if st[e]='(' then dec(np);     if st[e]=')' then inc(np); until (not l and (e=1)) or (l and (e=length(st))) or ((st[e]=p) and (na=0) and (np=0)); if not l and (e=1) then e:=0 else if l and (e=length(st)) then e:=length(st)+1; result:=e; end; end;

// get last element of set st with separator s function le(st:string;s:string='+'):string; begin result:=copy(st,getls(st,s)+1,length(st)); end;

// get first element of set st with separator s function fe(st:string;s:string='+'):string; begin result:=copy(st,1,getls(st,s,true)-1); end;

// get left rest of set st with separator s function lrest(st:string;s:string='+'):string; begin result:=copy(st,1,getls(st,s)-1); if result='' then result:='0'; end;

// get right rest of set st with separator s function rrest(st:string;s:string='+'):string; begin result:=copy(st,getls(st,s,true)+1,length(st)); if result='' then result:='0'; end;

// last term of Cantor normal form st set to beta function ltst(st,beta:string):string; begin if beta='0' then result:=lrest(st) else begin if lrest(st)='0' then result:='' else result:=lrest(st)+'+'; result:=result+beta; end; end;

// get successor of ordinal st function suc(st:string):string; begin if st='0' then result:='1' else result:=st+'+1'; end;

// get type of ordinal st (0 - limit, 1 - successor, 2 - limit) function getordtype(st:string):byte; begin if st='0' then result:=0 else if le(st)='1' then result:=1 else result:=2; end;

// get array of Veblen function st function getx(st:string):string; begin result:=copy(st,2,length(st)-2); end;

// get last base element of array x function lbeo(x:string):string; begin x:=le(x,','); result:=copy(x,getls(x,'>')+1,length(x)); end;

// get coordinates of last base element of array x function colbeo(x:string):string; begin x:=le(x,','); result:=copy(x,1,getls(x,'>')-1); if result='' then result:='0' else delete(result,1,1); end;

// get left rest of array x function lrt(x:string):string; begin result:=copy(x,1,getls(x,',')-1); if result='' then result:='0'; end;

// get first base element of array x function fbeo(x:string):string; begin x:=fe(x,','); result:=copy(x,getls(x,'>')+1,length(x)); end;

// get coordinates of first base element of array x function cofbeo(x:string):string; begin x:=fe(x,','); result:=copy(x,1,getls(x,'>')-1); if result='' then result:='0' else delete(result,1,1); end;

// get right rest of array x function rrt(x:string):string; begin result:=copy(x,getls(x,',',true)+1,length(x)); if result='' then result:='0'; end;

// get last element of array x function leo(x:string):string; begin if colbeo(x)='0' then result:=lbeo(x) else result:='0'; end;

// last base element of array x set to beta function lbest(x,beta:string):string; begin if beta='0' then result:=lrt(x) else begin if lrt(x)='0' then result:='' else result:=lrt(x)+','; if colbeo(x)<>'0' then result:=result+'<'+colbeo(x)+'>'; result:=result+beta; end; end;

// last element of array x set to beta function lest(x,beta:string):string; begin if colbeo(x)='0' then result:=lbest(x,beta) else if beta='0' then result:=x else result:=x+','+beta; end;

// last element of array x set to its successor function suca(x:string):string; begin result:=lest(x,suc(leo(x))); end;

// add element e with coordinates c to array x function addbe(x,c,e:string):string; begin if x='0' then x:='' else x:=x+','; if c<>'0' then x:=x+'<'+c+'>'; result:=x+e; end;

// get iterated last base element of array x function ilbeo(x:string; s:string=''):string; begin result:=s+lbeo(x); if colbeo(x)<>'0' then result:=ilbeo(colbeo(x),result+'|'); end;

// get iterated set of base elements of array x function isobe(x:string; s:string=''):string; begin result:=s; repeat if result<>'' then result:=result+'|'; result:=result+lbeo(x); if colbeo(x)<>'0' then result:=isobe(colbeo(x),result); x:=lrt(x); until x='0'; end;

// get iterated set of base elements without iterated last base element of array x function isobewilbeo(x:string; s:string=''):string; var e:integer; begin result:=s; e:=-1; repeat inc(e); if e>0 then begin if result<>'' then result:=result+'|'; result:=result+lbeo(x); end; if colbeo(x)<>'0' then if e=0 then result:=isobewilbeo(colbeo(x),result) else result:=isobe(colbeo(x),result); x:=lrt(x); until x='0'; end;

// compare arrays x1 and x2 of standard form function compare(x1,x2:string):shortint; var e:shortint;

// compare ordinals st1 and st2 function compareo(st1,st2:string):shortint; var e:shortint; s1,s2:string;

// compare Veblen functions s1 and s2 function comparev(s1,s2:string):shortint; var x1,x2,l,s,xs,i,st:string; e,p:shortint; b:boolean; begin x1:=getx(s1); x2:=getx(s2); b:=false; if s1=s2 then result:=0 else begin repeat e:=compare(cofbeo(x1),cofbeo(x2)); if e=0 then begin e:=compareo(fbeo(x1),fbeo(x2)); if e<>0 then b:=true; end; if e=0 then begin x1:=rrt(x1); x2:=rrt(x2); end; until (e<>0) or ((x1='0') and (x2='0')); if e=0 then result:=0 else begin if e<0 then begin p:=-1; s:=s1; l:=s2; xs:=x1; end else begin p:=1; s:=s2; l:=s1; xs:=x2; end; if b and (cofbeo(x1)='0') then result:=e else begin if b then xs:=rrt(xs); i:=isobewilbeo(xs); b:=false; if i<>'' then repeat if compareo(fe(i,'|'),l)>-1 then b:=true else i:=rrest(i,'|'); until b or (i='0'); if b then result:=-p else begin i:=ilbeo(xs); b:=false; repeat st:=fe(i,'|'); if compareo(st,'1')<>0 then b:=true else i:=rrest(i,'|'); until b or (i='0'); if not b then result:=p else begin e:=compareo(st,l); i:=rrest(i,'|'); if e=0 then begin if i='0' then result:=0 else begin b:=false; repeat if compareo(fe(i,'|'),l)>-1 then b:=true else i:=rrest(i,'|'); until b or (i='0'); if b then result:=-p else result:=0; end; end else begin b:=false; if e=1 then result:=-p else if i='0' then result:=p else begin repeat if compareo(fe(i,'|'),l)>-1 then b:=true else i:=rrest(i,'|'); until b or (i='0'); if b then result:=-p else result:=p; end; end; end; end; end; end; end; end;

// start compareo begin if st1=st2 then result:=0 else begin if st1='' then st1:='0'; if st2='' then st2:='0'; if (st1='0') or (st1='1') or (st2='0') or (st2='1') then begin if (st1='0') or (st1='1') then else st1:='2'; if (st2='0') or (st2='1') then else st2:='2'; result:=comparevalue(strtoint(st1),strtoint(st2)); end else begin repeat s1:=fe(st1); s2:=fe(st2); if (st1='0') or (st1='1') or (st2='0') or (st2='1') then e:=compareo(s1,s2) else e:=comparev(s1,s2); if e=0 then begin st1:=rrest(st1); st2:=rrest(st2); end; until (e<>0) or ((st1='0') and (st2='0')); result:=e; end; end; end;

// start compare begin if x1=x2 then result:=0 else if (x1='0') or (x1='1') or (x2='0') or (x2='1') then begin if (x1='0') or (x1='1') then else x1:='2'; if (x2='0') or (x2='1') then else x2:='2'; result:=comparevalue(strtoint(x1),strtoint(x2)); end else begin repeat e:=compare(cofbeo(x1),cofbeo(x2)); if e=0 then e:=compareo(fbeo(x1),fbeo(x2)); if e=0 then begin x1:=rrt(x1); x2:=rrt(x2); end; until (e<>0) or ((x1='0') and (x2='0')); result:=e; end; end;

// standard form of ordinal st function sf(st:string):string;

// standard form of array x function sfa(x:string):string; begin result:=''; repeat result:=sf(lbeo(x))+result; if colbeo(x)<>'0' then result:='<'+sfa(colbeo(x))+'>'+result; x:=lrt(x); if x<>'0' then result:=','+result; until x='0'; end;

// standard form of Cantor normal form term st function sft(st:string):string; var x,i,l,s:string; b:boolean; begin if (st='1') or (st='(0)') then result:='1' else begin x:=getx(st); i:=ilbeo(x); b:=false; s:='('+sfa(x)+')'; repeat //l:=sf(le(i,'|')); l:=le(i,'|'); //if (lrest(l)='0') and (l[1]='(') and csu(s,l) then     if (lrest(l)='0') and (l[1]='(') and (compare(s,l)=0) then b:=true else i:=lrest(i,'|'); until b or (i='0'); if b then result:=l else result:=s; end; end;

// start sf begin if st='0' then result:='0' else begin result:=''; repeat result:=sft(le(st))+result; st:=lrest(st); if st<>'0' then result:='+'+result; until st='0'; end; end;

// n-th fundamental sequence element of ordinal st function fse(st:string; n:integer; m:boolean=false; v:boolean=false):string; var r,l,x,i,delta:string; a,c:array[0..1000] of string; q,w,y,n2:integer; b:boolean; begin n2:=n; if st='BHO' then begin r:='1'; while n>0 do  begin r:='<'+r+'>1'; dec(n); end; result:='('+r+')'; end else begin r:=lrest(st); if m and not v and (r='0') and (le(st)<>'1') and (le(st)<>'(1)') then begin {if getordtype(fse(st,1,m,true))<2 then n:=n+2 else} if getordtype(fse(st,0,m,true))<2 then begin inc(n); //inc(n2); end; end; v:=false; if r<>'0' then

// Cantor normal form begin l:=fse(le(st),n,m,v); if l<>'0' then r:=r+'+'+l; end else

// Cantor normal form term begin if st='1' then r:='0' else               // 0 if st='(1)' then                         // omega if {not m and} (n=0) then r:='0' else                        // old m      begin r:=''; repeat if r<>'' then r:=r+'+'; r:=r+'1'; dec(n); until n={ifthen(m,-1,0)}0;                             // old m      end else begin x:=getx(st); if (cofbeo(x)='0') and (getordtype(x)=1) then

// x - successor ordinal if {not m and} (n=0) then r:='0' else                     // old m         begin r:=''; l:=sf('('+fse(x,0,m,v)+')'); repeat if r<>'' then r:=r+'+'; r:=r+l; dec(n); until n={ifthen(m,-1,0)}0;                           // old m         end

else begin //setlength(a,1); //setlength(c,1); c[0]:=lest(x,'0'); if leo(x)='0' then {if m and (lbeo(c[0])='1') and (lrt(c[0])='0') then delta:='1' else} delta:='0'             // old m                                                 // not modified else begin l:=lest(x,fse(leo(x),n,m,v)); if l='0' then delta:='1+1' else delta:='('+lest(x,fse(leo(x),n,m,v))+')'+'+1'; end; if getordtype(leo(x))=2 then

// leo(x) - limit ordinal r:=copy(delta,1,length(delta)-2)

else

// leo(x) - not limit ordinal begin i:=ilbeo(c[0]); q:=0; repeat a[q]:=fe(i,'|'); i:=rrest(i,'|'); inc(q); //setlength(a,q+1); //setlength(c,q+1); c[q]:=colbeo(c[q-1]); until i='0'; dec(q); b:=false; w:=-1; repeat inc(w); if getordtype(a[w])=2 then b:=true; until b or (w=q); r:=''; y:=w+1; if b then

// ilbeo contains limit ordinal begin repeat dec(y); l:=lbest(c[y],fse(lbeo(a[y]),n,m,v)); if l='0' then l:=''; if y=w then r:=l else begin if (l<>) and (r<>) then r:=l+','+r else r:=l+r; end; if y>0 then begin if r<>'' then r:='<'+r+'>'; r:=r+'1'; end; until y=0; if not clested or (delta<>'0') then r:=lest(r,sf(delta));       // do not set to zero last element (clest) end else

// ilbeo does not contain limit ordinal begin repeat dec(y); l:=lbest(c[y],fse(lbeo(a[y]),n,m,v)); if y=w then if n>0 then begin if l<>'0' then l:='<'+l+'>' else l:=''; r:=l+fse(st,n-1,m,true);                        // v                        end else

// 2nd system begin if (fss=2) and (delta<>'0') then begin if l<>'0' then l:='<'+l+'>' else l:=''; r:=l+delta;                        // v                           end; end

else begin if l='0' then l:=''; if (l<>) and (r<>) then r:=l+','+r else r:=l+r; if y>0 then begin if r<>'' then r:='<'+r+'>'; r:=r+'1'; end; end; until y=0; if (fss=6) and (n=0) and (not clested or (delta<>'0')) then r:=lest(r,delta);   // 6th system, do not set to zero last element (clest) end; if (r='0') or (r='') then r:='1' else r:='('+r+')'; end; end; end; end; {if n2>1 then l:=sf(r); if (n2>1) and (r<>l) then result:=r else} if n2>1 then result:=r else result:=sf(r); end; end;

// expand e-th ordinal in current list procedure expand(e:integer); var u,i,y,o:integer; g:byte; st:string; begin j[e]:=true; inc(fsc); dec(c1); l[e]:=false; k[e]:=0; form1.Label1.Caption:=inttostr(fsc)+' / '+inttostr(c1)+'                                         '; form1.Label1.Refresh; setlength(s,length(s)+m); setlength(l,length(l)+m); setlength(j,length(j)+m); setlength(c,length(c)+m); setlength(k,length(k)+m); o:=c[e]; c[length(s)-1]:=o; c[e]:=length(s)-m; for i:=length(s)-m to length(s)-2 do c[i]:=i+1; i:=-1; repeat inc(i); st:=fse(s[e],i,mo); until compare(st,s[o])=1; g:=getordtype(st); if not ec and (lrest(st)<>'0') then g:=1; for y:=1 to m do  begin u:=length(s)-y; if y>1 then s[u]:=fse(s[e],i+y-1,mo) else s[u]:=st; if g=2 then k[u]:=y else k[u]:=0; if (lic>1) and (y=1) and (g=2) then inc(c1); if (y0) and (k[e]<=si+1) then inc(c1);           // k   dec(n); //dec(m); e:=1; lic:=li; repeat {if not l[e] and l[c[e]] and (getordtype(s[e])=2) then                        // l         begin l[e]:=true; e:=c[e]; end} if k[e]>si+1 then                                                           // k         begin k[e]:=k[e]-si; e:=c[e]; end else //if l[e] and (lic>0) then                                                 // l         if (k[e]>0) and (lic>0) then                                                // k            begin expand(e); e:=c[e]+m-1; end else begin e:=c[e]; lic:=li; end; until c[e]=-1; until n=0; end;

// convert ordinal st function convert(st:string):string; var s1,s2:string; n:integer;

// convert Veblen function s function convertv(s:string):string; var x,l,s1,x1,s2,x2:string;

// convert array x function converta(x:string):string; var st,x1:string; //c:shortint; b:boolean; begin if x='0' then result:='0' else begin result:=''; x1:=cofbeo(x); if false then //if (x1='0') or (({(x1='1+1+1') or (x1='1+1') or} (x1='1')) and (lrt(x)<>'0')) then //if compare(x1,'1')=-1 then begin {c:=strtoint(convert(x1)); repeat if c<>strtoint(convert(x1)) then st:='0' else begin st:=convert(fbeo(x)); x:=rrt(x); x1:=cofbeo(x); end; if result<>'' then result:=result+','; result:=result+st; dec(c); until c<0;} end else begin if colbeo(x)='0' then b:=true else b:=false; repeat st:=convert(lbeo(x)); x1:=colbeo(x); x:=lrt(x); if (x1<>'0') or (x<>'0') then {if cofbeo(x1)='0' then                     // @ st:=st+' @ '+convert(x1) else} if suca(x1)<>colbeo(x) then              // omit predecessors of coordinates begin if not b or ((x<>'0') and (compare('(1)',colbeo(x))=1)) then //st:='['+converta(x1)+']'+st;           // coordinates inside [] st:=+converta(x1)++st;    // coordinates - left supersript if b then b:=false;                   // omit successors of 0 coordinates end; if result<>'' then result:=','+result; result:=st+result; until x='0'; end; end; end;

// start convertv begin x:=getx(s); s1:=lbeo(x); x1:=colbeo(x); l:=lrt(x); if (x1='0') and (l='0') then begin result:='omega'; if s1<>'1' then result:=result++convert(s1)+; end else begin if x1='0' then begin s2:=lbeo(l); x2:=colbeo(l); l:=lrt(l); end else begin s2:=s1; x2:=x1; s1:='0'; x1:='0'; end; if (l='0') and (((x2='1') and ((s2='1') or (s2='1+1') or (s2='1+1+1'))) or (((x2='1+1') or (x2='1+1+1') or (x2='(1)') or (x2='<1>1'){ or (x2='<1>1,(1)') or (x2='<1>1+1') or (x2='<1>(1)') or (x2='<1+1>1') or (x2='<(1)>1') or (x2='<<1>1>1')}) and (s2='1'))) then begin if x2='1' then begin if s2='1' then s2:='epsilon' else if s2='1+1' then s2:='zeta' else s2:='eta'; end else begin if x2='1+1' then s2:='Gamma' else if x2='1+1+1' then s2:='Delta' else if x2='(1)' then s2:='v' else {if x2='<1>1,(1)' then s2:='u' else if x2='<1>1+1' then s2:='U' else if x2='<1>(1)' then s2:='s' else if x2='<1+1>1' then s2:='S' else if x2='<(1)>1' then s2:='h' else if x2='<<1>1>1' then s2:='H' else} s2:='V'; end; result:=s2++convert(s1)+; end else //result:='phi('+converta(x)+')';             // phi result:='('+converta(x)+')';                  // without phi end end;

// start convert begin if (st='0') or (st='BHO') then result:=st else begin result:=''; repeat s1:=le(st); s2:=s1; n:=0; while (st<>'0') and (s1=s2) do        begin inc(n); st:=lrest(st); s2:=le(st); end; if s1='1' then s1:='' else s1:=convertv(s1); if (n>1) or (s1='') then s1:=s1+inttostr(n); if result<>'' then result:='+'+result; result:=s1+result; until st='0'; end; end;

// array part with finite coordinates shift to the right by 1 function asttr(x:string):string; var l,c:string; begin result:=''; if x<>'0' then repeat l:=fbeo(x); c:=cofbeo(x); x:=rrt(x); if (cofbeo(c)='0') and (fe(c)='1') then c:=fse(c,0) else if c='0' then l:=''; if c<>'0' then l:='<'+c+'>'+l; if (result<>) and (l<>) then l:=','+l; result:=result+l; until x='0'; if result='' then result:='0'; end;

// Veblen to Madore function vtm(st:string):string; var s1,s2:string; n:integer;

// array to exponent function ate(x:string):string; var l,c:string; begin if x='0' then result:='0' else begin result:=''; repeat l:=fbeo(x); c:=ate(cofbeo(x)); x:=rrt(x); if c<>'0' then begin if l='1' then l:='' else l:=vtm(l); if c='1' then l:='Omega'+l else l:='Omega'+c+''+l; end else l:=vtm(l); if result<>'' then l:='+'+l; result:=result+l; until x='0'; end; end;

// array to argument function ata(x:string):string; var l,a:string; begin if cofbeo(x)='1' then begin l:=fbeo(x); a:=leo(x); if l='1' then result:=vtm(a) else begin if fe(l)='1' then l:=fse(l,0); if l='1' then l:= else l:=+vtm(l)+''; if fe(a)='1' then a:=a+'+1' else if a='0' then a:=''; if a<>'' then a:=vtm(a); result:='Omega'+l+a; end; end else begin a:=leo(x); if fe(a)='1' then a:=a+'+1' else if a='0' then a:=''; if a<>'' then a:=vtm(a); result:='Omega'+ate(asttr(x))+''+a; end; end;

// Cantor normal form term Veblen to Madore function vtmt(st:string):string; var x,x1,s,l,beta:string; b:boolean; begin x:=getx(st); if cofbeo(x)='0' then if x='1' then result:='omega' else result:='omega'+vtm(x)+'' else begin result:=''; b:=false; repeat l:=leo(x); x1:=fe(l); if x1[1]='(' then x1:=getx(x1);     if (cofbeo(x1)<>'0') and (compare(lest(x1,'0'),lest(x,'0'))=1) then         begin         beta:=rrest(l);         if ((cofbeo(x)<>'1') or (fbeo(x)<>'1')) and (fe(beta)='1') then beta:=fse(beta,0);         end      else         b:=true;      if b then         s:=ata(x)      else         //s:=vtm('('+lest(x,beta)+')');         s:=ata(lest(x,beta));      if result<>'' then result:='+'+result;      result:=s+result;      x:=x1;      until b;   result:='psi('+result+')';   end; end;

// start vtm begin if (st='0') or (st='BHO') then result:=st else begin result:=''; repeat s1:=le(st); s2:=s1; n:=0; while (st<>'0') and (s1=s2) do        begin inc(n); st:=lrest(st); s2:=le(st); end; if s1='1' then s1:='' else s1:=vtmt(s1); if (n>1) or (s1='') then s1:=s1+inttostr(n); if result<>'' then result:='+'+result; result:=s1+result; until st='0'; end; end;

// add ca to cout procedure ca(st:string); begin cout:=cout+st; end;

// get html link s, displaying string st function getrefs(s, st: string):string; begin result:=''+st+''; end;

// get html link for n-th ordinal in the list, displaying ordinal st function getref(n:integer; st: string):string; begin result:=getrefs(inttostr(n),st); end;

// add line st to output procedure addln(st:string); begin if g then ca(st+#13#10) else writeln(f,st); end;

// write list to file procedure raiselist; var s1:array of string; j1:array of boolean; n:array of integer; k1:array of byte; e,i,y:integer;

procedure ch; begin if not h then addln(''); end;

begin setlength(s1,length(s)); setlength(j1,length(j)); setlength(k1,length(k)); setlength(n,length(k)); e:=1; i:=0; y:=1; repeat s1[i]:=s[e]; j1[i]:=j[e]; k1[i]:=k[e]; n[i]:=e; e:=c[e]; inc(i); until e=-1; if not g then begin st:='D:\Delphi\Ord2\1.'; if h then st:=st+'htm' else st:=st+'txt'; assignfile(f,st); rewrite(f); end; st:='FS #1'; //st:=''; if h then begin st:=' '+st+' '; st:='sup {font-size: 0.83rem;}'+st; st:='sub {font-size: 0.83rem;}'+st; st:=' '+st; end; addln(st); ch; repeat dec(i); if j1[i] or ((i0) and (k1[i]<=k1[i+1])) then begin inc(y); if i>0 then st:='FS #'+inttostr(y)+'' else st:='...'; if h then st:=st+' '; addln(st); ch; end; //st:=convert(s1[i]); st:=vtm(s1[i]); //st:=vtm(s1[i])+' = '+convert(s1[i]); st:=stringreplace(st,'+',' + ',[rfReplaceAll]); st:=stringreplace(st,',',', ',[rfReplaceAll]); st:=stringreplace(st,'omega','&#969;',[rfReplaceAll]); st:=stringreplace(st,'epsilon','&#949;',[rfReplaceAll]); st:=stringreplace(st,'zeta','&#950;',[rfReplaceAll]); st:=stringreplace(st,'eta','&#951;',[rfReplaceAll]); st:=stringreplace(st,'Gamma','&#915;',[rfReplaceAll]); st:=stringreplace(st,'Delta','&#916;',[rfReplaceAll]); st:=stringreplace(st,'psi','&#968;',[rfReplaceAll]); st:=stringreplace(st,'Omega','&#937;',[rfReplaceAll]); if links and (k1[i]>0) then st:=getref(n[i],st); if h then st:=st+' '; addln(st); ch; until i=0; if g then begin addln(' '); addln(getrefs('reset','Reset')); end; if h then addln(' '); if not g then closefile(f); end;

// reset list of ordinals procedure resetlist; begin setlength(s,2); setlength(l,2); setlength(j,2); setlength(c,2); setlength(k,2);

s[0]:='0'; l[0]:=false; j[0]:=false; c[0]:=-1; k[0]:=0;

s[1]:='BHO'; l[1]:=true; j[1]:=true; c[1]:=0; k[1]:=1; end;

// read HTTP from cin to q... procedure readhttp; var e:integer; begin e:=pos(' ',cin)+1; qm:=leftstr(cin,e-2); qurl:=copy(cin,e,posex(' ',cin,e)-e); delete(qurl,1,1); if qurl='' then qurl:='0'; e:=pos('Host: ',cin)+6; qhost:=copy(cin,e,posex(#13#10,cin,e)-e); e:=pos(#13#10#13#10,cin)+4; qc:=copy(cin,e,length(cin)); end;

// client request procedure TForm1.Serversocket1ClientRead(Sender: TObject; Socket: TCustomWinSocket); var e:integer; b:boolean; begin // cin - client request, cout - server response, dn - host name cin:=Socket.ReceiveText; cout:=''; readhttp; b:=true; if trystrtoint(qurl,e) then begin if (e>0) and (e0) then begin c1:=1; expand(e); end; end else begin if qurl='reset' then resetlist else b:=false; end; if b then begin raiselist; Socket.SendText(cout); end; Socket.Close; end;

// start procedure TForm1.Button1Click(Sender: TObject); begin st:='<7>3,<<11>12,<1>8,<<20>30,6>10>5'; st1:='<7>3,<1>500000'; //st:='0'; //st1:=lbeo(st); //st1:=ilbeo(st); //st1:=isobe(st); //st1:=isobewilbeo(st);

//st:='<1+1+1+1+1+1+1>1+1+1,<<1+1+1+1+1+1+1+1+1+1+1>1+1+1+1+1+1+1+1+1+1+1+1,<1>1+1+1+1+1+1+1+1,<<1+1>1+1+1,1+1+1+1+1+1>1+1+1+1+1+1+1+1+1+1>1+1+1+1+1'; //st1:='<1+1+1+1+1+1+1>1+1+1,<1>1+1+1+1+1';

//st:='(<1+1+1+1+1+1+1>1+1+1,<1>1+1+1+1+1)'; //st1:='(<1+1+1+1+1+1+1>1+1+1,<<1+1+1+1+1+1+1+1+1+1+1>1+1+1+1+1+1+1+1+1+1+1+1,<1>1+1+1+1+1+1+1+1,<<1+1>1+1+1,1+1+1+1+1+1>1+1+1+1+1+1+1+1+1+1>1+1+1+1+1)';

//st:='(<1>(<1+1>1),1)'; //st1:='(<1+1>1)';

{st:='(<<1+1+1>1+1+1+1>1+1+1+1+1+1+1+1,1+1+1+1+1+1)'; st:='(<<1>1>1,1)'; st:='(<1>1+1)';

st:=fse(st,0);}

//e:=compare('(<1>1,(((((((((((1))))))))))))','(((((((((((1))))))))))))'); //e:=compare('(<1>1)','(((((1)))))'); //e:=compare('(<<<<1>1>1>1>1)','(<<<1>1>1>1)');

//st:=fse('(<<1>1>1,(<<((<1>1)+1)>1>1)+1)',9); //st:=fse('(<1>1)',15); //st:=sf('(<1>1,(<1>1,(<1>1,(<1>1))))');

//st:=sf('(<(<(<(<(<(<(<(<(<((<<((<1>1))>1>1)+1)>1)>1)>1)>1)>1)>1)>1)>1)>1)'); //e:=compare('(<(<(<(<(<(<(<(<(<((<<1>1>1)+1)>1)>1)>1)>1)>1)>1)>1)>1)>1)','(<(<(<(<(<(<(<(<(<(<<1>1>1)>1)>1)>1)>1)>1)>1)>1)>1)>1)'); //e:=compare('(<(<(<(<(1)+1>1)>1)>1)>1)','(<(<(<(<(1)+1+1>1)>1)>1)>1)');

fss:=6;           // fundamental sequence system clested:=true;    // clested

{st:=sf('(<(<<1>1>1)>1)'); st:=fse('(<(<<1>1>1)+1>1)',1,true); st:=sf(st); }

//st:=suca('1+1'); //st:=fse(st,0,true); //st:=convert(st);

resetlist;

//s[1]:='(<1>1)';

ec:=true;         //expand ordinals with more than 1 Cantor normal form terms mo:=true;         // modified li:=300000000;    // limitation of expansions number

fsc:=0;

m:=7;            // number of fundamental sequence elements si:=1;            // number of fundamental sequence elements expanded initially {levelup(1); si:=3; m:=6; levelup(1); si:=2; m:=4; levelup(1); si:=1; levelup(1); si:=1; levelup(1); si:=1; levelup(1); si:=1; levelup(1); levelup(1); levelup(1); levelup(1); levelup(1); levelup(1);}

h:=true;                  // if true then html else wiki g:=true;                  // if true then output to browser else to file links:=true;              // links at browser output e:=length(s); //raiselist;

ServerSocket1.open; end;

// close program procedure TForm1.Form1Destroy(Sender: TObject); begin ServerSocket1.Close; end;

end.

Components
Components used in the program:


 * Form1
 * Button1
 * Label1
 * ServerSocket1

I use Delphi 7.

Also, I set property Port of ServerSocket1 to 80, and event OnClientRead of ServerSocket1 to Serversocket1ClientRead.

Updates
I'm going to develop the program further, and here will be updates.

Feel free to make suggestions.