mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-11 20:36:09 +02:00
* Extract IDs from selected HTML file and fill combobox
This commit is contained in:
parent
6feea8040b
commit
02daf30de2
@ -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
|
||||
|
@ -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
|
||||
|
@ -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;
|
||||
|
||||
{ ----------------------------------------------------------------------
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user