Текстовый движок! Опции

[GLuk]

Не знал куда запихать. Вот тут появились мысли по поводу текстового движка для форума, в каком-то смысле. И вот краснея/бледнея от стыда, с криками/стонами вампиров, кидаю тебе народ свои иЦходники...
для того чтобы заработало уберите восклицательные знаки из описания цветов в константах...

см. ниже

Решил тут поправить исходник - поправил, привел примеры работы, а когда решил изменить исходник - злой/вонючий/говенный провайдер выкинул меня из инета, изменения как таковые - это цветовая гамма

[GLuk]

Uses
   Crt;

Const
    N = 32;
    a: array [1..N] of String = ('BEGIN', 'PROCEDURE','STRING','VAR',
                                 'ELSE','FOR','TO','DO','IF','THEN','USES',
                                 'CONST','WHILE','NOT','END','ARRAY','OF',
                                 'REPEAT','UNTIL','WITH','CASE','DOWNTO',
                                 'GOTO','INLINE','ASM','TYPE','IMPLEMENTATION',
                                 'INTERFACE','ASSEMBLER','EXTERNAL','INTERRUPT',
                                 'LABEL');
    GrayFlag1:Boolean = False;
    GrayFlag2:Boolean = False;
    AsmFlag:Boolean   = False;
    TextFlag:Boolean  = False;
    AsmColor:String   = '[colo!r=Green]';
    ReservedColor : String = '[colo!r=White]';
    GrayColor1 : String = '[colo!r=Black]';
    GrayColor2 : String = '[colo!r=Teal]';
    StandartColor : String = '[colo!r=Yellow]';
    EndColor : String = '[/colo!r]';

Procedure CheckForReservedWords(var W : String);
var
  i,j,Si:Integer;
  Process:Boolean;
  L:Byte;
  T:String;
begin
    i:=1;
    While i<=Length(W) do
    begin
         Case W[i] of
         {RESERVED WORDS}
         {Џ®вҐ­жЁ «м­ п ў®§¬®¦­®бвм ўбваҐзЁ § аҐ§ҐаўЁа®ў ­­®Ј® б«®ў }
         'A'..'Z','a'..'z':If (not GrayFlag1) and (not GrayFlag2) and (not TextFlag) then
         If Ord(W[i+1]) in [65..90, 97..122] then
         {…¦Ґ«Ё нв® ­Ґ ®¤Ё­®з­л© бЁ¬ў®«, Їа®ўҐа塞 ¤ «миҐ}
         begin
              Si:=i;
              While Ord(W[i]) in [65..90, 97..122] do Inc(i);
              T:=Copy(W,Si,i-Si); {‚뤥«пҐ¬ б«®ў®}
              For j:=1 to Length(T) do T[j]:=UpCase(T[j]); {‚ ўҐае­Ё© ॣЁбва}
              j:=1;
              While (j<=N) do
              begin
                   If a[j]=T then
                   begin
                        Insert(EndColor,W,Si+Length(T));
                        Insert(ReservedColor,W,Si);
                        Inc(i,Length(EndColor)+Length(ReservedColor)-1);
                        j:=N;
                   end;
                   Inc(j);
              end;
              If T='ASM' then
              begin
                   AsmFlag:=True;
                   Insert(AsmColor,W,i);
                   Inc(i,Length(AsmColor));
              end;
              If (T='END') and (AsmFlag) then
              begin
                   AsmFlag:=False;
                   Insert(EndColor,W,i+1);
                   Inc(i,Length(EndColor));
              end;
         end;
         ' ':begin end; {iret/§ Ј«гиЄ  ¤«п Їа®ЎҐ«  - ¤ Ўл Ўлбв॥ Їа®бЄ ЄЁў «}
         {--------------}
         {COMMENTS}
         '{':begin
                  Insert(GrayColor1,W,i);
                  Inc(i,Length(GrayColor1));
                  GrayFlag1:=True;
             end;
         '}':begin
                  Insert(EndColor,W,i+1);
                  Inc(i,Length(EndColor));
                  GrayFlag1:=False;
             end;
         '(':If W[i+1]='*' then
             begin
                  GrayFlag2:=True;
                  Insert(GrayColor2,W,i);
                  Inc(i,Length(GrayColor2));
                  Inc(i); {Џа®ЇгбЄ Ґ¬ §ўҐ§¤г}
             end; {Їа®ўҐаЄ  ­  (**) }
         '*':If (W[i+1]=')') and (GrayFlag2) then
             begin
                  GrayFlag2:=False;
                  Insert(EndColor,W,i+2);
                  Inc(i,Length(EndColor));
                  Inc(i); {Џа®ЇгбЄ Ґ¬ § Єалў ойго бЄ®ЎЄг}
             end;
         #39:If not TextFlag then TextFlag:=True {ЂЇ®бва®д}
             else TextFlag:=False;
         {--------}
         {DOS -> WIN}
         #128..#175:W[i]:=Chr(Ord(W[i])+64); {'Ђ'-'Ї'}
         #224..#239:W[i]:=Chr(Ord(W[i])+16); {'а'-'п'}
         'с':begin end; {с - Ў®«м讥 Ё ¬ «Ґ­мЄ®Ґ}
         'р':begin end;
         {----------}
         {MISC}
         '[':begin end;          ']':begin end;
         end;
         Inc(i);
    end;
end;

Var
  T,F:Text;
  S,Ts:String;
  M:Byte;
  C:LongInt;

Begin
    ClrScr;
    If ParamStr(1)='' then
    begin
         WriteLn('?бЇ®«м§®ў ­ЁҐ: forum_t.exe [Ё¬п_д ©« ]');
         Halt(1);
    end;
    S:=ParamStr(1);
    Assign(T,S);
    Reset(T);
    S:=Copy(S,1,Pos('.',S))+'TXT';
    Assign(F,S);
    ReWrite(F);
    {WriteLn(F,StandartColor);}
    C:=0;
    While not Eof(T) do
    begin
    {ЏаЁ¤Ґвбп а §ЎЁў вм Ї® 4800 бЁ¬ў®«®ў :( }
         ReadLn(T,S);
         CheckForReservedWords(S);
         GotoXY(1,1); Write©;
         Inc(C,Length(S));
         If C>=4800 then
         begin
              C:=0;
              WriteLn(F,'---------------cut here---------------');
         end;
         WriteLn(F,S);
    end;
    {WriteLn(F,EndColor);}{‡ Єа. ⥣ ¤«п StandartColorTeg}
    Close(T);
    Close(F);
End.