Попинайте код, предложите альтернативы :)

← →
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 и есть сравнение с нулём, только чтобы лишние скобки не писать.

> Еще вопрос: Assigned к интерфейсу применим или достатчно проверить на nil?
нет смысла, по твоему коду... создание в начале работы и "убиение", в конце гораздо быстрее, чем проверка на "созданость" и очистка... также как и делете построчное дольше, чем удалить и создать весь файл, и очистка позаписьно таблицы в сравнении с транкейтом, и т.д., только порядки другие. удалить 1 большой кусок всегда проще чем тысячу мелких его составляющих.

> 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 на каждой итерации цикла поиска файлов?

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

А понял... Про 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, но это неприоритетно - теперь надо клиента переписывать...

> А понял... Про Free не дойдя в Create...
FindFirst
...
FindClose(SearchRec);

Хммм... А где тут 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}

ТУТ, нету. но оно может быть если закрывать уже закрытый объект, как у ТЕБЯ.
а он закрыт
> if Result <> 0 then FindClose(F);

1. по процедуркам раскидать слабо?
2. слипы зачем?

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.

> но оно может быть если закрывать уже закрытый объект, как
> у ТЕБЯ.
> а он закрыт
> > 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}

где я не прав?

> Slym © (29.08.12 13:22) [36]
> 1. по процедуркам раскидать слабо?

Ну кроме как создание самого xml, смысла особого не вижу. А вот FrfToXml() не только в отдельную процедуру, но в отдельный модуль отправить...
Но суть была не в этом...

> 2. слипы зачем?

От рукоблудия... Когда ловишь AV и не знаешь откуда оно - и не такое появится :)

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

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

Попинайте код, предложите альтернативы :) Найти похожие ветки