psvautoassembler.pas.svn-base

这是一段游戏修改工具的源代码.ring3功能由dephi开发,驱动是C开发.希望对大家有帮助

  HashKey: Integer;
begin
  fToIdent := MayBe;
  HashKey := KeyHash(MayBe);
  if HashKey < 223 then Result := fIdentFuncTable[HashKey] else
    Result := tkIdentifier;

  if (result=tkIdentifier) and (GetOpcodesIndex(getfirsttoken(maybe))<>-1) then
    result:=tkKey;

end;

procedure TpsvAARTF.MakeMethodTables;
var
  I: Char;
begin
  for I := #0 to #255 do
    case I of
      #0: fProcTable[I] := NullProc;
      #10: fProcTable[I] := LFProc;
      #13: fProcTable[I] := CRProc;
      #1..#9, #11, #12, #14..#32:
        fProcTable[I] := SpaceProc;
      '#': fProcTable[I] := AsciiCharProc;
      //'$': fProcTable[I] := IntegerProc;
      #39: fProcTable[I] := StringProc;
      '0'..'9','A'..'F', 'a'..'f': fProcTable[I] := NumberProc;
      'G'..'Z', 'g'..'z', '_':
        fProcTable[I] := IdentProc;
      '{': fProcTable[I] := BraceOpenProc;
      '}', '!', '"', '%', '&', '('..'/', ':'..'@', '['..'^', '`', '~':
        begin
          case I of
            '(': fProcTable[I] := RoundOpenProc;
            '.': fProcTable[I] := PointProc;
            ';': fProcTable[I] := SemicolonProc;
            '/': fProcTable[I] := SlashProc;
            ':', '>': fProcTable[I] := ColonOrGreaterProc;
            '<': fProcTable[I] := LowerProc;
            '@': fProcTable[I] := AddressOpProc;
          else
            fProcTable[I] := SymbolProc;
          end;
        end;
    else
      fProcTable[I] := UnknownProc;
    end;
end;

constructor TpsvAARTF.Create;
begin
  inherited Create;
  InitIdent;
  MakeMethodTables;
  fRange := rsUnknown;
  fAsmStart := False;
  CreateColorTable([clBlue,   //1  Comment
                    clBlack,  //2  Identifier
                    clBlack,  //3  Key
                    clGreen,  //4  Number
                    clNavy,   //5  Space
                    clRed,    //6  String
                    clBlack,  //7  Symbol
                    clGreen, //8 Unknown
                    clBlack, //9
                    $0080f0
                    ]);
end; { Create }

procedure TpsvAARTF.SetLine(NewValue: string; LineNumber:Integer);
begin
  fLine := PChar(NewValue);
  Run := 0;
  fLineNumber := LineNumber;
  Next;
end; { SetLine }

procedure TpsvAARTF.AddressOpProc;
begin
  fTokenID := tkSymbol;
  inc(Run);
  if fLine[Run] = '@' then inc(Run);
end;

procedure TpsvAARTF.AsciiCharProc;
begin
  fTokenID := tkString;
  inc(Run);
  while FLine[Run] in ['0'..'9'] do inc(Run);
end;

procedure TpsvAARTF.BorProc;
begin
  case fLine[Run] of
     #0: NullProc;
    #10: LFProc;
    #13: CRProc;
    else begin
      fTokenID := tkComment;
      repeat
        if fLine[Run] = '}' then begin
          Inc(Run);
          if fRange = rsBorAsm then
            fRange := rsAsm
          else
            fRange := rsUnKnown;
          break;
        end;
        Inc(Run);
      until fLine[Run] in [#0, #10, #13];
    end;
  end;
end;

procedure TpsvAARTF.BraceOpenProc;
begin
  if fRange = rsAsm then
    fRange := rsBorAsm
  else
    fRange := rsBor;
  BorProc;
end;

procedure TpsvAARTF.ColonOrGreaterProc;
begin
//rsANil, rsAnsi, rsAnsiAsm, rsAsm, rsBor, rsBorAsm, rsProperty,   rsUnKnown
  fTokenID := tkSymbol;
  inc(Run);
  if fLine[Run] = '=' then inc(Run);
end;

procedure TpsvAARTF.CRProc;
begin
  fTokenID := tkSpace;
  inc(Run);
  if fLine[Run] = #10 then inc(Run);
end;

procedure TpsvAARTF.IdentProc;
begin
  fTokenID := IdentKind((fLine + Run));
  inc(Run, fStringLen);
  while Identifiers[fLine[Run]] do inc(Run);
end;

procedure TpsvAARTF.IntegerProc;
begin
  inc(Run);
  fTokenID := tkNumber;
  while FLine[Run] in ['0'..'9', 'A'..'F', 'a'..'f'] do inc(Run);
end;
            
procedure TpsvAARTF.NumberProc;
begin
  fTokenID := IdentKind((fLine + Run));

  if fTokenID=tkIdentifier then
  begin
    inc(Run);
    fTokenID := tkNumber;
    while FLine[Run] in ['0'..'9', '.', 'a'..'f' , 'A'..'F'] do
    begin
      {case FLine[Run] of
        '.':
          if FLine[Run + 1] = '.' then break;
      end;   }
      inc(Run);
    end;

    if ((FLine[Run]>'G') and (FLine[Run]<='Z')) or ((FLine[Run]>='g') and (FLine[Run]<='z')) then
      fTokenID:=tkIdentifier;
  end
  else
  begin
    inc(Run, fStringLen);
    while Identifiers[fLine[Run]] do inc(Run);
  end;
end;



procedure TpsvAARTF.LFProc;
begin
  fTokenID := tkSpace;
  inc(Run);
end;

procedure TpsvAARTF.LowerProc;
begin
  fTokenID := tkSymbol;
  inc(Run);
  if fLine[Run] in ['=', '>'] then inc(Run);
end;

procedure TpsvAARTF.NullProc;
begin
  fTokenID := tkNull;
end;



procedure TpsvAARTF.PointProc;
begin
  fTokenID := tkSymbol;
  inc(Run);
  if fLine[Run] in ['.', ')'] then inc(Run);
end;

procedure TpsvAARTF.AnsiProc;
begin
  case fLine[Run] of
     #0: NullProc;
    #10: LFProc;
    #13: CRProc;
  else
    fTokenID := tkComment;
    repeat
      if (fLine[Run] = '*') and (fLine[Run + 1] = '/') then begin
        Inc(Run, 2);
        if fRange = rsAnsiAsm then
          fRange := rsAsm
        else
          fRange := rsUnKnown;
        break;
      end;
      Inc(Run);
    until fLine[Run] in [#0, #10, #13];
  end;
end;

procedure TpsvAARTF.RoundOpenProc;
begin
  Inc(Run);
  case fLine[Run] of
  {  '*':
      begin
        Inc(Run);
        if fRange = rsAsm then
          fRange := rsAnsiAsm
        else
          fRange := rsAnsi;
        fTokenID := tkComment;
        if not (fLine[Run] in [#0, #10, #13]) then
          AnsiProc;
      end; }
    '.':
      begin
        inc(Run);
        fTokenID := tkSymbol;
      end;
  else
    fTokenID := tkSymbol;
  end;
end;

{begin}
procedure TpsvAARTF.SemicolonProc;
begin
  Inc(Run);
  fTokenID := tkSymbol;
  if fRange = rsProperty then
    fRange := rsUnknown;
end;
{end}


procedure TpsvAARTF.SlashProc;
begin
  Inc(Run);
  if fLine[Run] = '/' then
  begin
    fTokenID := tkComment;
    repeat
      Inc(Run);
    until fLine[Run] in [#0, #10, #13];
  end
  else
  if fline[run] = '*' then
  begin
      begin
        Inc(Run);
        if fRange = rsAsm then
          fRange := rsAnsiAsm
        else
          fRange := rsAnsi;
        fTokenID := tkComment;
        if not (fLine[Run] in [#0, #10, #13]) then
          AnsiProc;
      end;
  end
  else fTokenID := tkSymbol;
end;

procedure TpsvAARTF.SpaceProc;
begin
  inc(Run);
  fTokenID := tkSpace;
  while FLine[Run] in [#1..#9, #11, #12, #14..#32] do inc(Run);
end;

procedure TpsvAARTF.StringProc;
begin
  fTokenID := tkString;
  Inc(Run);
  while not (fLine[Run] in [#0, #10, #13]) do begin
    if fLine[Run] = #39 then begin
      Inc(Run);
      if fLine[Run] <> #39 then
        break;
    end;
    Inc(Run);
  end;
end;

procedure TpsvAARTF.SymbolProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
end;

procedure TpsvAARTF.UnknownProc;
begin
  inc(Run);
  fTokenID := tkUnknown;
end;

procedure TpsvAARTF.Next;
begin
  fAsmStart := False;
  fTokenPos := Run;
  case fRange of
    rsAnsi, rsAnsiAsm:
      AnsiProc;
    rsBor, rsBorAsm:
      BorProc;
  else
    fProcTable[fLine[Run]];
  end;
{
  if fline[Run]=':' then
  begin
    fTokenID := tkLabel;

    while fline[run]=':' do
      inc(run);
  end;}
end;


function TpsvAARTF.GetEol: Boolean;
begin
  Result := fTokenID = tkNull;
end;

function TpsvAARTF.GetToken: string;
var
  Len: LongInt;
begin
  Len := Run - fTokenPos;
  SetString(Result, (FLine + fTokenPos), Len);
end;

function TpsvAARTF.GetTokenID: TtkTokenKind;
begin
  if not fAsmStart and (fRange = rsAsm)
    and not (fTokenId in [tkNull, tkComment, tkSpace])
  then
    Result := tkAsm
  else
    Result := fTokenId;
end;

function TpsvAARTF.GetTokenAttribute: integer;
begin
  case GetTokenID of
    tkAsm: Result := 9;
    tkComment: Result := 1;
    tkIdentifier: Result := 2;
    tkKey: Result := 3;
    tkNumber: Result := 4;
    tkSpace: Result := 5;
    tkString: Result := 6;
    tkSymbol: Result := 7;
    tkUnknown: Result := 8;
    tkRegister: result := 10;
  else
    Result := 9;
  end;
end;

function TpsvAARTF.GetTokenKind: integer;
begin
  Result := Ord(GetTokenID);
end;

function TpsvAARTF.GetTokenPos: Integer;
begin
  Result := fTokenPos;
end;

function TpsvAARTF.GetRange: Pointer;
begin
  Result := Pointer(fRange);
end;

procedure TpsvAARTF.SetRange(Value: Pointer);
begin
  fRange := TRangeState(Value);
end;

procedure TpsvAARTF.ResetRange;
begin
  fRange:= rsUnknown;
end;



procedure TpsvAARTF.PrepareToken(var AToken : string);
var St : string;
begin
  St := AToken;
  St := StringReplace(St,'\','\\',[rfReplaceAll]);
  St := StringReplace(St,'{','\{',[rfReplaceAll]);
  St := StringReplace(St,'}','\}',[rfReplaceAll]);
  AToken := St;
end;

function TpsvAARTF.PrepareOutput(Attr: integer; AToken : string): string;
begin
  case Attr of 
    1 : Result  := '\cf1 \i '+ AToken +'\i0 ';
    3 : Result  := '\cf3 \b '+ AToken +'\b0 ';
    10 : Result  := Format('\cf%d \b %s\b0 ',[Attr,AToken]);
  else
   Result := Format('\cf%d %s',[Attr,AToken]);
  end;
end;

procedure TpsvAARTF.SetupDefaultColors;
begin
  CreateColorTable([clRed,   //1  Comment
                    clRed,  //2  Identifier
                    clRed,  //3  Key
                    clRed,  //4  Number
                    clRed,   //5  Space
                    clRed,  //6  String
                    clRed,  //7  Symbol
                    clRed,  //8 Unknown
                    clRed, //9
                    clRed //10
                    ]);
end;

initialization
  MakeIdentTable;


end.