SOAP тип TXSDateTime не работает никак

← →
kaif (2009-02-20 17:20) [0]

Пытаюсь запросить курсы валют ЦБ при помощи их сервиса. К сервису обратился с помощью компонента HTTPRIO. Список валют получил без проблем. А вот ни один метод с параметром DateTime вызвать не удается. Прочитал, что в D6 есть ошибка на неанглийских локалях. Поменял локали. Не помогло. От отчаяния заменил текст метода в XSBuiltIns:

function TXSDateTime.NativeToXS: WideString;
var
TimeString: WideString;
begin

Result := "2009-02-20T00:00:00";
exit;

TimeString := FTimeParam.NativeToXS;
if TimeString <> "" then
Result := FDateParam.NativeToXS + SoapTimePrefix + TimeString
else
Result := FDateParam.NativeToXS;
end;

Смотрю SOAPRequest в OnBeforeExecute. Похоже, что все должно выглядеть именно так:

...
<NS1:GetCursOnDateXML xmlns="http://web.cbr.ru/">
<On_date xsi:type>2009-02-20T00:00:00</On_date>
</SOAP-ENV:Body>
</SOAP-ENV:Envelope>

Но сервис возвращает сообщение об ошибке преобразования символов в тип datetime.

В чем косяк?
Замучился уже.

← →
Медвежонок Пятачок © (2009-02-20 21:00) [1]

зачем так сложно то?
обычный ixmldomdocument2.load()

← →
Медвежонок Пятачок © (2009-02-20 21:01) [2]

они курсы отдают в xml по обычному гету, без всяких веб служб.

← →
kaif (2009-02-20 22:37) [3]

Медвежонок Пятачок © (20.02.09 21:01) [2]
они курсы отдают в xml по обычному гету, без всяких веб служб.

Да, я уже сам случайно нашел это решение. Быстро и просто. Правда не знаю, не накроется ли этот механизм в один прекрасный день.

← →
Медвежонок Пятачок © (2009-02-20 22:44) [4]

все может быть.
но я www.cbr.ru/scripts/XML_daily.asp уже лет 8 как использую

← →
kaif (2009-02-20 23:05) [5]

Медвежонок Пятачок © (20.02.09 22:44) [4]
все может быть.
но я www.cbr.ru/scripts/XML_daily.asp уже лет 8 как использую

Спасибо, ты меня убедил.
Правда при запросе отдельной валюты в диапазоне дат нужен параметр VAL_NM_RQ, в который к сожалению передается не трехбуквенное обозначение, а ID вроде R01235. Я собираюсь запросить сегодняшние курсы и оттуда выцепить ID, отыскав их по трехбуквенным обозначениям типа USD. Может быть есть более простое решение?

Ты не в курсе, нет ли такого вызова www.cbr.ru/scripts/XML_daily.asp, в котором я мог бы передать в параметрах две даты и трехбуквенное обозначение валюты?

Мне трехбуквенное по ряду причин удобно.

← →
Медвежонок Пятачок © (2009-02-20 23:17) [6]

насколько знаю, можно запросить только весь документ целиком на нужную дату. объем у него не тот чтобы экономить трафик.
далее используем selectsinglenode c нужным запросом и все.

var iNode : ixmldomnode;
begin
with CoDomDocument.Create do
begin
async := false;
if Load("http://www.cbr.ru/scripts/XML_daily.asp?date_req=13/01/2009") then
begin
iNode := selectSingleNode("//Valute[CharCode="USD"]/Value");
if iNode <> nil then ShowMessage(iNode.text);
end;
end;

← →
kaif (2009-02-21 00:05) [7]

2 Медвежонок Пятачок © (20.02.09 23:17) [6]

Я использую свой XML-разборщик.
У меня два запроса. Один на дату, как ты привел, другой на диапазон дат.
Вот, попробуй. Хорошая штука выходит. Например, запрос курсов доллара:

http://www.cbr.ru/scripts/XML_dynamic.asp?date_req1=01.01.2009&date_req2=20.02.2009&VAL_NM_RQ=R01235

Я даже запросил, начиная с 01.01.2000. Все выдает.
:)

← →
Медвежонок Пятачок © (2009-02-21 00:12) [8]

если нельзя запросить по буквенному коду, тогда заходим сбоку:
тянем за одну любую дату (например вообще без гет-параметров )
дальше получаем код R01235 по буквенному коду USD и используем его в рабочих запросах.

если свой разборщик поддерживает xpath, то все так же просто.

← →
Медвежонок Пятачок © (2009-02-21 00:19) [9]

inode := xdoc.selectSingleNode("//Valute[CharCode="USD"]/@ID");
ShowMessage("код доллара = " + iNode.Nodevalue);

← →
kaif (2009-02-21 17:47) [10]

2 Медвежонок Пятачок © (21.02.09 00:12) [8]

Я так и собираюсь сделать.

А разборщик я написал специальный, он работает с потоком TStream, загружая его кусочками и формирует события TagOpen и TagClose. Разборщик сделан так, что он запоминает все свойства тегов, которые были родительскими по отношению к текущему. Свойствами я называю как атрибуты, так и одноименные вложенные теги, которые не являются контейнерами. Таким образом моему разборщику все равно как составить XML-документ, используя атрибуты тегов или вложенные простые теги с контентом в виде текста:

<Entry>
1C-IMP-00000123123
<Date>2009-01-21<Date>
<Name>Предоплата по договору №113</Name>
<Debit>
<Account>Денежные средства<Account>
<Amount>100.00</Amount>
<Curency>USD</Currency>
</Debit>
<Credit>
<Account>Фирма Альфа<Account>
<Amount>100.00</Amount>
<Curency>USD</Currency>
</Credit>
</Entry>

для моего разборщика то же самое, как и такая запись:

<Entry Date="2009-01-21" Code="1C-IMP-00000123123" Name="Предоплата по договору №113"
<Debit Account="Денежные средства" Amount="100.00" Cuurency="USD"/>
<Credit Account="Фирма Альфа" Amount="100.00" Cuurency="USD"/>
</Entry>

Возможна и любая "смешанная" запись.
Важно лишь соблюдать имена "полей".
Получилось очень неплохо и дуракоустойчиво, с учетом того, что файл для импорта проводок формирую не я.

Ну и я задействовал тот же разборщик и для курсов с www.cbr.ru.
Саму идея обрабатывать XML-файлы в событиях "на лету", а не грузить все дерево тегов в память, я где-то спер, сам не помню где. Такая парадигма (и даже стандарт) парсеров существует. Но методы того интерфейса я не помнил, просто сделал два события и список "вложенных в данный момент тегов с их свойствами" и этого мне хватило за глаза. Свойства я просто храню в TStringList в форме Свойство=Значение. То есть в текстовом url-encoded виде.

← →
kaif (2009-02-21 17:49) [11]

Ошибся. Точнее впервом примере:

<Entry>
1C-IMP-00000123123
....

Жаль, что TXSDateTime так я и не победил.

← →
Медвежонок Пятачок © (2009-02-21 18:32) [12]

ну то есть весь документ все равно целиком загружен. пусть не в дом модель, а в стринглист.
либо код загрузки не универсален, а знает, что нужны данные скажем из второго и четвертого узла (в случае если грузить надо не все данные)

за эту экономию придется заплатить тем, что стрингист это просто стринглист с indexof и indexofname и не более.

а если пользоваться стандартными вещами, то в вашем арсенале всегда будет xpath

а это уже совсем иной уровень и совершенно иные возможности

← →
kaif (2009-02-21 19:59) [13]

Медвежонок Пятачок © (21.02.09 18:32) [12]
ну то есть весь документ все равно целиком загружен. пусть не в дом модель, а в стринглист.

Нет, я совершенно не загружаю документ в стринглист. Я в стринглисты загружаю лишь свойства (имена атрибутов или вложенных простых тегов и их строковые значения) для одних лишь открытых на данный момент разбора тегов.

Допустим, уровень вложенности документа 5. У меня в списке не будет ни на какой момент времени более 5 объектов, содержащих по стринглисту. В каждом стринглисте - от силы десяток строк.

А документ я в память не загружаю вообще. Использую чтение из Stream в буфер кусками по 32 KB. Если тег самого последнего уровня открыт, а закрывающий его тег не найден в пределах 32К, я подгружаю еще несколько блоков по 32К, в зависимости от ограничений, накладываемых одной константой. Если после этого все равно закрывающий тег не найден, я поднимаю исключение "слишком длинный контент тега либо отсутствует закрывающий тег".

Как только найден закрывающий тег, последний элемент списка удаляется. Как только найден открывающий тег, добавляется новый элемент. Это напоминает некий стек открытых тегов. Можно даже сказать, что это он и есть.

Я раньше делал разборы, загружая в память документы целиком, но в данном случае это импорт достаточно однотипных объектов, которые должны загружаться в базу данных. И число объектов может быть сотнями тысячами, может даже миллионы. Я нашел накладным разбор дерева тегов в памяти и пошел на обработку в событиях. Это очень просто. В событии OnCloseTag программист может проверить имя тега и если он соотвествует уровню, когда необходимо уже что-то записывать в базу данных, он обращается к свойствам этого тега из стека, а возможно и к свойствам родительского тега, если это вложенная конструкция типа Master-Detail, преобразует строковые величины к нужным типам данных и делает запись в базу данных.

← →
Медвежонок Пятачок © (2009-02-21 20:52) [14]

Все равно не понимаю в чем кайф.
провел эксперимент
документ из одного миллиона узлов <item id="n" name="Медвежонок Пятачок"/>

ноутбук целерон 1.2 ггц 512 мб

загрузка документа 19,422 сек
поиск предпоследнего узла по его id - 0,625 сек
размер файла ~ 60 mb

← →
kaif (2009-02-22 14:07) [15]

2 Медвежонок Пятачок © (21.02.09 20:52) [14]

Я не настаиваю на том, что должен быть какой-то кайф. Я просто описал решение, которое выбрал. У меня вообще нет ине предвидится такой задачи, как искать объект по его ID. Мне нужно было реализовать импорт данных в базу максимально быстро, просто, гибко и дуракоустойчиво. И хотелось, чтобы весь класс, реализующий нужную мне функциональность, помещался на паре экранных страниц. И если бы мой код содержал хотя бы один лишний метод, например, метод, позволяющий искать объект по его ID, я посчитал бы этот код просто избыточным и неоптимальным. Вот и все. Я же не навязываю свое решение никому. Тем более, что саму парадигму (обработка XML в событиях вместо загрузки в память) не я придумал. Если хочется спортить против парадигмы, то это тема для отдельного холивара. До того, как написать этот разборщик, а использовал написанный мною же разборщик с загрузкой в память дерева нодов. Но в данной задаче он меня не устроил. Не потому что у меня файлы большие. А просто потому что грузить в память то, что можно было бы и не грузить, противоречит моим программистским инстинктам. :)

Почему я пишу разборщики XML, а не юзаю имеющиеся? Да просто потому что мне зачастую быстрее написать самому, чем что-то изучать, исправлять и бороться с абсурдными вещами.

Ты говоришь, что это для узкой задачи?
Ну да, для узкой. Импорт данных в базу без излишеств - очень узкая задача.

Зато часто востребованная.
Это напоминает хороший гаечный ключ с определенным номером. Можно иметь набор таких ключей, а можно иметь один разводной. Если ключ нужен для дома для семьи и номер заранее не известен, то лучше купить разводной. Да еще и снабженный лазерным дальномером и уровнями в трех плоскостях до кучи. Но для профессиональной работы удобнее использовать качественный ключ из набора. Он и легче, и тверже, и надежнее, и проще в эксплуатации.

:)

← →
Медвежонок Пятачок © (2009-02-22 17:46) [16]

не, это не мой путь.
мне мой опыт подсказывает, что никогда не стоит заранее ограничивать себя в средствах.
сегодня и вчера нужен был только слепой импорт xml, а завтра у меня попросят предосмотр вкачиваемых данных в удобочитаемом виде.

если это случится, мне потребуется написать три строчки кода и уже будет результат.
а с самодельным парсером придется снова писать специальный и удобный хром-ванадиевый гаечный ключ на 17

← →
kaif (2009-02-22 22:41) [17]

2 Медвежонок Пятачок © (22.02.09 17:46) [16]

Дело вкуса.

А давай для проверки я попрошу тебя на своем универсальном парсере реализовать одну вещь, под которую мой парсер заточен.

Имеется дерево счетов, которые нужно импортировать.
XML-файл для импорта создают прочие системы пользователя (1С или возможно что-то самописное).

Одни потенциальные покупатели Leader Classic в состоянии соорудить экспорт счетов таким способом, при котором иерархия тегов отражает иерархию счетов и они умеют еще пользоваться атрибутами тегов:

<Accounts> <Account Name="Денежные средства" ParentName="Оборотные средства"/> <Account Name="Поставщики" ParentName="Краткосрочные обязательства"> <Account Name="Альфа"/> <Account Name="Бетта"/> <Account Name="Гамма"/> </Account> </Accounts>

А другие покупатели Leader Classic в состоянии соорудить экспорт счетов лишь плоским способом, при котором иерархия счетов выражена ссылками на родителя:

<Accounts> <Account Name="Денежные средства" ParentName="Оборотные средства"/> <Account Name="Поставщики" ParentName="Краткосрочные обязательства"/> <Account Name="Альфа" ParentName="Поставщики"/> <Account Name="Бетта" ParentName="Поставщики"/> <Account Name="Гамма" ParentName="Поставщики"/> </Accounts>

А у третьих потенциальных покупателей Leader Classic стоит свой "универсальный гаечный ключ" (например такой тупой экземляр экспорта имеется в базе данных Access), который просто вообще не умеет работать с атрибутами. Им нужен импорт плоского файла со ссылками на родителей, но поля они умеют изображать только вложенными тегами:

<Accounts> <Account> <Name>Денежные средства</Name> <ParentName>Оборотные средства</ParentName> </Account> <Account> <Name>Поставщики</Name> <ParentName>Краткосрочные обязательства</ParentName> </Account> <Account> <Name>Альфа</Name> <ParentName>Поставщики</ParentName> </Account> <Account> <Name>Бетта</Name> <ParentName>Поставщики</ParentName> </Account> <Account> <Name>Гамма</Name> <ParentName>Поставщики</ParentName> </Account> </Accounts>

И вот мне надо добавить в свой серийный продукт Leader Classic не то, что удовлетворит просьбу одного пользователя, сократив мне в некотором гипотетическом будущем усилия, если кто-то попросит препросмотр ста тысяч записей, а мне нужно оговорить синтаксис файла импорта, который могли бы обеспечить возможно большее число потенциальных покупателей и уже имеющихся пользователей.

Я приведу код своего класса, который я обдумал и написал за 1 день.
А ты приведи код методами XPath или чем хочешь, который будет точно так же нечувствителен к синтаксису и допускать как иерархическое, так и плоское описание, как поля переданные атрибутами, так и вложенными тегами, как, впрочем и смесь всех этих подходов у совсем сумасшедших пользователей, которым взбредет в голову, что XML-файл хорошо бы "глазами еще и читать чтобы было приятно".

Вот код моего класса:
{*******************************************************} { } { XML Import Tool } { } { Copyright (c) 2009 Ashot Tovmasyan } { } {*******************************************************} unit XMLImport; interface uses Classes, SysUtils, Dialogs, StrUtils; type TXMLImportTag = class private FName: string; FParent: TXMLImportTag; FProperties: TStringList; procedure SetProperties(const Value: TStrings); function GetProperties: TStrings; public function AsDate(const ValueName: string): TDateTime; function AsCurrency(const ValueName: string): Currency; function AsString(const ValueName: string): string; function NameIs(const AName: string): boolean; function HasValue(const ValueName: string): boolean; function Level: integer; property Name: string read FName; property Parent: TXMLImportTag read FParent; property Properties: TStrings read GetProperties write SetProperties; constructor Create; destructor Destroy; override; end; type TProgressEvent = procedure(Max, Position: integer) of object; TTagEvent = procedure(Tag: TXMLImportTag) of object; type TXMLImport = class(TComponent) private FFileSize: integer; FOnProgress: TProgressEvent; {список текущих открытых тегов} FOpenedTags: TList; FOnCloseTag: TTagEvent; FOnOpenTag: TTagEvent; F: TStream; procedure ClearOpenedTags; procedure Progress(Max, Position: integer); function TranslateEscapingSymbols(const s: string): string; procedure DoImport(const FileName: string; Stream: TStream); protected procedure OpenTag(const TagName, AttrString: string); procedure CloseTag(const TagName: string); procedure ParseAttributes(const Attributes: string); procedure ParseTextLine(const TextLine: string); public {Текущий открытый тег} function CurrentTag: TXMLImportTag; {Найте тег по имени} function FindTagByName(const TagName: string): TXMLImportTag; constructor Create(AOwner: TComponent);override; destructor Destroy;override; procedure ImportFromFile(const FileName: string); procedure ImportFromStream(Stream: TStream); published property OnOpenTag: TTagEvent read FOnOpenTag write FOnOpenTag; property OnCloseTag: TTagEvent read FOnCloseTag write FOnCloseTag; property OnProgress: TProgressEvent read FOnProgress write FOnProgress; end; var XMLDateFormat: string = "YYYY-MM-DD"; XMLDecimalSeparator: Char = "."; XMLDateSeparator: Char = "-"; var res_EndOfWhatTagNotFound: string = "End of <?... not found"; res_EndOfCommentsNotFound: string = "End of comments not found"; res_EndOfTagNotFound: string = "End of tag not found"; res_TagContentIsTooLong: string = "Tag content is too long or root tag is not closed"; res_OpeningTagNotFound: string = "Opening tag not found for <%s>"; res_ClosingTagNotFound: string = "Closing tag not found for <%s>"; res_AttrSyntaxError: string = "Attribute syntax error in tag <%s>"; res_AttrQuoteNotFound: string = "Attribute quote not found in tag <%s>";

← →
kaif (2009-02-22 22:43) [18]

implementation uses LeaderConsts; { TXMLImportTag } constructor TXMLImportTag.Create; begin FProperties := TStringList.Create; end; destructor TXMLImportTag.Destroy; begin FProperties.Free; inherited; end; function TXMLImportTag.GetProperties: TStrings; begin Result := FProperties; end; procedure TXMLImportTag.SetProperties(const Value: TStrings); begin FProperties.Assign(Value); end; function TXMLImportTag.AsDate(const ValueName: string): TDateTime; var SaveDateSeparator: Char; SaveShortDateFormat: string; begin SaveDateSeparator := SysUtils.DateSeparator; SaveShortDateFormat := SysUtils.ShortDateFormat; SysUtils.DateSeparator := XMLDateSeparator; SysUtils.ShortDateFormat := XMLDateFormat; Result := StrToDate(AsString(ValueName)); SysUtils.DateSeparator := SaveDateSeparator; SysUtils.ShortDateFormat := SaveShortDateFormat; end; function TXMLImportTag.AsCurrency(const ValueName: string): Currency; var SaveSeparator: Char; begin if not HasValue(ValueName) then begin Result := 0; exit; end; SaveSeparator := SysUtils.DecimalSeparator; SysUtils.DecimalSeparator := XMLDecimalSeparator; Result := StrToCurr(AsString(ValueName)); SysUtils.DecimalSeparator := SaveSeparator; end; function TXMLImportTag.AsString(const ValueName: string): string; begin Result := FProperties.Values[ValueName]; end; function TXMLImport.FindTagByName(const TagName: string): TXMLImportTag; var i: integer; begin for i := FOpenedTags.Count - 1 downto 0 do if AnsiCompareText(TXMLImportTag(FOpenedTags[i]).FName, TagName) = 0 then begin Result := FOpenedTags[i]; exit; end; Result := nil; end; function TXMLImportTag.Level: integer; var t: TXMLImportTag; begin Result := 1; t := nil; repeat t := t.Parent; inc(Result); until t = nil; end; function TXMLImportTag.HasValue(const ValueName: string): boolean; begin Result := AsString(ValueName) <> ""; end; function TXMLImportTag.NameIs(const AName: string): boolean; begin Result := AnsiCompareText(self.Name, AName) = 0; end;

← →
kaif (2009-02-22 22:43) [19]

{ TXMLImport }

procedure TXMLImport.Progress(Max, Position: integer);
begin
if assigned(FOnProgress) then
FOnProgress(Max, Position);
end;

procedure TXMLImport.ImportFromFile(const FileName: string);
begin
DoImport(FileName, nil);
end;

procedure TXMLImport.ImportFromStream(Stream: TStream);
begin
DoImport("", Stream);
end;

procedure TXMLImport.DoImport(const FileName: string; Stream: TStream);
var
FText, s, TextLine, OpenTagName, CloseTagName, AttrString: string;
Index: integer;
SelfClosedTag: boolean;

const
BUFFER_SIZE = 32768;

function ReadBuffer: integer;
var
P: PChar;
s: string;
begin
GetMem(P, BUFFER_SIZE + 1);
try
Result := F.Read(P^, BUFFER_SIZE); //чтение производится порциями
P[Result] := Char(0);
s := P;
FText := FText + s;
finally
FreeMem(P);
end;
end;

function FindStr(const Str: string): integer;
begin
Result := Pos(Str, FText); //ищем подстроку
if Result = 0 then
begin
ReadBuffer; //если подстрока не найдена, то считываем еще лишь еще одну
//порцию длиной BUFFER_SIZE, а не идем до конца файла!
Result := Pos(Str, FText); // вторично ищем подстроку
{Таким образом длина тега, его содержимого или комментария ограничены величиной порции BUFFER_SIZE}
end;
end;

function GetFileSize(const FileName:string):integer;
var SearchRec:TSearchRec;
begin
if FindFirst(ExpandFileName(FileName), faAnyFile, SearchRec) = 0 then
Result := SearchRec.Size
else
Result:=-1;
FindClose(SearchRec);
end;

begin
ClearOpenedTags;

if Stream = nil then
begin
F := TFileStream.Create(FileName, fmOpenRead, fmShareDenyNone);
FFileSize := GetFileSize(FileName)
end
else
begin
F := Stream;
FFileSize := F.Size;
end;

try
ReadBuffer;
while Length(FText) > 0 do
begin
Progress(FFileSize, F.Position - Length(FText));
{если первый символ строки - открывающая угловая скобка}
if FText[1] = "<" then
begin
{если это начало заголовка XML типа <?xml version="1.0"?>}
if CompareText(Copy(FText, 1, 2), "<?") = 0 then
begin
Index := FindStr("?>");
if Index = 0 then
raise Exception.Create(res_EndOfWhatTagNotFound);
delete(FText, 1, Index + 2);
end
{если это начало комментария}
else if CompareText(Copy(FText, 1, 4), "");
if Index = 0 then
raise Exception.Create(res_EndOfCommentsNotFound);
delete(FText, 1, Index + 3);
end
{если это начало закрывающего тега}
else if CompareText(Copy(FText, 1, 2), "</") = 0 then
begin
Index := FindStr(">");
if Index = 0 then
raise Exception.Create(res_EndOfTagNotFound);
CloseTagName := trim(copy(FText, 3, Index - 3));
CloseTag(CloseTagName);
delete(FText, 1, Index);
end
{во всех остальных случаях полагаем, что это начало открывающего тега}
else //OpenTag
begin
Index := FindStr(">");
if Index = 0 then
raise Exception.Create(res_EndOfTagNotFound);

s := Copy(FText, 2, Index - 2);

SelfClosedTag := s[Length(s)] = "/"; //самозакрывающийся тег
if SelfClosedTag then
delete(s, Length(s), 1);

if Pos(" ", s) <> 0 then
begin
OpenTagName := trim(Copy(s, 1, Pos(" ", s) - 1));
delete(s, 1, Pos(" ", s));
AttrString := trim(s);
end
else
begin
OpenTagName := s;
AttrString := "";
end;

OpenTag(OpenTagName, AttrString);
if SelfClosedTag then
CloseTag(OpenTagName);

delete(FText, 1, Index);
end
end
else {если же первый символ не открывающая угловая скобка,
то полагаем, что это текст между тегами}
begin
Index := FindStr("<");
if (Index = 0) then
begin
if (CurrentTag = nil) then
break
else
raise Exception.Create(res_TagContentIsTooLong);
end;
TextLine := Copy(FText, 1, Index - 1);
if trim(TextLine) <> "" then
ParseTextLine(TextLine);
delete(FText, 1, Index - 1);
end;
end;
finally
if Stream = nil then
F.Free;
end;
end;

procedure TXMLImport.OpenTag(const TagName, AttrString: string);
var
t: TXMLImportTag;
begin
{Добавляем тег в список открытых тегов}
t := TXMLImportTag.Create;
t.FName := TagName;
t.FParent := CurrentTag;
FOpenedTags.Add(t);

if AttrString <> "" then
ParseAttributes(AttrString); //тут же разбираем атрибуты

if assigned(FOnOpenTag) then FOnOpenTag(t); //вызываем событие
end;

procedure TXMLImport.CloseTag(const TagName: string);
begin
if CurrentTag = nil then
raise Exception.CreateFmt(res_OpeningTagNotFound, [TagName])
else if AnsiCompareText(CurrentTag.Name, TagName) <> 0 then
begin
if FindTagByName(TagName) <> nil then
raise Exception.CreateFmt(res_ClosingTagNotFound, [CurrentTag.Name])
else
raise Exception.CreateFmt(res_OpeningTagNotFound, [TagName]);
end;

if assigned(FOnCloseTag) then FOnCloseTag(CurrentTag); //вызываем событие

{Удаляем тег из списка открытых тегов}
CurrentTag.Free;
FOpenedTags.Delete(FOpenedTags.Count - 1);
end;

← →
kaif (2009-02-22 22:43) [20]

constructor TXMLImport.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FOpenedTags := TList.Create;
end;

destructor TXMLImport.Destroy;
begin
ClearOpenedTags;
FOpenedTags.Free;
inherited Destroy;
end;

function TXMLImport.CurrentTag: TXMLImportTag;
begin
if FOpenedTags.Count > 0 then
Result := FOpenedTags[FOpenedTags.Count - 1]
else
Result := nil;
end;

procedure TXMLImport.ClearOpenedTags;
var
i: integer;
begin
for i := FOpenedTags.Count - 1 downto 0 do
TXMLImportTag(FOpenedTags[i]).Free;
FOpenedTags.Clear;
end;

procedure TXMLImport.ParseTextLine(const TextLine: string);
begin
if (CurrentTag <> nil) and (CurrentTag.Parent <> nil) then
CurrentTag.Parent.Properties.Values[CurrentTag.Name] := TranslateEscapingSymbols(TextLine);
end;

procedure TXMLImport.ParseAttributes(const Attributes: string);
var
FAttrText, CurrentAttrName, CurrentAttrValue: string;
Index, Index2: integer;
begin
FAttrText := Attributes;

CurrentAttrName := "";

while Length(FAttrText) > 0 do
{знак равенства означает присвоение значения атрибуту}
if (FAttrText[1] = "=") then
begin
CurrentAttrName := trim(CurrentAttrName);
if (CurrentAttrName = "") or (Pos(" ", CurrentAttrName) > 0) then
raise Exception.CreateFmt(res_AttrSyntaxError, [CurrentTag.Name]);
delete(FAttrText, 1, 1);
Index := Pos(""", FAttrText);
Index2 := Pos("=", FAttrText);
{если не найдена открывающая кавычка или она правее очередного знака равенства}
if (Index = 0) or ((Index2 <> 0) and (Index2 < Index)) then
raise Exception.CreateFmt(res_AttrQuoteNotFound, [CurrentTag.Name]);
delete(FAttrText, 1, Index);
{Ищем закрывающую кавычку}
Index := Pos(""", FAttrText);
if Index = 0 then
raise Exception.CreateFmt(res_AttrQuoteNotFound, [CurrentTag.Name]);

CurrentAttrValue := Copy(FAttrText, 1, Index - 1);
delete(FAttrText, 1, Index);
FAttrText := trim(FAttrText);

if FOpenedTags.Count > 0 then
CurrentTag.Properties.Values[CurrentAttrName] := TranslateEscapingSymbols(CurrentAttrValue);

CurrentAttrName := "";
end
else {в противном случае это - название атрибута}
begin
CurrentAttrName := CurrentAttrName + FAttrText[1]; //накапливаем имя посимвольно
delete(FAttrText, 1, 1);
end;

if trim(CurrentAttrName) <> "" then
raise Exception.CreateFmt(res_AttrSyntaxError, [CurrentTag.Name]);
end;

function TXMLImport.TranslateEscapingSymbols(const s: string): string;
begin
Result := s;
Result := AnsiReplaceText(s, "<", "<");
Result := AnsiReplaceText(Result, ">", ">");
Result := AnsiReplaceText(Result, """, """);
Result := AnsiReplaceText(Result, "'", """");
Result := AnsiReplaceText(Result, "&", "&");
Result := AnsiReplaceText(Result, "\r\n", ""#13#10);
Result := AnsiReplaceText(Result, "\t", ""#9);
end;

end.

← →
kaif (2009-02-22 23:30) [21]

Впрочем, код можно было не приводить, так как идея ясна.
Но может кому-то пригодится.

Знаешь, ты меня заставил задуматься над вопросом, что будет, если меня попросят сделать предпросмотр.
Дело в том, что у меня финансовые операции заключены в контейнер <Entries></Entries>. И таких контейнеров может быть несколько. Если у меня и попросят предпросмотр, то скорее всего именно предпросмотр списка таких контейнеров.
Что я буду в этом случае делать? А ничего особенного.
Я просто пройдусь по файлу дважды.
Первый раз для выуживания списка контейнеров, что при моей обработке в событии OnCloseTag сделать крайне просто. А второй раз - уже для собственно импорта. Скорее всего ОС закеширует файл, если позволяет память, в любом случае и это ускорит потом импорт. Зачем мне делать это вместо нее? Зачем мне плодить вторую копию файла в памяти? Особенно зачем мне этим заниматься, если все это посвящено лишь тому, чтобы юзер, например, просмотрев список контейнеров, вообще отказался от импорта этого файла?

К тому же при таком подходе я дам возможность просмотра лишь в ситуации, когда пользователь нажмет соотвествующую кнопку. А если не нажмет, то двойного обхода файла вообще не произойдет. Таким образом тот юзер, которому предпросмотр не нужен, не будет расплачиваться никакими лишними секундами загрузки файла в память ради юзера, который без этого просмотра жить не может.

Возможно подходы при написании серийных продуктов и заказных могут сильно отличаться. В серийном продукте я придерживаюсь правила: не ущемлять всех ради некоторых. А в заказном продукте я придерживаюсь того же правила, что и ты: экономить свой собственный будущий гемеррой, если именно этот заказчик вдруг сойдет с ума по-новому.

здесь я скорее всего соглашусь.
насколько я понял, алгоритм чтения файла импорта ничего не знает про то , зачем он это делает и куда попадут читаемые данные.
то ли в БД то ли в окно проедосмотра.
у меня то же самое, заисключением того, что развязка реализована не событиями, а функциями обратного вызова.
я пришел к этому когда портребовался импорт одних и тех же сущностей из разных источников. при этом надо везде одинаковым образом проверять как входящие данные.

то есть грубо говоря для импорта написаны функции типа
function enum_dbase_file(afilename : string; AImportCallBack : TMyImortCallBack ) : integer;
function enum_text_file(afilename : string; AImportCallBack : TMyImortCallBack ) : integer;
function enum_excel_file(afilename : string; AImportCallBack : TMyImortCallBack) : integer;
и так далее

а для предосмотра xml (если не требуется отбор импортируемых записей)
использую просто ixmldomnode.transformnode()

результатом может быть html, txt, или что-нибудь иное в зависимости от содержания документа преобразования.

если же нужен отбор, что импортировать а что нет, обычно используется фрейм на базе TVirualStringTree c чекбоксами

← →
kaif (2009-02-23 23:48) [23]

Ну дык функции обратного вызова это по сути почти то же самое, что и события. Даже еще гибче. Так как на события надо не забывать повесить то один обработчик, то другой, а при вызове функции с параметром, в котром передается указатель на типизированную функцию обратного вызова, нужный обработчик сразу навешивается непринужденно.
Поддерживаю такое решение.

← →
имя (2009-03-23 21:51) [24]

Удалено модератором

← →
имя (2009-03-23 21:52) [25]

Удалено модератором

SOAP тип TXSDateTime не работает никак Найти похожие ветки