......
uses
  Classes, SysUtils, StrUtils, Forms, Dialogs, LConvEncoding, ComCtrls;

type
    TInsertXMLFunc = function(AXMLCut: AnsiString; var ANameFunction: String): boolean;
.....................................

class function TFileOMS.XMLChopper(AFile_Name:String; ATeg: AnsiString; AInsertXMLFunc: TInsertXMLFunc; AProgressBar: TProgressBar): integer;
var   CH : AnsiChar;  NameFunc: String;
      FText      : TFileStream;
      Length1, Length2 : integer;
      Teg1, Teg2, Value1, Value2, XMLCut: AnsiString;
begin
 Result:=0;
 try   //  ATeg:='PERS';
  Teg1:=ATeg+'>';  //  PERS>
  Teg2:='/'+Teg1; // /PERS>
  Length1:=Length(Teg1); //  5
  Length2:=Length(Teg2); //  6
  SetLength(Value1, Length1);
  SetLength(Value2, Length2);
  AProgressBar.Position:=0;
  FText:=TFileStream.Create(AFile_Name,fmShareDenyNone);   //открываем файл
  AProgressBar.Max:=FText.Size;
  FText.Seek(0,soFromBeginning);    //переходим в начало
  repeat
      FText.Read(CH,1);
      if (CH='<') then
        begin
           FText.ReadBuffer(Pointer(Value1)^, Length1);
           if Value1=Teg1   //   'PERS>'
             then begin
                    XMLCut:='<'+Teg1;   //  '<PERS>'
                    repeat
                        FText.Read(CH,1);
                        XMLCut:=XMLCut+CH;
                        if (CH='<') then
                           begin
                              FText.ReadBuffer(Pointer(Value2)^, Length2);
                              XMLCut:=XMLCut+Value2;
                              if Value2=Teg2  //   '/PERS>'
                                 then begin
                                       AProgressBar.Position:=FText.Position;
                                       if (not AInsertXMLFunc(XMLCut, NameFunc))
                                          then begin
                                                 XMLCut:=CP1251ToUTF8(XMLCut);
                                                 ShowMessage('В функции '+NameFunc+ ' неудачная вставка блока: '+ XMLCut);
                                                 exit;
                                               end;
                                        inc(Result);
                                        break;
                                      end
                           end;
                    until FText.Position>=FText.Size;
                  end;
        end;
  until FText.Position>=FText.Size;
 finally
     FreeAndNil(FText);
 end;
end;

function InsertXML_PERS_IntoFB(AXMLCut: String; var ANameFunction: String): boolean;
begin
   Result:=False;
   ANameFunction:='Добавление песональных данных в FB';
 //  Form_Main.SPxmlInsertZAP.ParamByName('XML_BODY_PERS').AsString:=CP1251ToUTF8(AXMLCut);   -- или
   Form_Main.SPxmlInsertZAP.ParamByName('XML_BODY_PERS').AsString:=AXMLCut;
   Form_Main.SPxmlInsertZAP.ExecSQL;
   Result:=true;
end;

procedure TForm_Main. .......................... ;
var InsertRecord: Integer;
begin
 try
......
      InsertRecord:=TFileOMS.XMLChopper(TmpDir+AFileOMS.NamePasp, 'PERS', @InsertXML_PERS_IntoFB, ProgressBar1);
  //    InsertRecord:=TFileOMS.XMLChopper(TmpDir+AFileOMS.NameMed, 'ZAP', @InsertXML_ZAP_IntoFB, ProgressBar1);

...................
      Memo1.Lines.Add('                Загружено в БД записей: '      +IntToStr(InsertRecord) );

 finally
     //
 end;

end;