uwdelphiparser.pas

Delphi脚本控件

    procedure ParseFunctionEntry(aUnitEntry : TEntry; var aIndex : Integer);
    procedure ParseClassEntry(aClassEntry : TEntry; var aIndex : Integer);
    function LocatePairBracket(aIndex: Integer): Integer;
    function LocateEndOfRecordStatement(aIndex: Integer): Integer;
    function ReadExistingType(var aIndex: Integer) : String;
    function ReadPropertyProcName(var aIndex: Integer): String;
    procedure ParseTStorageSpecifiers(var aIndex: Integer;
                var aStorageSpecifiers: TStorageSpecifiers;
                var aDefaultValue: String);
    function LocateToken(aTokenName: String; aTokenType: TTokenType;
      aStartIndex: integer; aErrorCode: String): Integer;
    procedure ReadProcedureEntry(aProcedureEntry: TProcedureEntry;
      var aIndex: Integer; aIsFunction : boolean);
    { Translated to FWParser }
    function  IsToken(aIndex : Integer; aTokenType : TTokenType; aText : String) : boolean; overload;
    function  IsToken(aToken : TToken; aTokenType : TTokenType; aText : String) : boolean;  overload;
    function  FindToken(aTokenName : String; aTokenType : TTokenType; aStartIndex : integer = 0) : Integer;
    function  GetSourceString(aStartIndex, aEndIndex: Integer) : String; overload;
    function  GetSourceString(aStartBP, aEndBP: TWParserBreakpoint) : String; overload;
    procedure ReadSourceStringIfNotEmpty(var aText : String; aStartBP, aEndBP: TWParserBreakpoint);
    procedure EndOfDeclaration(aEntry : TEntry; aStartBP, aEndBP: TWParserBreakpoint);
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function  FindEntry(aName : String; aEntry : TEntry = nil) : TEntry; overload;
    function  FindEntry(aName : String; aEntryClass : TClass; aEntry : TEntry = nil) : TEntry; overload;
    property RootEntry : TEntry read FRootEntry;
    {:$ List of entries. Index should be in range from 0 to Count-1. }
    property Items[Index: Integer]: TEntry read GetEntry;
    {:$ Total count of entries in Items collection. Zero if an error occurred. }
    property Count : Integer read GetCount;
    {:$ List of errors found during parsing process. }
    property Errors : TStringList read FErrors;
  published
    { Published declarations }
    property Active : Boolean read GetActive write SetActive;
    property FileName : String read FFileName write FFileName;
    property Version : String read GetVersion write SetVersion;
    property CompilerVersion : TCompilerVersion read FCompilerVersion write FCompilerVersion;
    property Options : TWDelphiParserOptions read FOptions write FOptions;
    property MemberVisibility : TMemberVisibility read FMemberVisibility write FMemberVisibility;
    property CommentTags: TStringList read FCommentTags write SetCommentTags;
    property CommentSummaryTags: TStringList read FCommentSummaryTags write SetCommentSummaryTags;
    property CommentDescriptionTags: TStringList read FCommentDescriptionTags write SetCommentDescriptionTags;
    property CommentNewLineTags: TStringList read FCommentNewLineTags write SetCommentNewLineTags;

    { Events }
    property OnPackageEntry : TWDelphiParserOnEntryEvent read FOnPackageEntry write FOnPackageEntry;
    property OnUnitEntry : TWDelphiParserOnEntryEvent read FOnUnitEntry write FOnUnitEntry;
    property OnProcedureEntry : TWDelphiParserOnEntryEvent read FOnProcedureEntry write FOnProcedureEntry;
    property OnFunctionEntry : TWDelphiParserOnEntryEvent read FOnFunctionEntry write FOnFunctionEntry;
    property OnTypeEntry : TWDelphiParserOnEntryEvent read FOnTypeEntry write FOnTypeEntry;
    property OnRecordEntry : TWDelphiParserOnEntryEvent read FOnRecordEntry write FOnRecordEntry;
    property OnConstEntry : TWDelphiParserOnEntryEvent read FOnConstEntry write FOnConstEntry;
    property OnVarEntry : TWDelphiParserOnEntryEvent read FOnVarEntry write FOnVarEntry;
    property OnConstantEntry : TWDelphiParserOnEntryEvent read FOnConstantEntry write FOnConstantEntry;
    property OnUsesEntry : TWDelphiParserOnEntryEvent read FOnUsesEntry write FOnUsesEntry;
    property OnClassEntry : TWDelphiParserOnClassEntryEvent read FOnClassEntry write FOnClassEntry;
    property OnInterfaceEntry : TWDelphiParserOnInterfaceEntryEvent read FOnInterfaceEntry write FOnInterfaceEntry;
    property OnClassProcedureEntry : TWDelphiParserOnEntryEvent read FOnClassProcedureEntry write FOnClassProcedureEntry;
    property OnClassFunctionEntry : TWDelphiParserOnEntryEvent read FOnClassFunctionEntry write FOnClassFunctionEntry;
    property OnClassPropertyEntry : TWDelphiParserOnEntryEvent read FOnClassPropertyEntry write FOnClassPropertyEntry;
    property OnClassFieldEntry : TWDelphiParserOnEntryEvent read FOnClassFieldEntry write FOnClassFieldEntry;
//    property OnDispinterfaceEntry : TWDelphiParserOnEntryEvent read FOnDispinterfaceEntry write FOnDispinterfaceEntry; //AB
    property OnDispinterfaceEntry : TWDelphiParserOnInterfaceEntryEvent read FOnDispinterfaceEntry write FOnDispinterfaceEntry; //AB
    property OnProgress : TWDelphiParserProgressEvent read FOnProgress write FOnProgress;

//AB
    property OnEnumType : TWDelphiParserOnEnumTypeEvent read FOnEnumType write FOnEnumType;
    property OnUsedUnit : TWDelphiParserFileEntryEvent read FOnUsedUnit write FOnUsedUnit;
    property OnEndOfUsesClause: TWDelphiParserProgressEvent read FOnEndOfUsesClause write FOnEndOfUsesClause;
    property OnEndOfClassDef: TWDelphiParserProgressEvent read FOnEndOfClassDef write FOnEndOfClassDef;
    property OnEndOfInterfaceDef: TWDelphiParserProgressEvent read FOnEndOfInterfaceDef write FOnEndOfInterfaceDef;

    property AfterUnitEntry : TWDelphiParserFileEntryEvent read FAfterUnitEntry write FAfterUnitEntry;
    property AfterPackageEntry : TWDelphiParserFileEntryEvent read FAfterPackageEntry write FAfterPackageEntry;
    property BeforeUnitEntry : TWDelphiParserFileEntryEvent read FBeforeUnitEntry write FBeforeUnitEntry;
    property BeforePackageEntry : TWDelphiParserFileEntryEvent read FBeforePackageEntry write FBeforePackageEntry;

    property BeforeOpen : TNotifyEvent read FBeforeOpen write FBeforeOpen;
    property BeforeClose : TNotifyEvent read FBeforeClose write FBeforeClose;
    property AfterOpen : TNotifyEvent read FAfterOpen write FAfterOpen;
    property AfterClose : TNotifyEvent read FAfterClose write FAfterClose;

    { Methods }
    procedure Reset;
    function Analyze : boolean;
    procedure ParsePackage;
    procedure ParseUnit(aFileName : String; aPackageEntry : TPackageEntry; aTitle : String; aBriefDescription : String = '');
    procedure SearchForEvents;
  end;

{$R uWDelphiParser.RES}

  {:$ Returns Delphi Source Path and Browse Path taken from the registry for
   :$ particular compiler version. }
  function GetDelphiLibraryPath(aCompilerVersion: TCompilerVersion): String;

  function StrToVisibilityArea(aVisibilityArea : String) : TVisibilityArea; overload;
  function StrToVisibilityArea(aIndex : Integer) : TVisibilityArea; overload;

  function VisibilityAreaToStr(aVisibilityArea : TVisibilityArea) : String;
  function EncodeMemberVisibility(aIsPublished, aIsPublic,
    aIsProtected, aIsPrivate : boolean) : TMemberVisibility;

implementation

function StrToVisibilityArea(aIndex : Integer) : TVisibilityArea;
begin

end;


function GetDelphiLibraryPath(aCompilerVersion : TCompilerVersion) : String;
var
  sVersionNumber, sDelphiPath: String;
  slstValues : TStringList;
  i : Integer;
begin
  Result := '';
  case aCompilerVersion of
    verDelphi6 : sVersionNumber := '6';
    verDelphi5 : sVersionNumber := '5';
    verDelphi4 : sVersionNumber := '4';
    verDelphi3 : sVersionNumber := '3';
    verDelphi2 : sVersionNumber := '2';
    verDelphi1 : sVersionNumber := '1';
  end;
  sDelphiPath := '';
  slstValues := TStringList.Create;
  try
    with TRegistry.Create do
    try
      if OpenKey('Software\Borland\Locales', False) then begin
        GetValueNames(slstValues);
        CloseKey;
      end;
      with slstValues do
        if Count > 0 then
          for i := 0 to Count - 1 do
            if (Pos('Delphi32.exe', Strings[i]) >= 0) and
               (Pos('Delphi' + sVersionNumber, Strings[i]) >= 0)
            then begin
              sDelphiPath := ExtractFilePath(Strings[i]);
              Break;
            end;

      if (sDelphiPath <> '') and
         OpenKey('Software\Borland\Delphi\' + sVersionNumber + '.0\Library', False)
      then begin
        if ValueExists('Browsing Path') then
          Result := Result + ReadString('Browsing Path');
        if ValueExists('Search Path') then begin
          if Result <> '' then Result := Result + ';';
          Result := Result + ReadString('Search Path');
        end;
        CloseKey;
        Result := StringReplace(Result, '$(DELPHI)\', sDelphiPath, [rfReplaceAll]);
      end;
    finally
      Free;
    end;
  finally
    slstValues.Free;
  end;
end;

function WParserBreakpoint(aIndex : Integer; aParser : TWParser) : TWParserBreakpoint;
begin
  Result.Index := aIndex;
  Result.Parser := aParser;
end;

function EncodeMemberVisibility(aIsPublished, aIsPublic,
  aIsProtected, aIsPrivate : boolean) : TMemberVisibility;
begin
  Result := [];
  if aIsPublished then Result := Result + [vaPublished];
  if aIsPublic then Result := Result + [vaPublic];
  if aIsProtected then Result := Result + [vaProtected];
  if aIsPrivate then Result := Result + [vaPrivate];
end;

function StrToVisibilityArea(aVisibilityArea : String) : TVisibilityArea;
begin
  if CompareText(aVisibilityArea, 'Private') = 0 then
    Result := vaPrivate
  else
  if CompareText(aVisibilityArea, 'Protected') = 0 then
    Result := vaProtected
  else
  if CompareText(aVisibilityArea, 'Public') = 0 then
    Result := vaPublic
  else
  if CompareText(aVisibilityArea, 'Published') = 0 then
    Result := vaPublished
  else
    Result := vaPublic;
end;

function VisibilityAreaToStr(aVisibilityArea : TVisibilityArea) : String;
begin
  case aVisibilityArea of
    vaPrivate   : Result := 'Private';
    vaProtected : Result := 'Protected';
    vaPublic    : Result := 'Public';
    vaPublished : Result := 'Published';
  end;
end;

{ TEntry }

constructor TEntry.Create(aName : String; aParent : TEntry;
      aWDelphiParser : TComponent);
begin
  inherited Create;
  Name := FirstCapitalLetter(aName);
  FWDelphiParser := aWDelphiParser;
  Parent := aParent;
  if Assigned(Parent) and (Parent is TEntry) then TEntry(Parent).Add(Self);
  HintDirectives := [];
end;

destructor TEntry.Destroy;
var
  E : TEntry;
begin
  while Count > 0 do begin
    E := Items[0];
    Delete(0);
    if Assigned(E) then E.Free;
  end;
  {Remove itself from the parent list of owned entries}
  if Assigned(Parent) and (Parent is TEntry) then TEntry(Parent).Remove(Self);
  {Remove itself from the parser Items list. }
  if Assigned(FWDelphiParser) then
    with FWDelphiParser as TWDelphiParser do begin
      if Self = FRootEntry then
        FRootEntry := nil;
      FItems.Remove(Self);
    end;
  inherited;
end;

{ TFileEntry }

constructor TFileEntry.Create;
begin
  inherited;
  FFileName := '';
  FFileStream := nil;
end;

destructor TFileEntry.Destroy;
begin
  if Assigned(FFileStream) then FFileStream.Free;
  inherited;
end;

procedure TFileEntry.SetFileName(const Value: String);
begin
  if FFileName <> Value then begin
    if Assigned(FFileStream) then FFileStream.Free;
    FFileName := Value;
    if Value <> '' then
      FFileStream := TFileStream.Create(FFileName, fmOpenRead)
    else
      FFileStream := nil;
  end;
end;

{ TUnitEntry }

procedure TUnitEntry.SetFileName(const Value: String);
var
  S : String;
begin
  S := Value;
  if (ExtractFilePath(S) = '') and Assigned(Parent) and (Parent is TPackageEntry) then
    S := ExtractFilePath((Parent as TPackageEntry).FileName) + S;
  inherited SetFileName(S);
end;

{ TClassEntry }

constructor TClassEntry.Create;
begin
  inherited;
  Parents := TStringList.Create;
end;

destructor TClassEntry.Destroy;
begin
  Parents.Free;
  inherited;
end;

{ TWDelphiParser }

constructor TWDelphiParser.Create(AOwner: TComponent);
var
  i : Integer;
begin
  inherited;
  FFileName := '';
  //FTreeView := nil;
  FRootEntry := nil;
  FStopAnalyze := False;
  //FWParser := TWParser.Create(Self);
  FWParser := nil;
  FErrors := TStringList.Create;
  FItems := TList.Create;
  FCommentTags := TStringList.Create;
  FCommentTags.Add('*');
  FCommentTags.Add(':');
  FCommentSummaryTags := TStringList.Create;
  FCommentSummaryTags.Add('@summary');
  FCommentSummaryTags.Add('$');

  FCommentDescriptionTags := TStringList.Create;
  FCommentDescriptionTags.Add('@desc');
  FCommentDescriptionTags.Add(':');

  FCommentNewLineTags := TStringList.Create;
  FCommentNewLineTags.Add('/n');
  FCommentNewLineTags.Add('<br>');

  FWParserStack := TWParserStack.Create;
  FCompilerVersion := verDelphi6;
  FOptions := [poAcceptComments, poAcceptCommentLine, poAcceptComment1Block, poAcceptComment2Block];
  FMemberVisibility := [vaPrivate, vaProtected, vaPublic, vaPublished];
end;

destructor TWDelphiParser.Destroy;
begin
  FWParserStack.Clear(FWParser);
  FreeAndNil(FWParserStack);
  FreeAndNil(FErrors);
  FreeAndNil(FWParser);
  FreeAndNil(FCommentTags);
  FreeAndNil(FCommentSummaryTags);
  FreeAndNil(FCommentDescriptionTags);
  FreeAndNil(FCommentNewLineTags);
  FreeAndNil(FItems);
  inherited;
end;

procedure TWDelphiParser.InitWParser(aCompilerVersion: TCompilerVersion; aWParser : TWParser);
begin