From 02daf30de2a91322ace155e96b127247d18cfb46 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Micha=C3=ABl=20Van=20Canneyt?= <michael@freepascal.org>
Date: Sun, 20 Feb 2022 12:44:17 +0100
Subject: [PATCH] * Extract IDs from selected HTML file and fill combobox

---
 components/pas2js/frmhtmltoform.lfm |   6 +-
 components/pas2js/frmhtmltoform.pas |  12 +++
 components/pas2js/idehtml2class.pas | 126 +++++++++++++++++++++++++++-
 3 files changed, 141 insertions(+), 3 deletions(-)

diff --git a/components/pas2js/frmhtmltoform.lfm b/components/pas2js/frmhtmltoform.lfm
index 28b0f7be47..177ba9ae42 100644
--- a/components/pas2js/frmhtmltoform.lfm
+++ b/components/pas2js/frmhtmltoform.lfm
@@ -29,9 +29,9 @@ object frmHTML2Form: TfrmHTML2Form
     Height = 434
     Top = 0
     Width = 633
-    ActivePage = TSCodeGen
+    ActivePage = TSHTML
     Align = alClient
-    TabIndex = 1
+    TabIndex = 0
     TabOrder = 1
     object TSHTML: TTabSheet
       Caption = 'HTML File'
@@ -56,6 +56,7 @@ object frmHTML2Form: TfrmHTML2Form
         Height = 27
         Top = 8
         Width = 434
+        DialogOptions = [ofFileMustExist, ofEnableSizing, ofViewDetail]
         FilterIndex = 0
         HideDirectories = False
         ButtonWidth = 23
@@ -63,6 +64,7 @@ object frmHTML2Form: TfrmHTML2Form
         Anchors = [akTop, akLeft, akRight]
         MaxLength = 0
         TabOrder = 0
+        OnEditingDone = FEHTMLFileEditingDone
       end
       object cbAddHTMLFile: TCheckBox
         AnchorSideTop.Control = FEHTMLFile
diff --git a/components/pas2js/frmhtmltoform.pas b/components/pas2js/frmhtmltoform.pas
index 7937430fe4..1793e9ca77 100644
--- a/components/pas2js/frmhtmltoform.pas
+++ b/components/pas2js/frmhtmltoform.pas
@@ -47,6 +47,7 @@ type
     TSCodeGen: TTabSheet;
     TSHTML: TTabSheet;
     procedure CBEventsChange(Sender: TObject);
+    procedure FEHTMLFileEditingDone(Sender: TObject);
     procedure FormCreate(Sender: TObject);
 
   private
@@ -134,6 +135,17 @@ begin
   CheckEventEdits;
 end;
 
+procedure TfrmHTML2Form.FEHTMLFileEditingDone(Sender: TObject);
+begin
+  if (FEHTMLFile.FileName<>'') and FileExists(FEHTMLFile.FileName) then
+    With THTMLExtractIDS.Create(Self) do
+      try
+        ExtractIDS(FEHTMLFile.FileName,cbBelowID.Items);
+      finally
+        Free;
+      end;
+end;
+
 procedure TfrmHTML2Form.CheckEventEdits;
 
 Var
diff --git a/components/pas2js/idehtml2class.pas b/components/pas2js/idehtml2class.pas
index 8706c06c71..428d5396a2 100644
--- a/components/pas2js/idehtml2class.pas
+++ b/components/pas2js/idehtml2class.pas
@@ -214,6 +214,28 @@ Type
     Property OnLog : TLogEvent Read FOnLog Write FOnLog;
   end;
 
+  { THTMLExtractIDS }
+
+  THTMLExtractIDS = Class(TComponent)
+  Private
+    FBelowID: String;
+    FLevel: Integer;
+    FList: TStrings;
+  Protected
+    procedure DoStartElement(Sender: TObject; const {%H-}NamespaceURI, LocalName,
+      {%H-}QName: SAXString; Atts: TSAXAttributes);  virtual;
+    procedure DoEndElement(Sender: TObject; const {%H-}NamespaceURI, {%H-}LocalName,
+      {%H-}QName: SAXString);  virtual;
+    Property List : TStrings Read FList;
+    Property Level : Integer Read FLevel Write FLevel;
+  Public
+    Procedure ExtractIDS(aInput : TStream; aList : TStrings);
+    Function ExtractIDS(aInput : TStream) : TStringArray;
+    Procedure ExtractIDS(Const aFileName : String; aList : TStrings);
+    function ExtractIDS(const aFileName: String): TStringArray;
+    Property BelowID : String Read FBelowID Write FBelowID;
+  end;
+
   { TFormCodeGen }
 
 
@@ -314,7 +336,109 @@ Type
 
 implementation
 
-uses TypInfo;
+uses TypInfo, bufstream;
+
+{ THTMLExtractIDS }
+
+procedure THTMLExtractIDS.DoStartElement(Sender: TObject; const NamespaceURI, LocalName, QName: SAXString; Atts: TSAXAttributes);
+
+Var
+  aID,aType : String;
+  El : TFormElement;
+
+begin
+  if Not Assigned(atts) then exit;
+  aID:=UTF8Encode(Atts.GetValue('','id'));
+  if (aID<>'') then
+    begin
+    if (Level=0) and (BelowID=aID) then
+      begin
+      Level:=1;
+      exit;
+      end
+    else if (BelowID<>'') and (Level<=0) then
+      Exit;
+    FList.Add(aID);
+    end;
+end;
+
+procedure THTMLExtractIDS.DoEndElement(Sender: TObject; const NamespaceURI, LocalName, QName: SAXString);
+begin
+  if Level>0 then
+    Dec(FLevel);
+end;
+
+procedure THTMLExtractIDS.ExtractIDS(aInput: TStream; aList: TStrings);
+var
+  MyReader : THTMLReader;
+
+begin
+  FList:=aList;
+  MyReader:=THTMLReader.Create;
+  Try
+    MyReader.OnStartElement:=@DoStartElement;
+    MyReader.OnEndElement:=@DoEndElement;
+    MyReader.ParseStream(aInput);
+  finally
+    FreeAndNil(MyReader);
+  end;
+
+end;
+
+function THTMLExtractIDS.ExtractIDS(aInput: TStream): TStringArray;
+
+Var
+  L : TStringList;
+  I : Integer;
+
+begin
+  L:=TStringList.Create;
+  try
+    ExtractIDS(aInput,L);
+    L.Sort;
+    Setlength(Result,L.Count);
+    For I:=0 to L.Count-1 do
+      Result[I]:=L[i];
+  finally
+    L.Free;
+  end;
+end;
+
+procedure THTMLExtractIDS.ExtractIDS(const aFileName: String; aList: TStrings);
+
+Var
+  F : TFileStream;
+  B : TBufStream;
+
+begin
+  F:=TFileStream.Create(aFileName,fmOpenRead or fmShareDenyWrite);
+  try
+    B:=TReadBufStream.Create(F,4096);
+    B.SourceOwner:=True;
+    ExtractIDS(B,aList);
+  finally
+    B.Free;
+  end;
+end;
+
+function THTMLExtractIDS.ExtractIDS(const aFileName : String): TStringArray;
+
+Var
+  L : TStringList;
+  I : Integer;
+
+begin
+  L:=TStringList.Create;
+  try
+    ExtractIDS(aFileName,L);
+    L.Sort;
+    Setlength(Result,L.Count);
+    For I:=0 to L.Count-1 do
+      Result[I]:=L[i];
+  finally
+    L.Free;
+  end;
+end;
 
 { ----------------------------------------------------------------------