/
dorofeev_denis
/
Find_objects_xml
Обзор
Документация
Войти
/
dorofeev_denis
/
Find_objects_xml
Код
Запросы
0
Задачи
Вики
Пакеты
0
Релизы
0
CI/CD
Аналитика
Безопасность
master
Unit1.pas
190 строк
7 KB
dorofeev_denis
Загрузка файлов
07 май 2026, 14:56
Верифицирован
07 май 2026, 14:56
3e1ae4c
Код
Авторство
О чём код?
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Graphics, Controls, Forms, Dialogs, StdCtrls, MSXML2_TLB, ComCtrls, ExtCtrls, Menus, xmldom, XMLIntf, msxmldom, XMLDoc, UNIT_XML, UNIT_TEXT_FILES_AND_FOLDERS, Classes, UniProvider, OracleUniProvider, DB, MemDS, DBAccess, Uni; const parcel = '/����/��������'; empty_string = 1; fill_string = 0; type TForm1 = class(TForm) StatusBar1: TStatusBar; Panel3: TPanel; Panel4: TPanel; StaticText3: TStaticText; Button1: TButton; Label2: TLabel; EditNum: TEdit; Memo1: TMemo; Label1: TLabel; Edit_zd: TEdit; Label3: TLabel; Edit_pom: TEdit; Label4: TLabel; Edit_zu: TEdit; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; fn_xml, p_date, p_time: string; ErrorFile: TextFile; //��������� ����� ��� ������ ���������, ���������� � ����������� �������� xml_doc: IXMLDOMDocument2; //��� ������������ ����������, ������� ����� �������� � xml path_exe: string; //���� �� exe ����� number_of_file, num_total_files: integer; file_name, path_script_search, path_script_update: string; num_zu, num_zd, num_pom: integer; implementation {$R *.dfm} procedure Memo_log(msg: widestring; par: byte); begin //p_date:=DateToStr(now); p_time:=TimeToStr(now); Form1.Memo1.Lines.Add(p_time+' - '+msg); case par of empty_string: Form1.Memo1.Lines.Add(''); end; end; procedure MainProcessNode(number_of_file, num_total_files: integer);//(rootNodesStr: string; fileCnt, fileTot: Integer); var node: IXMLDOMNode; node_list: IXMLDOMNodeList; i, n: integer; begin try {��� selectNodes �� ����������� ������ ���������, �� ���� ���� ������ ����� �� ����� for ��� �� �����������, ������ �� �����. ���� �� ������������ ����������� ��������� ������ ���� node_list.item[i].childNodes, �� ��� �������� ����� ����� ����� ����� ������ ����� ���������������, ����� for �� ������� � ����� ������. ��� ��� ������ ����� ���� while} node_list:= xml_doc.selectNodes(parcel); n:= node_list.length; //���������� ��������� ����� person for i:= 0 to n - 1 do begin node:= node_list.item[i]; //�������� ���������� �� if Assigned(node.selectSingleNode('./������')) then if Assigned(node.selectSingleNode('./������').attributes.getNamedItem('�����������')) then begin num_zu:= num_zu + 1; Form1.Edit_zu.Text:= IntToStr(num_zu); end; if Assigned(node.selectSingleNode('./����������')) then if Assigned(node.selectSingleNode('./����������').attributes.getNamedItem('�����������')) then begin num_zd:= num_zd + 1; Form1.Edit_zd.Text:= IntToStr(num_zd); end; if Assigned(node.selectSingleNode('./���������')) then if Assigned(node.selectSingleNode('./���������').attributes.getNamedItem('������������')) then begin num_pom:= num_pom + 1; Form1.Edit_pom.Text:= IntToStr(num_pom); end; Form1.EditNum.Text:= '���� ' + IntToStr(number_of_file) + ' - ' + IntToStr(num_total_files) + '; ������ ' + IntToStr(i + 1) + ' - ' + IntToStr(n); Application.ProcessMessages; end except on E:Exception do begin //Form1.UniConnection1.Rollback; //����� ���������� � ������ ������ Memo_log('������ ��� ��������� ������� � i = ' + chr(9) + IntToStr(i) + chr(9) + e.message, empty_string); Write_Text_File(ErrorFile, path_exe + 'LOG\Errors.log', '������ ��� ��������� ������� � i = ' + chr(9) + IntToStr(i) + chr(9) + e.message); Form1.Button1.Enabled:= true; //��� ������ ���������� � �������� ����� ������� ������ ���������� ������� ���������� Form1.StatusBar1.SimpleText:= '������ ��������� ��������� � ��������!!!'; Exit //���� �� ��������� ������ ��������, � ���������� ��� �� ��������� end; end; end; function NumOfParcels(nodesStr: string): Integer; begin Result := xml_doc.selectNodes(nodesStr).length; end; procedure MainProcessXmlFile(number_of_file, num_total_files: integer; path_fname: string); begin xml_doc:=CoDOMDocument.Create(); //�������� ��������� {���������� �������� ������ xml: ��������� ����� ��������� xml ����� �� ������. ��� ������ ������������ ���� ���� xml, ���������� ������ � �.�. } xml_doc.async:=false; //���������� ������������ �������� Form1.StatusBar1.SimplePanel:= true; //��� ����, ����� ����������� ���� � SimpleText Form1.StatusBar1.SimpleText := '�������������� ���� ' + file_name + ' . . .'; if not xml_doc.load(path_fname) then Write_Text_File(ErrorFile, path_exe + 'LOG\Errors.log', '�� ������� ��������� XML-���� ' + file_name + ' ' + DateTimeToStr(now)) else begin xml_doc.setProperty('SelectionLanguage','XPath'); //����� ������� ����� XPath ���������� ��������� MainProcessNode(number_of_file, num_total_files); //�������� ������� ��������� xml ������ end; {������������ ������������ ������ ��-��� ����������} // xml_doc:= nil; end; procedure TForm1.Button1Click(Sender: TObject); var SearchResult: TSearchRec; FileFind: integer; path_fname, search_str, path_dir_xml_load: string; begin Button1.Enabled:=false; path_exe:=ExtractFilePath(Application.ExeName); //���� �� exe ����� {�������� �������� ���� ��������� � ���� ������, ���� ��� ���} Create_Directory(path_exe,'LOG'); {�������� �������� �������������� xml ������, ���� ��� ���} Create_Directory(path_exe,'XML_LOAD'); {��� ������} Create_Text_File(ErrorFile,path_exe + 'LOG\Errors.log'); path_dir_xml_load:= path_exe + 'XML_LOAD'; //��������� ���� �� ����� search_str:= path_dir_xml_load + '\*.xml'; //��������� ���� �� ������ XML num_total_files:= GetNumOfFiles(search_str); //����� �������������� ������ xml number_of_file:= 0; //���������� ����� ��������������� ����� FileFind:= FindFirst(search_str, faAnyFile, SearchResult); //����� ���� ����� .xml ��� �� ���������������� ��������� if FileFind = 0 then begin while FileFind = 0 do begin number_of_file:= number_of_file + 1; path_fname:= path_dir_xml_load + '\' + SearchResult.Name; file_name:= SearchResult.Name; MainProcessXmlFile(number_of_file, num_total_files, path_fname); //�������� ������� FileFind:= FindNext(SearchResult); end; Form1.StatusBar1.SimpleText:= '������� ��������� ������ ��������!'; end else //�� ���� ���� xml �� ������ MessageDlg('����� *.xml � ����� XML_LOAD �� �������!', mtInformation,[mbOK],0); FindClose(SearchResult); //������������ ������������ ������ �� ��� ���������� sr Button1.Enabled:=true end; end.