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

sniknik   (2012-08-30 00:59:00) [1]

ЧУДОМ, ...
не можешь думать, так хоть поиском воспользуйся.

Dennis I. Komarov   (2012-08-29 22:43:00) [2]


> с закрытием в начале поиска ВСЕГДА

Как FindClose раньше FindFirst?

sniknik   (2012-08-29 20:39:00) [3]

> разбираешь частный случай
притом, выдуманный частный случай... т.к. вариант/ветка с закрытием в начале поиска ВСЕГДА происходит с хендлом не равным INVALID_HANDLE_VALUE, что ты почему то принял с точностью до наоборот.

sniknik   (2012-08-29 20:29:00) [4]

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

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

Dennis I. Komarov   (2012-08-29 20:05:00) [5]


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

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

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

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

Dennis I. Komarov   (2012-08-29 19:58:00) [6]


> но оно может быть если закрывать уже закрытый объект, как
> у ТЕБЯ.
> а он закрыт
> > 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_VALUEthen
begin
  Windows.FindClose(F.FindHandle);
  F.FindHandle := INVALID_HANDLE_VALUE;
end;
{$ENDIF}


где я не прав?

Slym   (2012-08-29 14:40:00) [7]

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.

Slym   (2012-08-29 13:22:00) [8]

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

sniknik   (2012-08-29 01:27:00) [9]

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

Dennis I. Komarov   (2012-08-29 00:57:00) [10]

Хммм... А где тут 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-28 23:18:00) [11]

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

Dennis I. Komarov   (2012-08-28 22:43:00) [12]

А понял... Про 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 21:24:00) [13]

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

Dennis I. Komarov   (2012-08-28 20:56:00) [14]


> 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-27 22:12:00) [15]

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

Dimka Maslov   (2012-08-27 21:57:00) [16]


> Еще вопрос: Assigned к интерфейсу применим или достатчно
> проверить на nil?


Вроде как Аssigned и есть сравнение с нулём, только чтобы лишние скобки не писать.

Dennis I. Komarov   (2012-08-27 21:25:00) [17]

Еще вопрос: Assigned к интерфейсу применим или достатчно проверить на nil?

sniknik   (2012-08-27 21:18:00) [18]

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:16:00) [19]


> "слипов" зачем то на вставлял, внутри итерации лишние. ИМХО.

Согласен, но не критично...

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


> проверочное, использую NewXMLDocument

Пример кода можно?

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

Наверх

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