Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

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


Страницы:   1 2 3

Dennis I. Komarov ©   (2012-08-27 19:26:00) 

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 без обертки, пока искал столько баталий начитался по поводу хмл, так что можно сказать есть очередной повод :)

Dennis I. Komarov   (2012-08-27 20:58:00) [21]


> Специально для этого и существует attach to process

Нашел :) Пасиб, Дим ;)

Dennis I. Komarov   (2012-08-27 20:52:00) [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.

Dimka Maslov   (2012-08-27 20:45:00) [23]


> Как запустить службу из IDE (или приклеать процесс к коду


Специально для этого и существует attach to process

Dennis I. Komarov   (2012-08-27 20:44:00) [24]


> + ты присваиваешь имя файла объекту...

Добавил уже после, когда перенес XML.Create от "к каждому frf файлу, к каждому скану каталога, но это уже так же пытаясь найти где AV

> все одно скидываешь его через SaveToFile

Интерфейс заставляет...

Dennis I. Komarov   (2012-08-27 20:41:00) [25]


> и да
> CoInitialize(nil);
> CoUninitialize;
> должны быть строго парные

Ну вроде так и есть...
Init
try
....
except
...
end;
UnInit...
Далее коней потоку...

Dennis I. Komarov   (2012-08-27 20:38:00) [26]


> ну так Terminated проверится только после завершения поиска.

ну и что? Пробежали по каталогу - проверили. А как?
З.Ы.
после переделаю на ReadDirectoryChangesW

sniknik   (2012-08-27 20:33:00) [27]

> Там если он создается от nil,
проверочное, использую NewXMLDocument

sniknik   (2012-08-27 20:32:00) [28]

+ ты присваиваешь имя файла объекту... что насколько помню заставляет документ его поддерживать, в файле, что, ИМХО, стабильности не добавляет. тем более в конце все одно скидываешь его через SaveToFile.
лучше бы не задавал, чтобы объект был в памяти.
"слипов" зачем то на вставлял, внутри итерации лишние. ИМХО.

и код бы "причесал"... трудно ориентироваться.

Dennis I. Komarov   (2012-08-27 20:26:00) [29]


> RWolf ©   (27.08.12 20:15) [10]
> интерфейсы не предназначены для того, чтобы их освобождали
> вызовом Free.
> вся суть интерфейса в автоматическом освобождении реализующего
> его объекта, когда он становится не нужен.
> если уж так хочется освободить объект через интерфейс, это
> делается так:
> iDoc := nil;

Пасиб, я с ними до этого не работал. Легыч говорил - глянь в конструктор... Там если он создается от nil, то он работает в режиме интерфейса...

RWolf   (2012-08-27 20:24:00) [30]

ну так Terminated проверится только после завершения поиска.

Dennis I. Komarov   (2012-08-27 20:23:00) [31]


>  что будет если не найдено сразу. и выход из потока по терминейту
> у тебя "закрыт" циклом поиска...

Это почему?
while not Terminated nbegin
FindFirst
while ... do begin
...
FindNext
end;
FindClose
Sleep
end;
Где не так?

sniknik   (2012-08-27 20:22:00) [32]

и да
CoInitialize(nil);
CoUninitialize;
должны быть строго парные, имеет смысл использовать try finally

sniknik   (2012-08-27 20:17:00) [33]

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

RWolf   (2012-08-27 20:15:00) [34]

интерфейсы не предназначены для того, чтобы их освобождали вызовом Free.
вся суть интерфейса в автоматическом освобождении реализующего его объекта, когда он становится не нужен.
если уж так хочется освободить объект через интерфейс, это делается так:
iDoc := nil;

Dennis I. Komarov   (2012-08-27 20:12:00) [35]


> 2 команды с не нулевой вероятностью AV на каждой. на всякий
> пожарный... ага.

Ну быть может, но почему такая нестабильная?

sniknik   (2012-08-27 20:07:00) [36]

> Добил на всякий :)
2 команды с не нулевой вероятностью AV на каждой. на всякий пожарный... ага.

Dennis I. Komarov   (2012-08-27 20:02:00) [37]


> при том что работает в варианте интерфейса

Ну я его и создавал как TXML..., так и убил :-[

Dennis I. Komarov   (2012-08-27 19:58:00) [38]


> ?????????????/
>      TXMLDocument(iDoc).Free;
>      FreeAndNil(iDoc);

Добил на всякий :) Это уже извращения в надежде "А вдруг"...
Сперва iDoc создавался перед FindFirst, Потом подумал назачем, если файлов нет - дописал Assigned, после дорисовал FreeAndNil, на всякий пожарный... Без него поведение такое же

sniknik   (2012-08-27 19:57:00) [39]

F8 + Find Error

sniknik   (2012-08-27 19:56:00) [40]

при том что работает в варианте интерфейса

Страницы:   1 2 3

Наверх

Титульная страница Поиск, карта сайта Написать письмо