mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-18 17:19:23 +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
|
Height = 434
|
||||||
Top = 0
|
Top = 0
|
||||||
Width = 633
|
Width = 633
|
||||||
ActivePage = TSCodeGen
|
ActivePage = TSHTML
|
||||||
Align = alClient
|
Align = alClient
|
||||||
TabIndex = 1
|
TabIndex = 0
|
||||||
TabOrder = 1
|
TabOrder = 1
|
||||||
object TSHTML: TTabSheet
|
object TSHTML: TTabSheet
|
||||||
Caption = 'HTML File'
|
Caption = 'HTML File'
|
||||||
@ -56,6 +56,7 @@ object frmHTML2Form: TfrmHTML2Form
|
|||||||
Height = 27
|
Height = 27
|
||||||
Top = 8
|
Top = 8
|
||||||
Width = 434
|
Width = 434
|
||||||
|
DialogOptions = [ofFileMustExist, ofEnableSizing, ofViewDetail]
|
||||||
FilterIndex = 0
|
FilterIndex = 0
|
||||||
HideDirectories = False
|
HideDirectories = False
|
||||||
ButtonWidth = 23
|
ButtonWidth = 23
|
||||||
@ -63,6 +64,7 @@ object frmHTML2Form: TfrmHTML2Form
|
|||||||
Anchors = [akTop, akLeft, akRight]
|
Anchors = [akTop, akLeft, akRight]
|
||||||
MaxLength = 0
|
MaxLength = 0
|
||||||
TabOrder = 0
|
TabOrder = 0
|
||||||
|
OnEditingDone = FEHTMLFileEditingDone
|
||||||
end
|
end
|
||||||
object cbAddHTMLFile: TCheckBox
|
object cbAddHTMLFile: TCheckBox
|
||||||
AnchorSideTop.Control = FEHTMLFile
|
AnchorSideTop.Control = FEHTMLFile
|
||||||
|
@ -47,6 +47,7 @@ type
|
|||||||
TSCodeGen: TTabSheet;
|
TSCodeGen: TTabSheet;
|
||||||
TSHTML: TTabSheet;
|
TSHTML: TTabSheet;
|
||||||
procedure CBEventsChange(Sender: TObject);
|
procedure CBEventsChange(Sender: TObject);
|
||||||
|
procedure FEHTMLFileEditingDone(Sender: TObject);
|
||||||
procedure FormCreate(Sender: TObject);
|
procedure FormCreate(Sender: TObject);
|
||||||
|
|
||||||
private
|
private
|
||||||
@ -134,6 +135,17 @@ begin
|
|||||||
CheckEventEdits;
|
CheckEventEdits;
|
||||||
end;
|
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;
|
procedure TfrmHTML2Form.CheckEventEdits;
|
||||||
|
|
||||||
Var
|
Var
|
||||||
|
@ -214,6 +214,28 @@ Type
|
|||||||
Property OnLog : TLogEvent Read FOnLog Write FOnLog;
|
Property OnLog : TLogEvent Read FOnLog Write FOnLog;
|
||||||
end;
|
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 }
|
{ TFormCodeGen }
|
||||||
|
|
||||||
|
|
||||||
@ -314,7 +336,109 @@ Type
|
|||||||
|
|
||||||
implementation
|
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