All pastes #837796 Raw Edit

Someone

public text v1 · immutable
#837796 ·published 2007-12-29 22:37 UTC
rendered paste body
unit Parser;

interface

uses
  SysUtils, Classes;

type

  PProc = Procedure(Execute: Boolean; Params: Array of string) of object;

  TSwitchType = (SWITCH_VALUE, SWITCH_VALPROC, SWITCH_PROCEDURE);

  TSwitch = packed record
    Counter: Byte;
    Pos: Word;
    Proc: PProc;
    SType: TSwitchType;
  end;
  TSwitchArray = array of ^TSwitch;
  PSwitch = ^TSwitch;


  TParser = Class(TObject)
  {
    TParser 1.1

    Guide lines:
      + Allow checking of an eariler switch
      + Only Parsering Switch string
      + No case sensetive
      + Must be fast
  }
  private
    Data: Array['A'..'z'] of ^TSwitch;
  public
    constructor Initialize;
    destructor Destroy;override;
    function Work(Buffer: Array of string): Boolean;
    function Add(Switch: Char; Count: Byte; Callback: PProc; &Type: TSwitchType) : Boolean;
  end;

implementation

constructor TParser.Initialize;
var
  I: Word;
begin
  inherited Create;
  for I := Ord('A') to Ord('z') do
    Data[Chr(I)] := nil;
end;

destructor TParser.Destroy;
var
  I: Word;
begin
  for I := Ord('A') to Ord('z') do
    if Data[Chr(I)] <> nil then Dispose(Data[Chr(I)]);
  inherited Destroy;
end;

function TParser.Work;
type
  TData = packed record
    Paramters: Array of string;
    P: TSwitch;
  end;
var
  Temp: String;
  I, X, Y, Calc, Sum: Word;
  &Type: TSwitchType;
  Buf: array [TSwitchType] of array of TData;
  Test: ^TData;
begin
  Result := True;

  if (Length(Buffer) = 0) or (Length(Buffer[0]) = 0) then Exit;
  { If there are no paramters then Quit }

  for I := 0 to Length(Buffer) - 1 do
  begin
    Temp := Buffer[I];
    if Temp[1] = '-' then
    begin
      Calc := 0;
      Sum := Calc;
      Temp := Copy(Temp, 2, Length(Temp));
      for X := 1 to Length(Temp) do
      begin
        if Data[Temp[X]] <> nil then
        begin
          // Now calc and set paramters
          if (Length(Buffer) - I - 1 - Sum) >= Data[Temp[X]].Counter then
          begin
            &Type := Data[Temp[X]].SType;
            case Data[Temp[X]].SType of
              SWITCH_VALUE, SWITCH_VALPROC: begin
                SetLength(Buf[&Type], Length(Buf[&Type])+1);
                Buf[&Type, Length(Buf[&Type])-1].P := Data[Temp[X]]^;

                Test := Addr(Buf[&Type, Length(Buf[&TYpe])-1].Paramters);

                SetLength(Test^.Paramters, Data[Temp[X]].Counter);
                for Y := 0 to Length(Test^.Paramters) - 1 do
                begin
                  Test^.Paramters[Y] := Buffer[I + Sum + 1];
                end;
                Inc(Sum, Data[Temp[X]].Counter);
              end;
              SWITCH_PROCEDURE: begin
                SetLength(Buf[&Type], Length(Buf[&Type])+1);
                Buf[&Type, Length(Buf[&Type])-1].P := Data[Temp[X]]^;
              end;
            end;
          end
          else
          begin
            Result := False;
              Break;
              Break;
          end;
        end;
      end;
    end;
  end;
  if Result then
     for X := 0 to 2 do
      for I := 0 to Length(Buf[TSwitchType(X)]) - 1 do
        if Length(Buf[TSwitchType(X)]) > 0 then
          case X of
            0: Buf[SWITCH_VALUE, I].P.Proc(False, Buf[SWITCH_VALUE, I].Paramters);
            1:  begin
                  if I = (Length(Buf[SWITCH_VALPROC])-1) then
                    Buf[SWITCH_VALPROC, I].P.Proc(True, Buf[SWITCH_VALPROC, I].Paramters)
                  else
                    Buf[SWITCH_VALPROC, I].P.Proc(FALSE, Buf[SWITCH_VALPROC, I].Paramters);
                end;
            2: if I = Length(Buf[SWITCH_PROCEDURE])-1 then
                  Buf[SWITCH_PROCEDURE, I].P.Proc(True, [])
                else
                  Buf[SWITCH_PROCEDURE, I].P.Proc(False, []);
        end;
end;

function TParser.Add(Switch: Char; Count: Byte; Callback: PProc; &Type: TSwitchType): Boolean;
begin
  if Data[Switch] <> Nil then
    Result := False
  Else
  begin
    New(Data[Switch]);
    with Data[Switch]^ do
    begin
      Counter := Count;
      Proc := CallBack;
      SType := &Type;
    end;
    Result := True;
  end;
end;


end.