Форум: "Основная";
Текущий архив: 2005.08.28;
Скачать: [xml.tar.bz2];
ВнизКак быстрее прочитать и обработать файл Найти похожие ветки
← →
Viktop (2005-08-06 20:05) [0]Как можно наиболее быстро прочитать этот файл (курсы скорочтения не предлагать:) ). В первую очередь интересуют поля name (на их основе должно строиться дерево).
Block
{
name = Раздел 1
uplash = Строка
Block
{
name = Подраздел 1
Entry
{
name = Название проги 1
url = адрес
executable = Путь
... (другие поля)
}
Entry
{
name = Название проги 2
url = адрес
executable = Путь
... (другие поля)
}
}
Block
{
name = Подраздел 2
Entry
{
name = Название проги 1
url = адрес
executable = Путь
... (другие поля)
}
...
}
}
и далее такая структура повторяется несколько раз
← →
Viktop (2005-08-06 20:06) [1]Здесь вместо пробелов в начале строки должен стоять знак табуляции (1 пробел=1 Tab)
← →
lookin © (2005-08-06 20:10) [2]А что значит "прочитать"?
← →
Юрий Зотов © (2005-08-06 20:19) [3]Например, прочитать весь файл в строку, а ее распарсить (сначала составив набор БНФ). Доли секунды должно занять.
← →
lookin © (2005-08-06 20:21) [4][3] Юрий Зотов © (06.08.05 20:19)
Автор не имеет в виду "прочитать" - т.е. загрузить из файла?
← →
pasha_golub © (2005-08-06 22:49) [5]А лучше было бы хранить это все дело в XML, а уж потом использовать один из доступных парсеров.
Ну, прямо напрашивается.
← →
lookin © (2005-08-06 23:29) [6][5] pasha_golub © (06.08.05 22:49)
Паресер можно и самому написать....
← →
jack128 © (2005-08-07 00:32) [7]На вскидку, без тестирования:
unit Unit2;
interface
uses
SysUtils, Contnrs, Classes;
type
TEntry = class
Name: string;
Url: string;
Executable: string;
end;
TBlock = class
private
FName: string;
FBlocks: TObjectList;
FEntries: TObjectList;
function GetBlockCount: Integer;
function GetBlock(Index: Integer): TBlock;
function GetEntry(Index: Integer): TEntry;
function GetEntryCounnt: Integer;
public
constructor Create;
destructor Destroy; override;
property Name: string read FName write FName;
property Blocks[Index: Integer]: TBlock read GetBlock;
property BlockCount: Integer read GetBlockCount;
property Entries[Index: Integer]: TEntry read GetEntry;
property EntryCount: Integer read GetEntryCounnt;
end;
TBlockParser = class
private
FSources: TStrings;
FCurrentLine: Integer;
function CurrentLine: string;
procedure RaiseParseError;
procedure CheckEOF;
function EOF: boolean;
function IsStartBlock: boolean;
function IsEndBlock: boolean;
function ParseBlock: TBlock;
function ParseEntry: TEntry;
function ParseParamValue(Param: string): string;
public
procedure Parse(Sources: TStrings; ResultBlockList: TList);
end;
implementation
{ TBlock }
constructor TBlock.Create;
begin
FBlocks := TObjectList.Create;
FEntries := TObjectList.Create;
end;
destructor TBlock.Destroy;
begin
FreeAndNil(FBlocks);
FreeAndNil(FEntries);
inherited;
end;
function TBlock.GetBlockCount: Integer;
begin
Result := FBlocks.Count;
end;
function TBlock.GetBlock(Index: Integer): TBlock;
begin
Result := TBlock(FBlocks[Index])
end;
function TBlock.GetEntry(Index: Integer): TEntry;
begin
Result := TEntry(FEntries[Index])
end;
function TBlock.GetEntryCounnt: Integer;
begin
Result := FEntries.Count
end;
{ TBlockParser }
procedure TBlockParser.CheckEOF;
begin
if EOF then
raise Exception.Create("Неожиданный конец файла");
end;
function TBlockParser.CurrentLine: string;
begin
CheckEOF;
Result := FSources[FCurrentLine];
end;
function TBlockParser.EOF: boolean;
begin
Result := FCurrentLine >= FSources.Count;
end;
function TBlockParser.IsEndBlock: boolean;
begin
Result := not EOF and (UpperCase(Trim(CurrentLine)) = "}")
end;
function TBlockParser.IsStartBlock: boolean;
begin
Result := not EOF and (UpperCase(Trim(CurrentLine)) = "BLOCK")
end;
procedure TBlockParser.Parse(Sources: TStrings; ResultBlockList: TList);
begin
FCurrentLine := 0;
CheckEOF;
while not EOF do
ResultBlockList.Add(ParseBlock);
end;
function TBlockParser.ParseBlock: TBlock;
var
Block: TBlock;
Value: string;
NameFinded: boolean;
begin
Result := nil;
if not IsStartBlock then
RaiseParseError;
inc(FCurrentLine);
if CurrentLine <> "{" then
RaiseParseError;
inc(FCurrentLine);
try
Result := TBlock.Create;
Result.FName := ParseParamValue("Name");
while not IsEndBlock do
begin
if IsStartBlock then
Result.FBlocks.Add(ParseBlock)
else
Result.FEntries.Add(ParseEntry);
end;
if CurrentLine <> "}" then
RaiseParseError;
inc(FCurrentLine);
except
FreeAndNil(Result);
raise;
end;
end;
function TBlockParser.ParseEntry: TEntry;
var
Value: string;
begin
Result := nil;
if UpperCase(CurrentLine) <> "ENTRY" then
RaiseParseError;
inc(FCurrentLine);
if UpperCase(CurrentLine) <> "{" then
RaiseParseError;
Result := TEntry.Create;
try
Result.Name := ParseParamValue("name");
Result.Url := ParseParamValue("url");
Result.Executable := ParseParamValue("Executable");
except
FreeAndNil(Result);
raise;
end;
end;
function TBlockParser.ParseParamValue(Param: string): string;
var
s: string;
i: Integer;
begin
s := CurrentLine;
i := Pos("=", s);
if i <= 0 then RaiseParseError;
if UpperCase(Param) <> UpperCase(Trim(copy(s, 1, i - 1))) then
raise Exception.CreateFmt("Не найден параметр %s", [Param]);
Result := copy(s, i + 1, MaxInt);
inc(FCurrentLine);
end;
procedure TBlockParser.RaiseParseError;
begin
raise Exception.CreateFmt("Ошибка в строке %d", [FCurrentLine]);
end;
end.
← →
jack128 © (2005-08-07 00:44) [8]
function TBlockParser.ParseEntry: TEntry;
var
Value: string;
begin
Result := nil;
if UpperCase(CurrentLine) <> "ENTRY" then
RaiseParseError;
inc(FCurrentLine);
if UpperCase(CurrentLine) <> "{" then
RaiseParseError;
Result := TEntry.Create;
try
Result.Name := ParseParamValue("name");
Result.Url := ParseParamValue("url");
Result.Executable := ParseParamValue("Executable");
if UpperCase(CurrentLine) <> "}" then
RaiseParseError;
inc(FCurrentLine);
except
FreeAndNil(Result);
raise;
end;
end;
← →
jack128 © (2005-08-07 01:27) [9]Мда.. Кол - во ошибок ужасает.. Вот новый примерчик, по крайней мере приведенный фрагмент он распарсил..
unit uParser;
interface
uses
SysUtils, Contnrs, Classes;
type
TEntry = class
Name: string;
Url: string;
Executable: string;
end;
TBlock = class
private
FName: string;
FUplash: string;
FBlocks: TObjectList;
FEntries: TObjectList;
function GetBlockCount: Integer;
function GetBlock(Index: Integer): TBlock;
function GetEntry(Index: Integer): TEntry;
function GetEntryCounnt: Integer;
public
constructor Create;
destructor Destroy; override;
property Name: string read FName write FName;
property Blocks[Index: Integer]: TBlock read GetBlock;
property BlockCount: Integer read GetBlockCount;
property Entries[Index: Integer]: TEntry read GetEntry;
property EntryCount: Integer read GetEntryCounnt;
end;
TBlockParser = class
private
FSources: TStrings;
FCurrentLine: Integer;
function CurrentLine: string;
procedure RaiseParseError;
procedure CheckEOF;
function EOF: boolean;
procedure CheckStr(const s: string);
function IsStartBlock: boolean;
function IsEndBlock: boolean;
function IsParamStr(var Param, Value: string): boolean;
function ParseBlock: TBlock;
function ParseEntry: TEntry;
function ParseParamValue(Param: string): string;
public
procedure Parse(Sources: TStrings; ResultBlockList: TList);
end;
implementation
{ TBlock }
constructor TBlock.Create;
begin
FBlocks := TObjectList.Create;
FEntries := TObjectList.Create;
end;
destructor TBlock.Destroy;
begin
FreeAndNil(FBlocks);
FreeAndNil(FEntries);
inherited;
end;
function TBlock.GetBlockCount: Integer;
begin
Result := FBlocks.Count;
end;
function TBlock.GetBlock(Index: Integer): TBlock;
begin
Result := TBlock(FBlocks[Index])
end;
function TBlock.GetEntry(Index: Integer): TEntry;
begin
Result := TEntry(FEntries[Index])
end;
function TBlock.GetEntryCounnt: Integer;
begin
Result := FEntries.Count
end;
{ TBlockParser }
procedure TBlockParser.CheckEOF;
begin
if EOF then
raise Exception.Create("Неожиданный конец файла");
end;
procedure TBlockParser.CheckStr(const s: string);
begin
if UpperCase(Trim(CurrentLine)) <> UpperCase(s) then
RaiseParseError;
inc(FCurrentLine);
end;
function TBlockParser.CurrentLine: string;
begin
CheckEOF;
Result := FSources[FCurrentLine];
end;
function TBlockParser.EOF: boolean;
begin
Result := FCurrentLine >= FSources.Count;
end;
function TBlockParser.IsEndBlock: boolean;
begin
Result := not EOF and (UpperCase(Trim(CurrentLine)) = "}")
end;
function TBlockParser.IsParamStr(var Param, Value: string): boolean;
var
s: string;
i: Integer;
begin
s := CurrentLine;
i := Pos("=", s);
Result := i > 0;
if not Result then Exit;
Param := Trim(copy(s, 1, i - 1));
Result := Param <> "";
if Result then
Value := copy(s, i + 1, MaxInt);
end;
function TBlockParser.IsStartBlock: boolean;
begin
Result := not EOF and (UpperCase(Trim(CurrentLine)) = "BLOCK")
end;
procedure TBlockParser.Parse(Sources: TStrings; ResultBlockList: TList);
begin
FSources := Sources;
FCurrentLine := 0;
CheckEOF;
while not EOF do
ResultBlockList.Add(ParseBlock);
end;
function TBlockParser.ParseBlock: TBlock;
var
Param, Value: string;
begin
Result := nil;
CheckStr("Block");
CheckStr("{");
try
Result := TBlock.Create;
Result.FName := ParseParamValue("Name");
if IsParamStr(Param, Value) then
if SameText(Param, "uplash") then
Result.FUplash := ParseParamValue("uplash")
else
raise Exception.CreateFmt("Не известный параметр %s", [Param]);
while not IsEndBlock do
begin
if IsStartBlock then
Result.FBlocks.Add(ParseBlock)
else
Result.FEntries.Add(ParseEntry);
end;
CheckStr("}");
except
FreeAndNil(Result);
raise;
end;
end;
function TBlockParser.ParseEntry: TEntry;
begin
Result := nil;
CheckStr("ENTRY");
CheckStr("{");
Result := TEntry.Create;
try
Result.Name := ParseParamValue("name");
Result.Url := ParseParamValue("url");
Result.Executable := ParseParamValue("Executable");
CheckStr("}");
except
FreeAndNil(Result);
raise;
end;
end;
function TBlockParser.ParseParamValue(Param: string): string;
var
s: string;
begin
if not IsParamStr(s, Result) or not SameText(Param, s) then
raise Exception.CreateFmt("Не найден параметр %s", [Param]);
inc(FCurrentLine);
end;
procedure TBlockParser.RaiseParseError;
begin
raise Exception.CreateFmt("Ошибка в строке %d", [FCurrentLine]);
end;
end.
//////////////////////////////////////////////////////////////////////////////////////////unit uMainForm;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Contnrs, ComCtrls, uParser;
type
TMainForm = class(TForm)
ParseButton: TButton;
SourceMemo: TMemo;
BlockTreeView: TTreeView;
procedure ParseButtonClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
MainForm: TMainForm;
implementation
{$R *.dfm}
procedure TMainForm.ParseButtonClick(Sender: TObject);
function CreateBlockNode(ParentNode: TTreeNode; Block: TBlock): TTreeNode;
begin
Result := BlockTreeView.Items.AddChild(ParentNode, "Блок - " + Block.Name);
end;
procedure CreateChildrenNodes(Node: TTreeNode; Block: TBlock);
var
i: Integer;
ChildBlock: TBlock;
ChildNode: TTreeNode;
begin
for i := 0 to Block.BlockCount - 1 do
begin
ChildBlock := Block.Blocks[i];
ChildNode := CreateBlockNode(Node, ChildBlock);
CreateChildrenNodes(ChildNode, ChildBlock);
end;
for i := 0 to Block.EntryCount - 1 do
← →
jack128 © (2005-08-07 01:27) [10]
BlockTreeView.Items.AddChild(Node, "Entry - " + Block.Entries[i].Name);
end;
var
list: TObjectList;
parser: TBlockParser;
i: Integer;
begin
list := TObjectList.Create;
try
parser := TBlockParser.Create;
try
parser.Parse(SourceMemo.Lines, list);
BlockTreeView.Items.Clear;
for i := 0 to list.Count - 1 do
CreateChildrenNodes(CreateBlockNode(nil, TBlock(list[i])), TBlock(list[i]));
finally
parser.Free;
end;
finally
list.Free;
end;
end;
end.
← →
lookin © (2005-08-07 01:35) [11][10] jack128 © (07.08.05 01:27)
У меня тут проьблемка, может и мне поможете?
Страницы: 1 вся ветка
Форум: "Основная";
Текущий архив: 2005.08.28;
Скачать: [xml.tar.bz2];
Память: 0.51 MB
Время: 0.041 c