uwdelphiparser.pas

Delphi脚本控件

{******************************************************************************}
{                                                                              }
{               (W) Component Library                                          }
{               Borland Delphi Interface Section Parser                        }
{               Copyright (C) 2000-2002 Yuriy Shcherbakov                      }
{               All rights reserved.                                           }
{******************************************************************************}

unit uWDelphiParser;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  uWStringFunctions, uWParser, Registry;

const
  sVersion : String = '1.0';

const
  sDelphi60DefaultSymbols : array [0..2] of String = ('MSWINDOWS', 'WIN32', 'VER140');
  sDelphi50DefaultSymbols : array [0..1] of String = ('WIN32', 'VER130');
  sDelphi40DefaultSymbols : array [0..1] of String = ('WIN32', 'VER120');
  sDelphi30DefaultSymbols : array [0..1] of String = ('WIN32', 'VER100');
  sDelphi20DefaultSymbols : array [0..1] of String = ('WIN32', 'VER90');
  sDelphi10DefaultSymbols : array [0..1] of String = ('WIN16', 'VER80');

const
  sDelphiKeywords : array [1..90] of String = (
    'abstract','and','array','as','asm','at','automated','begin','case','cdecl',
    'class','const','constructor','default','destructor','dispinterface','div',
    'do','downto','dynamic','else','end','except','exports','file','finalization',
    'finally','for','function','goto','if','implementation','implements','in',
    'inherited','initialization','inline','interface','is','label','library',
    'message','mod','nil','nodefault','not','object','of','on','or','out',
    'overload','override','packed','pascal','private','procedure','program',
    'property','protected','public','published','raise','read','record','register',
    'reintroduce','repeat','resourcestring','safecall','set','shl','shr','stdcall',
    'stored','string','then','threadvar','to','try','type','unit','until','uses',
    'var','virtual','while','with','write','xor');

  sDelphi60Keywords : array [1..2] of String = (
    'platform', 'deprecated');

type
  TCompilerVersion = (verDelphi6, verDelphi5, verDelphi4, verDelphi3, verDelphi2, verDelphi1);
  TWDelphiParserOption = (poAcceptComments, poAcceptCommentLine, poAcceptComment1Block, poAcceptComment2Block);
  TWDelphiParserOptions = set of TWDelphiParserOption;

type
  TVisibilityArea = (vaPrivate, vaProtected, vaPublic, vaPublished);
  TMemberVisibility = set of TVisibilityArea;
  TRoutineDirective = (rdOverride, rdOverload, rdreintroduce, rdVirtual,
                       rdMessageHandler, rdDynamic, rdAbstract,
                       rdRegister, rdPascal, rdCdecl, rdStdcall, rdSafecall);
  TRoutineDirectives = set of TRoutineDirective;
  TStorageSpecifier = (ssDefault, ssNoDefault, ssStored, ssNotStored);
  TStorageSpecifiers = set of TStorageSpecifier;

type
  THintDirective = (hdPlatform, hdDeprecated);
  THintDirectives = set of THintDirective;

type
  { TEntry }
  TEntry = class(TList)
    FWDelphiParser : TComponent;
    Parent : TEntry;
    ID : Integer;
    Name : String;
    Summary, Description : String;
    HintDirectives : THintDirectives;
    constructor Create(aName : String; aParent : TEntry;
      aWDelphiParser : TComponent); virtual;
    destructor Destroy; override;
  end;

  { TSymbolEntry }
  TSymbolEntry = class(TEntry)
    Value : String;
  end;

  { TFileEntry }
  TFileEntry = class(TEntry)
    FFileName : String;
    FFileStream : TFileStream;
    constructor Create(aName : String; aParent : TEntry;
      aWDelphiParser : TComponent); virtual;
    destructor Destroy; override;
  private
    procedure SetFileName(const Value: String); virtual;
  public
    property FileStream : TFileStream read FFileStream write FFileStream;
    property FileName : String read FFileName write SetFileName;
  end;

  { TPackageEntry }
  TPackageEntry = class(TFileEntry)
  end;

  { TUnitEntry }
  TUnitEntry = class(TFileEntry)
    procedure SetFileName(const Value: String); override;
  end;

  { TUsesEntry }
  TUsesEntry = class(TFileEntry)
  end;

  { TPasEntry }
  TPasEntry = class(TEntry)
    Declaration : String;
  end;

  { TProcedureEntry }
  TProcedureEntry = class(TPasEntry)
    RoutineDirectives : TRoutineDirectives;
    MessageHandler : String;
  end;

  { TFunctionEntry }
  TFunctionEntry = class(TProcedureEntry)
    ResultType : String;
  end;

  { TVarEntry }
  TVariableEntry = class(TPasEntry)
    TypeName : String;
    Value : String;
  end;

  { TConstantEntry }
  TConstantEntry = class(TVariableEntry)
  end;

  { TStructuredTypeEntry }
  TStructuredTypeEntry = class(TPasEntry)
    IsPacked : boolean;
  end;

  { TTypeEntry }
  TTypeEntry = class(TStructuredTypeEntry)
    ExistingType : String;
  end;

  { TRecordEntry }
  TRecordEntry = class(TStructuredTypeEntry)
  end;

  { TClassEntry }
  TClassEntry = class(TStructuredTypeEntry)
    Parents : TStringList;
    BriefDeclaration : String;
    IsMetaClass : boolean;
    constructor Create(aName : String; aParent : TEntry;
      aWDelphiParser : TComponent); virtual;
    destructor Destroy; override;
  end;

  { TInterfaceEntry }
  TInterfaceEntry = class(TClassEntry)
    GUID : String;
  end;

  { TDispInterfaceEntry }
  TDispInterfaceEntry = class(TInterfaceEntry)
  end;

  { TClassMemberEntry }
  TClassMemberEntry = class(TPasEntry)
    VisibilityArea : TVisibilityArea;
  end;

  { TClassProcedureEntry }
  TClassProcedureEntry = class(TClassMemberEntry)
    IsClassMethod : boolean;
    RoutineDirectives : TRoutineDirectives;
    MessageHandler : String;
    ParentObjectName : String;
    ParentMethodName : String;
  end;

  { TClassFunctionEntry }
  TClassFunctionEntry = class(TClassProcedureEntry)
    ResultType : String;
  end;

  { TClassVarEntry }
  TClassVarEntry = class(TClassMemberEntry)
    TypeName : String;
  end;

  { TClassPropertyEntry }
  TClassPropertyEntry = class(TClassVarEntry)
    IsEvent : boolean;
    PropertyIndex : String;
    PropertyReadProcName : String;
    PropertyWriteProcName : String;
    PropertyDefValue : String;
    ArrayIsDefaultProperty : boolean;
    StorageSpecifiers : TStorageSpecifiers;
    Implements : String;
  end;

type
  TWDelphiParserOnEntryEvent = procedure (aEntry : TEntry; aAddEntry : boolean) of object;
  TWDelphiParserFileEntryEvent = procedure (aFileName : String) of object;
  TWDelphiParserProgressEvent = procedure (var aStopAnalyze : boolean) of object;

//ab
  TWDelphiParserOnClassEntryEvent = procedure (aEntry : TEntry;
      aAddEntry, IsForward : boolean) of object;
  TWDelphiParserOnInterfaceEntryEvent = procedure (aEntry : TEntry;
      aAddEntry, IsForward : boolean) of object;
  TWDelphiParserOnEnumTypeEvent = procedure (const TypeName: String) of object;

{ TWParserStackItem }

type
  TWParserStackItem = class
    FWParser : TWParser;
    FIndex : Integer;
    FFileName : String;
    constructor Create(aWParser: TWParser; aIndex: Integer; aFileName : String); virtual;
    destructor Destroy; override;
  end;

{ TWParserStack }

type
  TWParserStack = class(TList)
    function GetItem(Index: Integer): TWParserStackItem;
    procedure Push(aWParser : TWParser; aIndex : Integer; aFileName : String);
    procedure Pop(var aWParser : TWParser; var aIndex : Integer; var aFileName : String);
    procedure Clear(var aWParser: TWParser);
    property Items[Index: Integer] : TWParserStackItem read GetItem;
  end;

{ Breakpoint structure to save }
type
  TWParserBreakPoint = record
    Index : Integer;
    Parser : TWParser;
  end;

{ TWDelphiParser }

type
  TWDelphiParser = class(TComponent)
  private
    procedure SetActive(const Value: Boolean);
    function GetVersion: String;
    procedure SetVersion(const Value: String);
    function GetCount: Integer;
    function GetEntry(Index: Integer): TEntry;
    function GetActive: Boolean;
    procedure Initialize;
    procedure LoadDefaultSymbols(aCompilerVersion: TCompilerVersion);
    procedure LoadKeywords(aCompilerVersion: TCompilerVersion; aWParser : TWParser);
    procedure CheckForPlatformDirective(var aIndex: Integer;
      aEntry: TEntry);
    procedure IncludeFile(aFileName: String; var aIndex : Integer);
    procedure InitWParser(aCompilerVersion: TCompilerVersion; aWParser : TWParser);
    function GetToken(Index: Integer): TToken;
    procedure SetCommentDescriptionTags(const Value: TStringList);
    procedure SetCommentSummaryTags(const Value: TStringList);
    procedure SetCommentTags(const Value: TStringList);
    function AcceptComment(var aText: String): boolean;
    function IsCommentTag(var aText: String; aTags: TStringList): boolean;
    procedure AddComment(aText: String; var aComment: String; aAddBefore : boolean);
    procedure SetCommentNewLineTags(const Value: TStringList);
    function IsCommentNewLineTag(var aText: String): boolean;
    { Private declarations }
  protected
    { Protected declarations }
    FFileName : String;
    FWParser : TWParser;              // Points to the current WParser
    FWParserStack : TWParserStack;    // Stack of WParser objects. Used to parse included files.

    FItems : TList;
    FRootEntry : TEntry;
    FStopAnalyze : boolean;
    FErrors : TStringList;
    FCommentTags: TStringList;
    FCommentSummaryTags: TStringList;
    FCommentDescriptionTags: TStringList;
    FCommentNewLineTags: TStringList;

    FCompilerVersion : TCompilerVersion;
    FSearchPath : String;
    FOptions : TWDelphiParserOptions;
    FMemberVisibility : TMemberVisibility;

    FOnPackageEntry : TWDelphiParserOnEntryEvent;
    FOnUnitEntry : TWDelphiParserOnEntryEvent;
    FOnProcedureEntry : TWDelphiParserOnEntryEvent;
    FOnFunctionEntry : TWDelphiParserOnEntryEvent;
    FOnTypeEntry : TWDelphiParserOnEntryEvent;
    FOnRecordEntry : TWDelphiParserOnEntryEvent;
    FOnConstEntry : TWDelphiParserOnEntryEvent;
    FOnVarEntry : TWDelphiParserOnEntryEvent;
    FOnConstantEntry : TWDelphiParserOnEntryEvent;
    FOnUsesEntry : TWDelphiParserOnEntryEvent;
    FOnClassEntry : TWDelphiParserOnClassEntryEvent;
    FOnInterfaceEntry : TWDelphiParserOnInterfaceEntryEvent;
    FOnClassProcedureEntry : TWDelphiParserOnEntryEvent;
    FOnClassFunctionEntry : TWDelphiParserOnEntryEvent;
    FOnClassPropertyEntry : TWDelphiParserOnEntryEvent;
    FOnClassFieldEntry : TWDelphiParserOnEntryEvent;
//    FOnDispinterfaceEntry : TWDelphiParserOnEntryEvent;        //AB
    FOnDispinterfaceEntry : TWDelphiParserOnInterfaceEntryEvent; //AB
    FOnProgress : TWDelphiParserProgressEvent;

    FonEnumType : TWDelphiParserOnEnumTypeEvent; //AB
    FonUsedUnit: TWDelphiParserFileEntryEvent; //AB
    FonEndOfUsesClause: TWDelphiParserProgressEvent; //AB
    FonEndOfClassDef: TWDelphiParserProgressEvent; //AB
    FonEndOfInterfaceDef: TWDelphiParserProgressEvent; //AB

    FAfterUnitEntry : TWDelphiParserFileEntryEvent;
    FAfterPackageEntry : TWDelphiParserFileEntryEvent;
    FBeforeUnitEntry : TWDelphiParserFileEntryEvent;
    FBeforePackageEntry : TWDelphiParserFileEntryEvent;

    FBeforeOpen : TNotifyEvent;
    FBeforeClose : TNotifyEvent;
    FAfterOpen : TNotifyEvent;
    FAfterClose : TNotifyEvent;
    property Token[Index: Integer] : TToken read GetToken; // Array with found token. Translated to FWParser.Token[...]
    procedure AddDefaultDelphiSymbols(aSybmols : array of string);
    function AddSymbolEntry(aName, aValue: String): TSymbolEntry; 
    function FindSymbolEntry(aName: String): TSymbolEntry;
    procedure StepNextToken(var aIndex: Integer);
    procedure ExpectToken(aIndex : Integer; aTokenType : TTokenType; aText : String; aErrorCode : String = '');
    procedure ExpectTokenBooleanValue(aIndex : Integer);
    procedure LookBackwardForDescription(aIndex : Integer;
      var aSummary : String; var aDescription : String);
    procedure LookForwardForDescription(aIndex : Integer;
      var aSummary : String; var aDescription : String);
    procedure WParserTokenReadUnit(Sender: TObject; Token: TToken;
      var AddToList, Stop: Boolean);
    procedure ParseRoutineDirectives(var aIndex: Integer;
      var aRoutineDirectives: TRoutineDirectives; var aMessageHandler : String;
      var aHintDirectives: THintDirectives);
    procedure ParseUsesStatement(aUnitEntry : TEntry; var aIndex : Integer);
    procedure ParseConstStatement(aUnitEntry : TEntry; var aIndex : Integer);
    procedure ParseVarStatement(aUnitEntry : TEntry; var aIndex : Integer);
    procedure ParseTypeStatement(aUnitEntry : TEntry; var aIndex : Integer);
    procedure ParseDispinterface(aDispInterfaceEntry : TDispInterfaceEntry; var aIndex : Integer);
    procedure ParseProcedureEntry(aUnitEntry : TEntry; var aIndex : Integer);