Форум: "Начинающим";
Текущий архив: 2013.03.22;
Скачать: [xml.tar.bz2];
ВнизПопинайте код, предложите альтернативы :) Найти похожие ветки
← →
Dennis I. Komarov © (2012-08-27 19:26) [0]a) Попинайте код:
Служба пускает поток:unit frdecode;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,
SysDirs, FRF, xmldom, XMLIntf, msxmldom, XMLDoc, ActiveX;
type
TThreadConverter = class(TThread)
private
{ Private declarations }
protected
procedure Execute; override;
end;
implementation
{ TThreadConverter }
procedure TThreadConverter.Execute;
var
FRFDir: string;
SearchRec: TSearchRec;
FindResult: Integer;
FRFdata: TFRF;
FileName: TFileName;
iDoc: IXMLDocument;
EStr: AnsiString;
begin
FreeOnTerminate:=true;
FRFDir := GetAllUsersDocumentsDir + "\frf.files"; // Отправить в реестр
// сканирование frf файлов в заданной директории
CoInitialize(nil);
while not Terminated do try
try {TXMLDocument.Create}
FindResult := FindFirst(FRFDir + "\*.frf", faAnyFile, SearchRec);
while FindResult = 0 do begin
if (SearchRec.Name <> ".") and (SearchRec.Name <> "..") then begin
// при нахождении файла читаем его значения и сохраняем в уникальный xml файл
FRFdata:=DecodeFRF(FRFDir + "\" + SearchRec.Name);
if not Assigned(iDoc) then
iDoc := TXMLDocument.Create(nil);
//Сохраняем данные в XML документ
FileName:=FloatToStr(Time); Delete(FileName, 1, 2);
Filename:=ExtractFilePath(ParamStr(0)) + "Data\" + FileName;
iDoc.Active:=true;
Sleep(100);
iDoc.FileName := FileName;
iDoc.Encoding:="WINDOWS-1251";
iDoc.AddChild("ED101", "urn:cbr-ru:ed:v2.0");
with iDoc.DocumentElement do begin
SetAttributeNS("PaytKind", "", "1");
SetAttributeNS("Sum", "", FRFdata.Sum);
SetAttributeNS("TransKind", "", "01");
SetAttributeNS("Priority", "", "1");
with AddChild("AccDoc") do begin
SetAttributeNS("AccDocNo", "", FRFdata.Num);
SetAttributeNS("AccDocDate", "", FRFdata.Date);
end;
with AddChild("Payer") do begin
SetAttributeNS("INN", "", FRFdata.PayerINN);
SetAttributeNS("PersonalAcc", "", FRFdata.PayerACC);
SetAttributeNS("KPP", "", FRFdata.PayerKPP);
with AddChild("Name") do begin
NodeValue:=FRFdata.Payer;
end;
with AddChild("Bank") do begin
SetAttributeNS("BIC", "", "046126738");
end;
end;
with AddChild("Payee") do begin
SetAttributeNS("INN", "", FRFdata.RecipINN);
SetAttributeNS("PersonalAcc", "", FRFdata.RecipACC);
SetAttributeNS("KPP", "", FRFdata.RecipKPP);
AddChild("Name");
with AddChild("Name") do begin
NodeValue:=FRFdata.Recip;
end;
with AddChild("Bank") do begin
SetAttributeNS("BIC", "", FRFdata.RecipBIC);
end;
end;
with AddChild("Purpose") do begin
NodeValue:=string(FRFdata.PaymentAI);
end;
//if (Бюджетный платеж) then
with AddChild("DepartmentalInfo") do begin
SetAttributeNS("DrawerStatus", "", FRFdata.OperationKind);
SetAttributeNS("CBC", "", FRFdata.KBK);
SetAttributeNS("OKATO", "", FRFdata.OKATO);
SetAttributeNS("PaytReason", "", FRFdata.TaxReaso);
SetAttributeNS("TaxPeriod", "", FRFdata.TaxPeriod);
SetAttributeNS("DocNo", "", FRFdata.TaxDocN);
SetAttributeNS("DocDate", "", FRFdata.TaxDate);
SetAttributeNS("TaxPaytKind", "", FRFdata.TaxStatus);
end;
end;
iDoc.SaveToFile(FileName);
Sleep(100);
iDoc.Active := false;
iDoc.XML.Clear;
//Если удачно тогда удаляем frf файл
if RenameFile(FileName, FileName + ".xml") then
DeleteFile(FRFDir + "\" + SearchRec.Name);
Sleep(100);
end;
Sleep(1000);
FindResult := FindNext(SearchRec);
end;
FindClose(SearchRec);
finally
TXMLDocument(iDoc).Free;
FreeAndNil(iDoc);
end;{}
Sleep(5000);
except
on E: Exception do
with TFileStream.Create(ExtractFilePath(ParamStr(0)) + "Data\errors.txt", fmOpenWrite) do try
Seek(0, soFromEnd);
EStr := AnsiString("ERR "+ DateTimeToStr(Now) + #13#10 + E.ClassName + " | " + E.Message + ": " + E.ToString+ #13#10);
Write(EStr[1], Length(EStr));
finally
Free;
end;
end;
CoUninitialize;
end;
end.
б) Предложите альтернативу TXMLDocument - Получаю AV на втором файле (иногда на 3, 4....) вобщем нестабильна. Если сужбу перезапустить, результат тот же, так что дело не в *.frf:
ERR 27.08.2012 16:59:42
EAccessViolation | Access violation at address 0040A325 in module "frc.exe". Read of address 00000001: Access violation at address 0040A325 in module "frc.exe". Read of address 00000001
ERR 27.08.2012 16:59:43
EAccessViolation | Access violation at address 0040A325 in module "frc.exe". Read of address 00000001: Access violation at address 0040A325 in module "frc.exe". Read of address 00000001
ERR 27.08.2012 16:59:44
EAccessViolation | Access violation at address 0040A325 in module "frc.exe". Read of address 00000001: Access violation at address 0040A325 in module "frc.exe". Read of address 00000001
Дальше до перезапуска тишина
У Медвежонка был где-то код работы с DOM без обертки, пока искал столько баталий начитался по поводу хмл, так что можно сказать есть очередной повод :)
← →
Rouse_ © (2012-08-27 19:48) [1]Ну так а какой строке кода соответствует адрес 0040A325 ?
← →
sniknik © (2012-08-27 19:54) [2]?????????????/
TXMLDocument(iDoc).Free;
FreeAndNil(iDoc);
← →
Dennis I. Komarov © (2012-08-27 19:54) [3]
> Ну так а какой строке кода соответствует адрес 0040A325 ?
А х.з. До сих пор не знаю как это посмотрть... Лог с реально запущенной службы. Как запустить службу из IDE (или приклеать процесс к коду) - не знаю. Уж вот как-то так... :-[
← →
sniknik © (2012-08-27 19:56) [4]при том что работает в варианте интерфейса
← →
sniknik © (2012-08-27 19:57) [5]F8 + Find Error
← →
Dennis I. Komarov © (2012-08-27 19:58) [6]
> ?????????????/
> TXMLDocument(iDoc).Free;
> FreeAndNil(iDoc);
Добил на всякий :) Это уже извращения в надежде "А вдруг"...
Сперва iDoc создавался перед FindFirst, Потом подумал назачем, если файлов нет - дописал Assigned, после дорисовал FreeAndNil, на всякий пожарный... Без него поведение такое же
← →
Dennis I. Komarov © (2012-08-27 20:02) [7]
> при том что работает в варианте интерфейса
Ну я его и создавал как TXML..., так и убил :-[
← →
sniknik © (2012-08-27 20:07) [8]> Добил на всякий :)
2 команды с не нулевой вероятностью AV на каждой. на всякий пожарный... ага.
← →
Dennis I. Komarov © (2012-08-27 20:12) [9]
> 2 команды с не нулевой вероятностью AV на каждой. на всякий
> пожарный... ага.
Ну быть может, но почему такая нестабильная?
← →
RWolf © (2012-08-27 20:15) [10]интерфейсы не предназначены для того, чтобы их освобождали вызовом Free.
вся суть интерфейса в автоматическом освобождении реализующего его объекта, когда он становится не нужен.
если уж так хочется освободить объект через интерфейс, это делается так:
iDoc := nil;
← →
sniknik © (2012-08-27 20:17) [11]думаешь это единственная проблема? посмотри к примеру на пример поиска файлов в дельфи и найди разницу со своим... что будет если не найдено сразу. и выход из потока по терминейту у тебя "закрыт" циклом поиска... т.е. нафиг он вообще сдался...
все переделать нафиг, в общем.
← →
sniknik © (2012-08-27 20:22) [12]и да
CoInitialize(nil);
CoUninitialize;
должны быть строго парные, имеет смысл использовать try finally
← →
Dennis I. Komarov © (2012-08-27 20:23) [13]
> что будет если не найдено сразу. и выход из потока по терминейту
> у тебя "закрыт" циклом поиска...
Это почему?while not Terminated nbegin
FindFirst
while ... do begin
...
FindNext
end;
FindClose
Sleep
end;
Где не так?
← →
RWolf © (2012-08-27 20:24) [14]ну так Terminated проверится только после завершения поиска.
← →
Dennis I. Komarov © (2012-08-27 20:26) [15]
> RWolf © (27.08.12 20:15) [10]
> интерфейсы не предназначены для того, чтобы их освобождали
> вызовом Free.
> вся суть интерфейса в автоматическом освобождении реализующего
> его объекта, когда он становится не нужен.
> если уж так хочется освободить объект через интерфейс, это
> делается так:
> iDoc := nil;
Пасиб, я с ними до этого не работал. Легыч говорил - глянь в конструктор... Там если он создается от nil, то он работает в режиме интерфейса...
← →
sniknik © (2012-08-27 20:32) [16]+ ты присваиваешь имя файла объекту... что насколько помню заставляет документ его поддерживать, в файле, что, ИМХО, стабильности не добавляет. тем более в конце все одно скидываешь его через SaveToFile.
лучше бы не задавал, чтобы объект был в памяти.
"слипов" зачем то на вставлял, внутри итерации лишние. ИМХО.
и код бы "причесал"... трудно ориентироваться.
← →
sniknik © (2012-08-27 20:33) [17]> Там если он создается от nil,
проверочное, использую NewXMLDocument
← →
Dennis I. Komarov © (2012-08-27 20:38) [18]
> ну так Terminated проверится только после завершения поиска.
ну и что? Пробежали по каталогу - проверили. А как?
З.Ы.
после переделаю на ReadDirectoryChangesW
← →
Dennis I. Komarov © (2012-08-27 20:41) [19]
> и да
> CoInitialize(nil);
> CoUninitialize;
> должны быть строго парные
Ну вроде так и есть...
Init
try
....
except
...
end;
UnInit...
Далее коней потоку...
← →
Dennis I. Komarov © (2012-08-27 20:44) [20]
> + ты присваиваешь имя файла объекту...
Добавил уже после, когда перенес XML.Create от "к каждому frf файлу, к каждому скану каталога, но это уже так же пытаясь найти где AV
> все одно скидываешь его через SaveToFile
Интерфейс заставляет...
← →
Dimka Maslov © (2012-08-27 20:45) [21]
> Как запустить службу из IDE (или приклеать процесс к коду
Специально для этого и существует attach to process
← →
Dennis I. Komarov © (2012-08-27 20:52) [22]
> и код бы "причесал"... трудно ориентироваться.
... но не исправлялprocedure TThreadConverter.Execute;
var
FRFDir: string;
SearchRec: TSearchRec;
FindResult: Integer;
FRFdata: TFRF;
FileName: TFileName;
iDoc: IXMLDocument;
EStr: AnsiString;
begin
FreeOnTerminate:=true;
FRFDir := GetAllUsersDocumentsDir + "\frf.files"; // Отправить в реестр
CoInitialize(nil);
while not Terminated do try
try {TXMLDocument.Create}
FindResult := FindFirst(FRFDir + "\*.frf", faAnyFile, SearchRec);
while FindResult = 0 do begin
if (SearchRec.Name <> ".") and (SearchRec.Name <> "..") then begin
FRFdata:=DecodeFRF(FRFDir + "\" + SearchRec.Name);
if not Assigned(iDoc) then
iDoc := TXMLDocument.Create(nil);
FileName:=FloatToStr(Time); Delete(FileName, 1, 2);
Filename:=ExtractFilePath(ParamStr(0)) + "Data\" + FileName;
iDoc.Active:=true;
Sleep(100);
iDoc.FileName := FileName;
iDoc.Encoding:="WINDOWS-1251";
iDoc.AddChild("ED101", "urn:cbr-ru:ed:v2.0");
with iDoc.DocumentElement do begin
SetAttributeNS("PaytKind", "", "1");
...
end;
iDoc.SaveToFile(FileName);
Sleep(100);
iDoc.Active := false;
iDoc.XML.Clear;
if RenameFile(FileName, FileName + ".xml") then
DeleteFile(FRFDir + "\" + SearchRec.Name);
Sleep(100);
end;
Sleep(1000);
FindResult := FindNext(SearchRec);
end;
FindClose(SearchRec);
finally
TXMLDocument(iDoc).Free;
FreeAndNil(iDoc);
end;
Sleep(5000);
except
on E: Exception do
// пишем в файл
end;
CoUninitialize;
end;
end.
← →
Dennis I. Komarov © (2012-08-27 20:58) [23]
> Специально для этого и существует attach to process
Нашел :) Пасиб, Дим ;)
← →
Dennis I. Komarov © (2012-08-27 21:00) [24]
> проверочное, использую NewXMLDocument
Пример кода можно?
← →
Dennis I. Komarov © (2012-08-27 21:16) [25]
> "слипов" зачем то на вставлял, внутри итерации лишние. ИМХО.
Согласен, но не критично...
← →
sniknik © (2012-08-27 21:18) [26]
var
XMLDoc: IXMLDocument;
begin
XMLDoc:= NewXMLDocument;
try
XMLDoc.Encoding:= "windows-1251";
XMLDoc.AddChild("test").SetAttributeNS("val", "", 12345);
XMLDoc.SaveToFile("d:\primer.xml");
finally
XMLDoc:= nil;
end;
end;
← →
Dennis I. Komarov © (2012-08-27 21:25) [27]Еще вопрос: Assigned к интерфейсу применим или достатчно проверить на nil?
← →
Dimka Maslov © (2012-08-27 21:57) [28]
> Еще вопрос: Assigned к интерфейсу применим или достатчно
> проверить на nil?
Вроде как Аssigned и есть сравнение с нулём, только чтобы лишние скобки не писать.
← →
sniknik © (2012-08-27 22:12) [29]> Еще вопрос: Assigned к интерфейсу применим или достатчно проверить на nil?
нет смысла, по твоему коду... создание в начале работы и "убиение", в конце гораздо быстрее, чем проверка на "созданость" и очистка... также как и делете построчное дольше, чем удалить и создать весь файл, и очистка позаписьно таблицы в сравнении с транкейтом, и т.д., только порядки другие. удалить 1 большой кусок всегда проще чем тысячу мелких его составляющих.
← →
Dennis I. Komarov © (2012-08-28 20:56) [30]
> Dimka Maslov © (27.08.12 21:57) [28]
> Вроде как Аssigned и есть сравнение с нулём, только чтобы
> лишние скобки не писать.
Ну мало ли чего там с этими интерфесами :)
> sniknik © (27.08.12 22:12) [29]
> нет смысла, по твоему коду... создание в начале работы и "убиение", в конце гораздо быстрее, чем проверка на "созданость" и очистка...
Да сперва так и было, это уже после... вернул.
-------------------
AV ловился в [2]
+ поправил
> iDoc := nil;
> CoInitialize(nil);
> CoUninitialize;
> должны быть строго парные, имеет смысл использовать try finally
> проверочное, использую NewXMLDocument
> лучше бы не задавал, чтобы объект был в памяти
Вроде не падает :) Пасиб!
P.S.
Только не понял [11]. Предлагается проверять Terminated на каждой итерации цикла поиска файлов?
← →
sniknik © (2012-08-28 21:24) [31]в [11] главное не это, а "дыра" на "пустом" начале поиска. также чреватая AV.
а терминетед надо смотреть по смыслу, зачем поток, нужна разовая обязательная обработка всех файлов? значит убрать вообще внешний цикл проверки на терминетед. нужна возможность прекратить на любой итерации, а крутился постоянно? значит внести проверку "внутрь" дополнительно. с возможностью прекратить на разовой обработке всего, внутрь вставить, внешний убрать.
короче думай на логикой.
← →
Dennis I. Komarov © (2012-08-28 22:43) [32]А понял... Про Free не дойдя в Create... Я вернул как было: нашли файло-создали iDoc - поработали/сохранили - занилили iDoc...
Сейчас так:
while not Terminated do try
FindResult := FindFirst(FRFDir + "\*.frf", faAnyFile, SearchRec);
while FindResult = 0 do begin
if (SearchRec.Name <> ".") and (SearchRec.Name <> "..") then begin
FRFdata := DecodeFRF(FRFDir + "\" + SearchRec.Name);
iDoc := NewXMLDocument; try
...
... правда сорцов под руками нет, так что возможно где-то ошибся
> а терминетед надо смотреть по смыслу
Не принципиально. Суть смотреть в папку, и если туда падает файло - конвертить его в xml. Поток - чтобы не трогать основной поток службы.
После переделаю его для ReadDirectoryChangesW, но это неприоритетно - теперь надо клиента переписывать...
← →
sniknik © (2012-08-28 23:18) [33]> А понял... Про Free не дойдя в Create...
FindFirst
...
FindClose(SearchRec);
← →
Dennis I. Komarov © (2012-08-29 00:57) [34]Хммм... А где тут AV?
function FindFirst(const Path: string; Attr: Integer;
var F: TSearchRec): Integer;
const
faSpecial = faHidden or faSysFile or faDirectory;
{$IFDEF MSWINDOWS}
begin
F.ExcludeAttr := not Attr and faSpecial;
F.FindHandle := FindFirstFile(PChar(Path), F.FindData);
if F.FindHandle <> INVALID_HANDLE_VALUE then
begin
Result := FindMatchingFile(F);
if Result <> 0 then FindClose(F);
end else
Result := GetLastError;
end;
{$ENDIF}
procedure FindClose(var F: TSearchRec);
begin
{$IFDEF MSWINDOWS}
if F.FindHandle <> INVALID_HANDLE_VALUE then
begin
Windows.FindClose(F.FindHandle);
F.FindHandle := INVALID_HANDLE_VALUE;
end;
{$ENDIF}
← →
sniknik © (2012-08-29 01:27) [35]ТУТ, нету. но оно может быть если закрывать уже закрытый объект, как у ТЕБЯ.
а он закрыт
> if Result <> 0 then FindClose(F);
← →
Slym © (2012-08-29 13:22) [36]1. по процедуркам раскидать слабо?
2. слипы зачем?
← →
Slym © (2012-08-29 14:40) [37]
unit frdecode;
interface
uses Windows, Messages, SysUtils, Classes, ActiveX;
type
TThreadConverter = class(TThread)
private
FatalException:boolean;
protected
procedure Execute; override;
procedure ScanDir;
procedure ProcessFile(const FileName:string);
procedure WaitForNewIteration(const Delay:integer);
procedure LogException(E: Exception);
end;
implementation
{ TThreadConverter }
procedure TThreadConverter.Execute;
begin
FatalException:=false;
CoInitialize(nil);
try
while not Terminated do
try
ScanDir;
WaitForNewIteration(5000);
except
on E: Exception do
begin
LogException(E);
if FatalException then
break;
end;
end;
finally
CoUninitialize;
end;
end;
procedure TThreadConverter.ScanDir;
var
FRFDir:string;
SearchRec: TSearchRec;
FindResult: Integer;
begin
//FRFDir := GetAllUsersDocumentsDir + "\frf.files"; // Отправить в реестр
FindResult := FindFirst(FRFDir + "\*.frf", faAnyFile, SearchRec);
while FindResult = 0 do
begin
// . .. - отсекаются маской ты же не *.*
try
ProcessFile(FRFDir + "\" + SearchRec.Name);
except
on E: Exception do
begin
LogException(E);
if FatalException then
break;
end;
end;
FindResult := FindNext(SearchRec);
end;
FindClose(SearchRec);
end;
procedure TThreadConverter.ProcessFile(const FileName: string);
begin
//делай свой xml
end;
procedure TThreadConverter.LogException(E: Exception);
begin
//тут пишем логи
end;
procedure TThreadConverter.WaitForNewIteration(const Delay: integer);
begin
//Долгий слип плохо надо делать на WaitFor(Эвентах)
end;
end.
← →
Dennis I. Komarov © (2012-08-29 19:58) [38]
> но оно может быть если закрывать уже закрытый объект, как
> у ТЕБЯ.
> а он закрыт
> > if Result <> 0 then FindClose(F);
не может (или я не вижу), т.к. вызов FindClose(F) однозначно присвоит F.FindHandle значение INVALID_HANDLE_VALUE и повторная попытка закрыть закончиться на:procedure FindClose(var F: TSearchRec);
begin
{$IFDEF MSWINDOWS}
if F.FindHandle <> INVALID_HANDLE_VALUE then
begin
Windows.FindClose(F.FindHandle);
F.FindHandle := INVALID_HANDLE_VALUE;
end;
{$ENDIF}
где я не прав?
← →
Dennis I. Komarov © (2012-08-29 20:05) [39]
> Slym © (29.08.12 13:22) [36]
> 1. по процедуркам раскидать слабо?
Ну кроме как создание самого xml, смысла особого не вижу. А вот FrfToXml() не только в отдельную процедуру, но в отдельный модуль отправить...
Но суть была не в этом...
> 2. слипы зачем?
От рукоблудия... Когда ловишь AV и не знаешь откуда оно - и не такое появится :)
← →
sniknik © (2012-08-29 20:29) [40]> однозначно присвоит
если бы это было так однозначно то ветка с приведенным мной условием где закрывается, была бы не нужна совсем...
> где я не прав?
разбираешь частный случай, когда тебе говорят о вероятности, и правиле избежать проблем в любом.
← →
sniknik © (2012-08-29 20:39) [41]> разбираешь частный случай
притом, выдуманный частный случай... т.к. вариант/ветка с закрытием в начале поиска ВСЕГДА происходит с хендлом не равным INVALID_HANDLE_VALUE, что ты почему то принял с точностью до наоборот.
← →
Dennis I. Komarov © (2012-08-29 22:43) [42]
> с закрытием в начале поиска ВСЕГДА
Как FindClose раньше FindFirst?
← →
sniknik © (2012-08-30 00:59) [43]ЧУДОМ, ...
не можешь думать, так хоть поиском воспользуйся.
Страницы: 1 2 вся ветка
Форум: "Начинающим";
Текущий архив: 2013.03.22;
Скачать: [xml.tar.bz2];
Память: 0.6 MB
Время: 0.068 c