uwdelphiparser.pas

Delphi脚本控件

  with aWParser do begin
    AdditionalChars := '_';
    AllowFigures := True;
    AllowIdentifier := True;
    Comment1Begin := '{';
    Comment1End := '}';
    Comment2Begin := '(*';
    Comment2End := '*)';
    CommentLine := '//';
    SpecialChars := '(),-.:;=[]';
    KeywordsCaseSensitive := False;
    OnTokenRead := WParserTokenReadUnit;
  end;
  LoadKeywords(aCompilerVersion, aWParser);
  FSearchPath := GetDelphiLibraryPath(FCompilerVersion);
end;

procedure TWDelphiParser.LoadKeywords(aCompilerVersion : TCompilerVersion; aWParser : TWParser);
var
  i : Integer;
begin
  with aWParser.Keywords do begin
    Clear;
    for i := Low(sDelphiKeywords) to High(sDelphiKeywords) do
      Add(sDelphiKeywords[i]);
    if aCompilerVersion = verDelphi6 then
      for i := Low(sDelphi60Keywords) to High(sDelphi60Keywords) do
        Add(sDelphi60Keywords[i]);

  end;
end;

procedure TWDelphiParser.LoadDefaultSymbols(aCompilerVersion : TCompilerVersion);
begin
  case CompilerVersion of
    verDelphi1 : AddDefaultDelphiSymbols(sDelphi10DefaultSymbols);
    verDelphi2 : AddDefaultDelphiSymbols(sDelphi20DefaultSymbols);
    verDelphi3 : AddDefaultDelphiSymbols(sDelphi30DefaultSymbols);
    verDelphi4 : AddDefaultDelphiSymbols(sDelphi40DefaultSymbols);
    verDelphi5 : AddDefaultDelphiSymbols(sDelphi50DefaultSymbols);
    verDelphi6 : AddDefaultDelphiSymbols(sDelphi60DefaultSymbols);
  end;
end;

procedure TWDelphiParser.Initialize;
begin
  InitWParser(FCompilerVersion, FWParser);
end;

function TWDelphiParser.GetVersion: String;
begin
  Result := sVersion;
end;

procedure TWDelphiParser.SetActive(const Value: Boolean);
begin
  if Value then begin
    if Assigned(FBeforeOpen) then FBeforeOpen(Self);

    if not Assigned(FRootEntry) then begin
      if (Trim(FileName) <> '') then
        Analyze
      else
        if not (csDesigning in ComponentState) then
          raise Exception.Create('Property ' + Self.ClassName + '.FileName is not assigned.');
    end;
    if Assigned(FAfterOpen) then FAfterOpen(Self);
  end
  else begin
    if Assigned(FBeforeClose) then FBeforeClose(Self);
    if Assigned(FRootEntry) then Reset;
    if Assigned(FAfterClose) then FAfterClose(Self);
  end;
end;

procedure TWDelphiParser.SetVersion(const Value: String);
begin
  {Dummy};
end;

procedure TWDelphiParser.Reset;
begin
  FreeAndNil(FRootEntry);
  FStopAnalyze := False;
  FErrors.Clear;
  FItems.Clear;
end;

function TWDelphiParser.Analyze : boolean;
begin
  Result := False;
  if Trim(FFileName) = '' then Exit;
  try
    try
      FWParser := TWParser.Create(Self);
      Reset;
      Initialize;
      if CompareText(ExtractFileExt(FileName), '.pas') = 0 then
        ParseUnit(FileName, nil, '')
      else
      if CompareText(ExtractFileExt(FileName), '.dpk') = 0 then
        ParsePackage;
      SearchForEvents;
    except
      on E : Exception do begin
        FErrors.Add(E.Message);
        FreeAndNil(FRootEntry);
        FWParserStack.Clear(FWParser);
      end;
    end;
  finally
    Result := FErrors.Count = 0;
    FreeAndNil(FWParser);
  end;
end;

procedure TWDelphiParser.CheckForPlatformDirective(var aIndex : Integer; aEntry : TEntry);
begin
  if not (FCompilerVersion in [verDelphi1, verDelphi2, verDelphi3, verDelphi4, verDelphi5]) then Exit;
  if IsToken(aIndex, ttKeyword, 'platform') then begin
    with aEntry do HintDirectives := HintDirectives + [hdPlatform];
    StepNextToken(aIndex);
  end;
end;

procedure TWDelphiParser.ParsePackage;
var
  FUnitFiles : TStringList;
  i, j  : Integer;
  S, sUnitFileName : String;
  PackageEntry : TPackageEntry;
  bAddEntry, FStopAnalyze : boolean;
begin
  try
    try
      PackageEntry := TPackageEntry.Create('', nil, Self);
      PackageEntry.FileName := Self.FileName;
      if FRootEntry = nil then begin
        FRootEntry := PackageEntry;
        LoadDefaultSymbols(FCompilerVersion);
      end;

      FUnitFiles := TStringList.Create;

      if Assigned(FBeforePackageEntry) then BeforePackageEntry(FileName);
      FFileName := PackageEntry.FileName;
      FWParser.Analyze(PackageEntry.FileStream);
      i := -1;
      StepNextToken(i);
      ExpectToken(i, ttIdentifier, 'package', 'E5260CFD');
      LookBackwardForDescription(i, PackageEntry.Summary, PackageEntry.Description);
      StepNextToken(i);
      PackageEntry.Name := Token[i].Text;
      { package <Name> }
      StepNextToken(i);
      CheckForPlatformDirective(i, PackageEntry);
      ExpectToken(i, ttSpecialChar, ';', '99BDF834');
      StepNextToken(i);
      { package Name; <...>}

      if IsToken(i, ttIdentifier, 'requires') then begin
        i := FindToken(';', ttSpecialChar, i);
        if i < 0 then
          raise Exception.Create('Error 807013F4: Unable to locate the end of REQUIRES section.');
        StepNextToken(i);
      end;

      ExpectToken(i, ttIdentifier, 'contains', 'CF42CC05');

      {i := FindToken('contains', ttIdentifier);
      if i > 0 then}
      {begin}

        LookBackwardForDescription(i, PackageEntry.Summary, PackageEntry.Description);

        bAddEntry := True;
        if Assigned(FOnPackageEntry) then
          OnPackageEntry(PackageEntry, bAddEntry);
        if Assigned(FOnProgress) then
          OnProgress(FStopAnalyze);  if FStopAnalyze then Abort;

        if bAddEntry then begin

          FItems.Add(PackageEntry);

          while Token[i].Token <> ttEof do begin
            if IsToken(i, ttKeyword, 'in') and (Token[i-1].Token = ttIdentifier) and
               (Token[i+1].Token = ttString)
            then begin
              j := FUnitFiles.Add(Token[i-1].Text + '=' + Token[i+1].Text);
              if (i < (FWParser.Count - 3)) and (Token[i+2].Token = ttSpecialChar) and
                 (Token[i+3].Token = ttComment) and (Pos('$', Token[i+3].Text) <> 1)
              then FUnitFiles.Objects[j] := TObject(NewStr(Token[i+3].Text));
            end;
            Inc(i);
          end;

          with FUnitFiles do
            if Count > 0 then begin
              if Assigned(FOnProgress) then
                OnProgress(FStopAnalyze);  if FStopAnalyze then Abort;
              for i := 0 to Count - 1 do begin
                if Objects[i] <> nil then begin
                  S := PString(Objects[i])^;
                  DisposeStr(PString(Objects[i]));
                end
                else S := '';
                try
                  sUnitFileName := Values[Names[i]];
                  if Pos(':', sUnitFileName) = 0 then
                    sUnitFileName := ExtractFilePath(PackageEntry.FileName) + sUnitFileName;
                  ParseUnit(sUnitFileName, PackageEntry, Names[i], S);
                except
                  on E : Exception do begin
                    if E is EAbort then Abort;
                    FErrors.Add(E.Message);
                  end;
                end;
                if Assigned(FOnProgress) then
                  OnProgress(FStopAnalyze);  if FStopAnalyze then Abort;
                Application.ProcessMessages;
              end;
            end;
        end
        else
          Abort;
    except
      if FRootEntry = PackageEntry then FRootEntry := nil;
      PackageEntry.Free;
      raise;
    end;
  finally
    FUnitFiles.Free;
    if Assigned(FAfterPackageEntry) then AfterPackageEntry(FileName);
  end;
end;

procedure TWDelphiParser.ParseUnit(
  aFileName : String; aPackageEntry : TPackageEntry; aTitle : String;
  aBriefDescription : String = '');
var
  i : Integer;
  UnitEntry : TUnitEntry;
  bAddEntry : boolean;
begin
  //with FWParser do
  try
    try
      UnitEntry := TUnitEntry.Create(aTitle, aPackageEntry, Self);
      UnitEntry.FileName := aFileName;

      if Assigned(FBeforeUnitEntry) then BeforeUnitEntry(aFileName);

      FFileName := UnitEntry.FileName;
      FWParser.Analyze(UnitEntry.FileStream);

      if FRootEntry = nil then begin
        FRootEntry := UnitEntry;
        LoadDefaultSymbols(FCompilerVersion);
      end;

      i := -1;
      StepNextToken(i);
      ExpectToken(i, ttKeyword, 'unit', '196825D1');
      {Read the unit comments above Unit keyword}
      LookBackwardForDescription(i, UnitEntry.Summary, UnitEntry.Description);
      StepNextToken(i);
      if UnitEntry.Name = '' then UnitEntry.Name := Token[i].Text;
      StepNextToken(i);
      CheckForPlatformDirective(i, UnitEntry);

      // ab
      if UpperCase(Token[i].Text) = 'PLATFORM' then
        StepNextToken(i);
  
      ExpectToken(i, ttSpecialChar, ';', 'F13FED4E');
      StepNextToken(i);
      ExpectToken(i, ttKeyword, 'interface', 'EDCF3556');

      {Read the unit comments between Unit and Interface keywords}
      LookBackwardForDescription(i, UnitEntry.Description, UnitEntry.Summary);

      bAddEntry := True;
      if Assigned(FOnUnitEntry) then
        OnUnitEntry(UnitEntry, bAddEntry);
      if Assigned(FOnProgress) then
        OnProgress(FStopAnalyze);  if FStopAnalyze then Abort;
      if bAddEntry then begin

        FItems.Add(UnitEntry);

        repeat
          while (i < (FWParser.Count - 2)) do begin
            if IsToken(i, ttKeyword, 'uses') then begin
              StepNextToken(i);
              ParseUsesStatement(UnitEntry, i);
            end
            else
            if IsToken(i, ttKeyword, 'const') then begin
              StepNextToken(i);
              ParseConstStatement(UnitEntry, i);
            end
            else
            if IsToken(i, ttKeyword, 'var') then begin
              StepNextToken(i);
              ParseVarStatement(UnitEntry, i);
            end
            else
            if IsToken(i, ttKeyword, 'type') then begin
              StepNextToken(i);
              ParseTypeStatement(UnitEntry, i);
            end
            else
            if IsToken(i, ttKeyword, 'procedure') then
              ParseProcedureEntry(UnitEntry, i)
            else
            if IsToken(i, ttKeyword, 'function') then
              ParseFunctionEntry(UnitEntry, i)
            else
              StepNextToken(i);
          end;

          { Check if any items in stack. }
          if FWParserStack.Count > 0 then
            FWParserStack.Pop(FWParser, i, FFileName)
          else
            Break;

        until False;

      end
      else begin
        if FRootEntry = UnitEntry then FRootEntry := nil;
        UnitEntry.Free;
      end;
    except
      if FRootEntry = UnitEntry then FRootEntry := nil;
      UnitEntry.Free;
      raise
    end;
  finally
    //FWParser.OnTokenRead := nil;
    if Assigned(FAfterUnitEntry) then AfterUnitEntry(aFileName);
  end;
end;

procedure TWDelphiParser.SearchForEvents;
var
  i, j : Integer;
begin