Часть текста скрыта
  
  

      ***************************************************************************************************************************
* Предлагается как замена штатного оператора FGETS из открытого хендла файла (1N)
* Для буферизации требуется передавать переменную-буфер (@2), ОБЯЗАТЕЛЬНО ССЫЛКОЙ (т.е эта переменная д.б. определена снаружи этой функции, и доступна по записи из этой п/п),
* т.к. она будет по мере чтения обрезаться слева (на длину возвращаемого этой ф-ией элемента),
* и иногда дополняться справа дочитываемыми данными из файла. Перед первым вызовом значение буфера м.б. любое, КРОМЕ СТРОКИ ДЛИНОЙ >0.
* (Строка буфера длиной >0 считается уже считанным содержимым файла... Это можно использовать для разбора XML-содержимого прямо в буфере...)
* В необязательном параметре [3N] можно указать тип ожидаемых элементов в файле, (XML,HTML и др.), 
* по умолчнию [3N]=0 - ожидаемый элемент - это строка, разделитель ВКПС, или ВК, или ПС, без перекодировок
* Данная ф-ия читает файл только ПОСЛЕДОВАТЕЛЬНО, что дает надежду (НЕТ, НЕ НАДЕЙСЯ) прочитать элементы из файла длиной >2(4?) Гб штатными ф-иями VFP
* Использует только VFP-ф-ии "низкого уровня" FREAD и FEOF... (заменил их на API, с гарантией чтения больших файлов...)
* Возвращает ОДИН запрошенный элемент из файла (при умолчательных режимах - очередную строку, без разделителя), или NULL (EOF)
***************************************************************************************************************************
* Внимание! Оказалось, что файлы >2Г открываются FOPEN, НО: FEOF() сразу возвращает .T., также FREAD после границы 2Г приводит к зависанию фокс (Internal consistent error)
* так-что без API не получится. * См. forum.foxclub.ru
***************************************************************************************************************************
* Чтобы не делать аналогов FOPEN/FCLOSE то эта ф-ия будет также:
*   - при вызове с одним параметром (1C) - открывать файл, и вернуть хендл, или NULL при ошибке
*   - при вызове с одним параметром (1N) - закрыть файл, и вернуть неNULL, или NULL при ошибке
***************************************************************************************************************************
* См. MSDN про ReadFile: msdn.microsoft.com
*!*    [System.Runtime.InteropServices.DllImport("kernel32", SetLastError = true, ThrowOnUnmappableChar = true, CharSet = System.Runtime.InteropServices.CharSet.Unicode)]
*!*       static extern unsafe System.IntPtr CreateFile
*!*       (
*!*           string FileName,          // file name
*!*           uint DesiredAccess,       // access mode
*!*           uint ShareMode,           // share mode
*!*           uint SecurityAttributes,  // Security Attributes
*!*           uint CreationDisposition, // how to create
*!*           uint FlagsAndAttributes,  // file attributes
*!*           int hTemplateFile         // handle to template file
*!*       );
*!*       [System.Runtime.InteropServices.DllImport("kernel32", SetLastError = true)]
*!*       static extern unsafe bool ReadFile
*!*       (
*!*           System.IntPtr hFile,      // handle to file
*!*           void* pBuffer,            // data buffer
*!*           int NumberOfBytesToRead,  // number of bytes to read
*!*           int* pNumberOfBytesRead,  // number of bytes read
*!*           int Overlapped            // overlapped buffer
*!*       );
*!*       [System.Runtime.InteropServices.DllImport("kernel32", SetLastError = true)]
*!*       static extern unsafe bool CloseHandle
*!*       (
*!*           System.IntPtr hObject // handle to object
*!*       );
***************************************************************************************************************************
* Собственно операции чтения из файла. См. использование ReadFile msdn.microsoft.com
* Штатный фоксовый вариант - просто FOPEN/FREAD...
#DEFINE  LowLevelBadHandle  (ISNULL(m.parHandle) .OR. m.parHandle=-1)  && в FGETSs можно указать .NULL. в качестве HANDLE, чтобы разобрать заранеез заполненный буфер, как будто он был считан из файла.

#DEFINE  LowLevelOPEN       FOPENs(m.parHandle)
#DEFINE  LowLevelFEOF       (LowLevelBadHandle .OR. FEOFs(m.parHandle))
#DEFINE xLowLevelFREAD      IIF(LowLevelBadHandle, "", FREADs(m.parHandle, m.x))
#DEFINE  LowLevelFREADbuff  100000  && число байт, рекомендуемое для чтения в 1 прием. Например, в фоксовом FREAD ограничение 64К... Однако в этом буфере будут строковые операции типа AT и SUBSTR !

* Собственно API-операции записи в файла. Штатный фоксовый вариант - просто FCREATE/FPUTS/FWRITE...
#DEFINE  LowLevelFCREATE    FCREATEs(m.parHandle)
#DEFINE  LowLevelOPENrw     FOPENs(m.parHandle, 2)
#DEFINE  LowLevelFWRITE     FWRITEs(m.parHandle,

#DEFINE xLowLevelFSEEKabs   IIF(LowLevelBadHandle, CREATEBINARY(""), FSEEKs(m.parHandle, m.x, 0))
#DEFINE xLowLevelFSEEK      IIF(LowLevelBadHandle, CREATEBINARY(""), FSEEKs(m.parHandle, m.x, 1))
#DEFINE xLowLevelFSEEKend   IIF(LowLevelBadHandle, CREATEBINARY(""), FSEEKs(m.parHandle, m.x, 2))
#DEFINE  LowLevelFCLOSE     FCLOSEs(m.parHandle)



****************************************************************************************************
FUNCTION FGETSs
LPARAMETERS m.parHandle, m.parBuff, m.parModa
PRIVATE ALL LIKE ?
m.p = PCOUNT()
#DEFINE Самовызов  FGETSs

****************************************************************************************************
* Спецрежим - открытие файла (1C), по чтению, возвращает хендл N, или NULL
*  Или закрытие файла (1N). Возвращает .T. при успехе, или NULL
IF m.p=1
   m.r = .NULL.  && Внимание! При неуспехе вернем NULL (а не -1 как обычный FOPEN)
   IF VARTYPE(m.parHandle)="C"  && открытие файла, по чтению
      IF !EMPTY(m.parHandle) .AND.;
         FILE(m.parHandle,1)
         m.h = LowLevelOPEN
         m.r = IIF(m.h=-1, m.r, m.h)
      ENDIF
   ELSE  && закрытие файла
      IF VARTYPE(m.parHandle)="N" .AND.;
         !m.parHandle=-1
         m.h = LowLevelFCLOSE
         m.r = IIF(!m.h, m.r, .T.)
      ENDIF
   ENDIF
   RETURN m.r
ENDIF  && открытие файла (1C)

****************************************************************************************************
* Собственно чтение элемента из хендла (1N)
m.m = IIF(m.p<3 .OR. ISNULL(m.parModa) .OR. EMPTY(m.parModa), "", m.parModa)  && тип элементов в файле (ум. - строки с разд. ВКПС)
m.m = ICASE(!VARTYPE(m.m)="N",  m.m,;       && тип файла задан текстом, а не числом
            m.m=0,              "",;        && текстовый файл с разделителями ВК-ПС
            m.m=1,              "XML",;     && XML-файл, любой, междутэговое содержимое (МТС), состоящее только из разделителей ВК-ПС, будет игнорироваться, и не возвращаться
            m.m=1.1,            "XMLcr",;   && XML-файл с разделителями ВК-ПС. Обычно 1тэг - одна строка, но 2017.05: разрешил атрибуты тэга размещать в отдельной строке шаблона!
            m.m=2,              "HTML",;    && пока не нужно, вроде, достаточно опции "XML"
            m.m=3,              "ZIP",;     && читалка блоков ZIP-файла с опознаванием блоков и их структуры (например, "PK"+0h0101). Возвращает блок в виде обьекта
            m.m=3.1,            "ZIPh",;    && тоже, но без физического чтения собствено zip-части блока (только заголовок блока, ДО его собственно ZIP-части)
            m.m=3.9,            "ZIPsfx",;  && позиционирование на 1й ZIP-блок в в EXE/SFX/ZIP файле. Возвращает T, если удалось позиционировать указатель
                                .NULL.)
IF ISNULL(m.m)
   ERROR "Неверное задание типа файла"
   RETURN .NULL.
ENDIF

LOCAL m.mm  && Подмода. После . можно задать подопцию, например, ZIP.eCD - создает и возвращает пустой обьект ZIP-блока eCD
m.mm = ALLTRIM(GETWORDNUM(" "+m.m, 2, "."))
m.m  = ALLTRIM(GETWORDNUM(" "+m.m, 1, "."))

IF TYPE("m.parBuff",1)="A"  && буфер задан массивом, значит надо наполнить этот массив. В случае ZIP - файловой структурой архива.
   m.m = "@"+m.m
ENDIF

* Микропрограмма извлечения одного элемента из буфера [и из файла].
* См. микропрограммный автомат (МПА) ниже (Внимание! Микрокоманда дочтения "?" возвращает МПА к выполнению микропрограммы сначала!)
m.q = ICASE(EMPTY(m.m),   "Ses  ?I",;      && ожидаем в файле строки с разделителями ВК[ПС], если не нашли - то подкачка
            m.m="XMLcr",  " e t ?I13",;    && 2017.05 добавил T. Ищем ВК[ПС], если не нашли - то подкачка. 1 - игнорирование пустого МТС (перезапуск микропрограммы), 3 - коррекция внутритэгового содержимомого (убираем ВК, ПС, ТАБ)
            m.m="XML",    " e T ?I13",;    && ищем тэг, если не нашли - то подкачка (Внимание! Микрокоманда T требует предварительной E - Проверка готовности источника к подкачке)
            m.m="HTML",   " e T ?I1",;     && пока почти то-же, что XML
            INLIST(m.m,"ZIP","@ZIP") .AND. !EMPTY(m.mm), "\O",;  && спецветка. Вернуть обьект - пустой ZIP-блок. Предполагается, что его наполнят и запишут командой FPUTSs
            m.m="@ZIP",   "\@",;           && спецветка. Наполнить массив (@2) файловой структурой ZIP-архива. Если M кончается на "?" - не применять декодирование имени файла (просто нативное чтение)
            m.m="ZIPsfx", "\F",;           && спецветка. Поиск ПОСЛЕДНЕГО, а по нему - 1го, блока в ZIP-файле. Возвращает T, если удалось позиционировать
            m.m="ZIPh",   "ze   ?i",;      && тоже, что "ZIP", но без физического чтения собственно zip-частей блоков lFH. Например, для чтения только каталога имен зазипованных файлов
            m.m="ZIP",    "Ze   ?i",;      && если в начале буфера - ZIP-блок, то вернем его как обьект (вырежем из буфера этот ZIP-блок), иначе - вернем NULL
                          "")
IF EMPTY(m.q)
   ERROR "Режим не поддерживается: "+m.m
   RETURN .NULL.
ENDIF

m.m = LTRIM(m.m,1,"@")  && восстановим исходную заданную моду, без добавленной @ (@ уже ушла в микропрограмму)
#DEFINE mКончаетсяЗнакомВПР  RIGHT(m.m,1)="?"  && в микрокоманде \@ это вызовет НЕПЕРЕВОД имен файлов ZIP в предполагаемую кодировку (см. PACKFILE.prg сразу после создания ZIP-файла в VFPCOMPRESS.fll)


* Возвращает пустой обьект - образ ZIP-блока типа mm
IF m.q=="\O"
   RETURN FREADs_ZIP_jflosdbgdsdpofug(m.parBuff, m.m, m.mm)
ENDIF  && это было создание пустого ZIP-блока


* Поиск ПОСЛЕДНЕГО, а по нему - 1го, блока в ZIP-файле. нужно при приеме EXE/SFX-файла (в нем ZIP-содержимое находится в самом конце, причем последний блок - eCD)
* Возвращает .T., если позиционирование произошло успешно, при ошибке в структуре файла возвращает .F.
IF m.q=="\F"
   m.parBuff = ""  && стираем буфер, т.к. мы будем двигать указатель в файле, и буфер уже не будет соответствовать положению в файле... Чтобы этим не озабачивался пользователь ф-ии.
   m.r = .F. && возвращаемое значение - флаг успешности позиционирования на 1й ZIP-блок EXE/SFX/ZIP-файла
   m.x = 0   && измерим размер файла (встанем в его конец, на 0 байтов от конца)
   m.x = xLowLevelFSEEKend   && абсолютная позиция в файле (здесь - размер файла)
   IF qEVAL(m.x, ">", 1000)  && прочитаем 1000 байтов В КОНЦЕ файла, но не более
      m.x = -1000
      m.x = xLowLevelFSEEKend
   ELSE  && файл размером 1000 или менее, прочитаем весь
      m.x = 0
      m.x = xLowLevelFSEEKabs
   ENDIF
   m.x = 1000
   m.b = xLowLevelFREAD  && вот последние 1000 байт файла
   m.l = 0       && счетчик вхождений сигнатуры ZIP-блока ("PK") с конца, чтобы поймать действительно последний ZIP-блок... Это должен быть блок eCD...
   m.o = .NULL.  && собственно искомый последний ZIP-блок
   DO WHILE .T.
      m.l = m.l + 1
      m.i = RAT("PK", m.b, m.l)
      IF m.i=0
         EXIT
      ENDIF
      m.o = FREADs_ZIP_jflosdbgdsdpofug(SUBSTR(m.b,m.i), "zip")  && попытка интерпретации подстроки как ZIP-блока, ("zip"-сами ZIP-данные читать не будем)
      IF VARTYPE(m.o)="O"  && подстрока интерпретирована как ZIP-блок
         EXIT
      ENDIF
      m.o = .NULL.
   ENDDO
   IF !ISNULL(m.o) .AND. m.o._name_="eCD"  && последний ZIP-блок найден, и тип его - eCD
      m.x = m.o.Offset  && адрес 1го CD-блока в файле
      IF qEVAL(m.x, "=", xLowLevelFSEEKabs)
         m.x = 1000
         m.b = xLowLevelFREAD  && вот 1й CD-блок, и еще немного байтов после него
         m.o = FREADs_ZIP_jflosdbgdsdpofug(m.b, "zip")  && попытка интерпретации подстроки как ZIP-блока, ("zip"-сами ZIP-данные читать не будем)
         IF VARTYPE(m.o)="O" .AND. m.o._name_="CD"  && 1й CD-блок содержит ссылку на 1 lFH-блок. Эта ссылка и есть начало ZIP-содержимого в EXE/SFX/ZIP-файле
            m.x = m.o.Offset  && адрес 1го lFH-блока (это и есть 1й блок в файле ZIP)
            IF qEVAL(m.x, "=", xLowLevelFSEEKabs)
               m.r = .T.
            ENDIF
         ENDIF
      ENDIF
   ENDIF  && последний ZIP-блок найден, и тип его - eCD
   RETURN m.r
ENDIF  && "\F" - это был поиск ПОСЛЕДНЕГО блока в ZIP-файле


* Чтение файловой структуры ZIP-архива, С ТЕКУЩЕГО ПОЛОЖЕНИЯ УКАЗАТЕЛЯ, а потом с автопоиском 1го ZIP-блока, в массив, аналогичный ADIR:
*      [имя, размер, дата, время, аттр(AHRSD), коммент, O-блокCD, O-блокlFH]
* Заполняет массив (@2) и возвращает кол. строк в нем, или возвращает <0 при ошибке
* При успешном нахождении 1го ZIP-блока в файле, по выходу из программы позиция в файле будет стоять на ней (чтобы можно было считать ее, или начать читать ZIP-блоки)
IF m.q=="\@"
   LOCAL m.buffr  && буфер для штатного самовызова
   m.buffr = ""
   LOCAL ARRAY lFH[1]  && временный накопитель блоков lFH - собственно информативных блоков: [offset, сокращенный O-блок lFH]
   EXTERNAL ARRAY parBuff
   DIMENSION parBuff[1]
   =ADDMASS(0, @parBuff)
   m.h = m.parHandle
   m.r = 0       && счетчик строк в выходном массиве
   m.x = 0
   m.t = xLowLevelFSEEK  && N- или Q- положение в файле - положение первого блока в файле архива (в ZIP-файле =0 )
   m.o = Самовызов(m.h, @buffr, m.m)  && чтение ZIP-блока С ТЕКУЩЕГО ПОЛОЖЕНИЯ УКАЗАТЕЛЯ в файле
   IF !VARTYPE(m.o)="O" .OR. m.o._name_="Z2E"  && если из текущего указателя в файле не удалось считать ZIP-блок, или тип файла - EXE(SFX), то поищем 1й блок...
      m.o = .NULL.
      IF Самовызов(m.h, @buffr, "ZIPsfx")  && поиск и позиционирование на 1й ZIP-блок
         m.x = 0
         m.t = xLowLevelFSEEK
         m.o = Самовызов(m.h, @buffr, m.m)  && чтение 1го ZIP-блока
      ENDIF
      m.o = IIF(VARTYPE(m.o)="O", m.o, .NULL.)
   ENDIF
   IF ISNULL(m.o)  && 1й ZIP-блок не найден, значит файл не является SFX(ZIP)-файлом
      m.t = .NULL.
      m.r = -1
   ENDIF
   DO WHILE VARTYPE(m.o)="O"  && перебираем ZIP-блоки в файле
      m.n = m.o._name_  && тип блока (lFH,CD,eCD)
      DO CASE
         CASE m.n="lFH"  && информативный блок, содержит собственно ZIP-данные
              =ADDMASS(@lFH, qEVAL(m.o._offset_), m.o)
         CASE m.n="CD"   && блок, аналогичный информативному, но БЕЗ ZIP-данных. Однако в нем есть ссылка (offset) на соотв. блок lFH
              m.f = m.o.FileName
              m.c = m.o.Dop
              DO CASE
                 CASE mКончаетсяЗнакомВПР  && задано "ZIP?" или "ZIPh?" - не интерпретировать имя файла в OEM, а вернуть его в нативном виде
                      * Внимание! Если файл создан средствами VFPCOMPRESS.fll в среде Windows, то кодовая страница все равно будет указывать на OEM (так устроена .fll),
                      * но имена будут записаны как есть, в кодировке Windows-1251 !
                      * В PACKFILE.prg требуется прочитать имя файла в нативном виде, чтобы сделать вывод, не перекодировать ли имена фйлов внутри созданного файла ZIP!
                 CASE BITTEST(m.o.flags, 11)  && 11=defBitGPBFutf8, ..."filename and comment fields for this file MUST be encoded using UTF-8"
                      m.f = STRCONV(m.f, 11)  && 11 это UTF-8 --> DBCS(ASCII) 
                      m.c = STRCONV(m.c, 11)
                 * Похоже старший байт числа =0 - это DOS,OEM, =10 - это Win NTFS... См. описание ниже
                 CASE INT(m.o.version/256)=0  && кодировка имени файла и комментария - ОЕМ (866 для РФ). Вероятно, если >255 - то без перекодировки (как есть, кодировка неизвестна)
                      m.f = CPCONVERT(CPCURRENT(2), CPCURRENT(1), m.f)
                      m.c = CPCONVERT(CPCURRENT(2), CPCURRENT(1), m.c)
              ENDCASE
              m.a = bitSUBSTR("RHS-DA", m.o.AttributeExt)  && аттрибуты файла в ОС
              =ADDMASS(@parBuff, m.f, m.o.LenghtBefore, m.o.LastDate, m.o.LastTime, m.a, m.c, m.o, .NULL.)  && [name, размер несж, дата, время, аттр, коммент, oБлокCD, oБлокlFH]
              m.r = m.r + 1
         CASE m.n="eCD"  && последний блок в файле, содержит комментарий к всему архиву, кол. файлов и пр.
      ENDCASE
      m.o = Самовызов(m.h, @buffr, m.m)  && чтение следующего ZIP-блока
   ENDDO  && перебирали ZIP-блоки в файле
   FOR m.j=1 TO m.r  && перебираем принятые CD-блоки, на предмет поиска соотв блоков в lFH
       m.i = ASCAN(lFH, qEVAL(parBuff[m.j,7].Offset), 1, -1, 1, 2+4+8)
       IF m.i>0
          parBuff[m.j,8] = lFH[m.i,2]  && структура - суть ZIP-блок
       ENDIF
   ENDFOR  && перебирали принятые CD-блоки, на предмет поиска соотв блоков в lFH
   RELEASE lFH
   IF !ISNULL(m.t)  && если удалось найти 1й ZIP-блок в файле, то позиционируем на нее!
      m.x = m.t
      =xLowLevelFSEEKabs  && N- или Q- положение в файле - начало 1го блока
   ENDIF
   RETURN m.r
ENDIF  && "\@" - Чтение файловой структуры ZIP-архива, С ТЕКУЩЕГО ПОЛОЖЕНИЯ УКАЗАТЕЛЯ


* Далее - режим работы собственно аналогичный FGETS, т.е. чтение очередного блока информации
IF !VARTYPE(m.parBuff)="C"  && если буфер был еще не определен, например, происходит первый вызов ф-ии
   m.parBuff = ""
ENDIF

#DEFINE iКонецБлокаНайден     (m.i>0)
#DEFINE iКонецБлока_НеНайден  m.i = 0
#DEFINE parBuff_Очистить      m.parBuff = ""
#DEFINE eЕстьЧтоПодкачать     m.e
STORE 0 TO m.i,;  && позиция очередного разделителя буфере (0 - если не найден)
           m.l,;  && длина разделителя после I (например длина ВК ПС)
           m.b    && длина начальной части (которую не надо возвращать в микрокоманде I)
eЕстьЧтоПодкачать = !LowLevelBadHandle  && флаг ПОДКАЧКА БУФЕРА ВОЗМОЖНА (НЕ ДОСТИГНУТ КОНЕЦ ФАЙЛА), F - возможно HANDLE задан как NULL, но буфер заранее заполнен данными из файла
m.r = .NULL.  && возвращаемый из файла элемент, если возвращает NULL, то значит файл закончился ("закончить чтение элементов")
* Выполнение микропрограммы поиска элементов в буфере, результат - заполнение переменных I,L,E,B
m.q = CHRTRAN(m.q," ","")  && уберем неисполняемые символы из микропрограммы
m.h = 0                    && счетчик микрокоманд
DO WHILE m.h<LEN(m.q)  && перебираем микрокоманды
    m.h = m.h + 1  && счетчик микрокоманд
    m.c = SUBSTR(m.q,m.h,1)  && очередная микрокоманда
    DO CASE
       * e: = Проверка готовности источника к подкачке (выдать дополнительные данные в буфер, ну, что файл не достиг FEOF)
       * Если микрокоманда указана м.буквой, то проверка производится только когда iКонецБлокаНайден
       CASE m.c="E"
            IF ISUPPER(m.c) .OR. NOT iКонецБлокаНайден  && если =="e", то выполняет чтение FEOF только в случае, когда следующий блок (разделитель блоков) еще не найден (микропрограмма Ses)
               **************************************************************************************************************************************************************
               eЕстьЧтоПодкачать = (eЕстьЧтоПодкачать .AND. !LowLevelFEOF)  && это единственное место определения конца файла (чтение последовательное)
               **************************************************************************************************************************************************************
            ENDIF

       * Попытаться найти разделитель ВК[ПС]
       * Если микрокоманда задана м.буквой, то ищем ОДИНОЧНЫЙ символ-разделитель 
       * I: = Вернуть I символов из буфера (I - положение разделителя, или след. блока данных)
       * L: = L символов начиная с I - удалить (это разделитель), буфер урезать слева в соотв с I и L
       CASE m.c="S"  && используется только в обычном FGETS-режиме (микропрограмма Ses ?I)
            IF ISUPPER(m.c)  && S - ищем двойной символ-разделитель (ВКПС)
               IF NOT iКонецБлокаНайден
                  m.l = LEN(ВКПС)
                  m.i = AT(ВКПС, m.parBuff)
               ENDIF
            ELSE  && s - ищем одиночные символы-разделители. Внимание! Если не нашли двойной (ВКПС), но нашли одиночный (ВК), последним символом буфера, то надо подкачать...
               IF NOT iКонецБлокаНайден
                  m.l = LEN(ВК)
                  m.i = AT(ВК, m.parBuff)
               ENDIF
               IF NOT iКонецБлокаНайден
                  m.l = LEN(ПС)
                  m.i = AT(ПС, m.parBuff)
               ENDIF
               IF iКонецБлокаНайден .AND. m.i=LEN(m.parBuff) .AND. eЕстьЧтоПодкачать  && найден разделитель, но последним символом в буфере, заставим подкачать
                  iКонецБлока_НеНайден  && обманем микрокоманду I - пока не будем ничего возвращать, пусть в буфер подкачает (а то может нашли ВК, а следующей подкачкой - ПС обнаружится...)
               ENDIF
            ENDIF


       * Попытаться найти в начале буфера элемент - <тэг> (начальный/завершающий/простой тэги, а также МТС (комментарий и форматные символы))
       * Общая идея - возвращать строку: преамбула <тэг>значение</тэг>  && комментарий
       * Недостаток - пока не умеет разбирать тэг CDATA (пока не было нужно)  infoxml.ru
       *   <! [CDATA[...]]> где ... может содержать любые символы, и угловые скобки и амперсанды, но кроме комбинации "]]>"
       #DEFINE cРежимXML_игнорироватьМеждутэг  ISUPPER(m.c)  && вызыван из приемника XML   (возвращать в CallBack МТС, типа ВКПС,пробелы): e T ?I13  - "1" - не возвращать пустое МТС, они обычно, форматные, для красоты текста файла
       #DEFINE cРежимXMLcr_возвращатьМеждутэг  ISLOWER(m.c)  && вызыван из приемника XMLcr          (игнорировать МТС, типа ВКПС,пробелы): e t ?I13  - "3" - коррекция внутритэгового содержимого в R на предмет удаления ВКПС
       #DEFINE xyzIsТэг    (m.x>0 .AND. m.y>m.x .AND. (m.z=0 .OR. m.z>m.y))  && найденные позиции X..Y (<..>) представляют собой тэг? Z - позиция "<" следующего вхождения за X (чтобы отследить неверную конструкцию <..<..>)
       #DEFINE xyТэг       SUBSTR(m.parBuff, m.x+1, m.y-m.x-1)  && содержимое между позициями  X("<") и Y(">")
       CASE m.c="T"
            m.l = 0  && разделитель здесь как таковой отсутствует (в микрокоманде I игнорируются L символов после возвращаемых I-1 символов)
            m.b = 0  && начальные байты (МТС также игнорируется в микрокоманде I)
            m.x = AT("<", m.parBuff, 1)    && ищем в буфере 1й попавшийся тэг
            m.y = AT(">", m.parBuff, 1)    && ищем в буфере 1й попавшийся тэг, конец его
            m.z = AT("<", m.parBuff, 1+1)  && чтобы отследить неверную конструкцию <..<..>
            m.d = 0  && если #0 то это № повтора символа "<" начала тэга, который надо поискать для поиска конца комментария к тэгу

            DO WHILE .T.  && GOTO (поиск возвращаемого тэга) vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
            
               * Предварительное значение I - "ТЭГ В НАЧАЛЕ БУФЕРА НЕ НАЙДЕН". Это состояние вызовет:
               *   В микрокоманде "?" (подкачка):
               *       и если eЕстьЧтоПодкачать - вызовет подкачку, и перезапуск микропрограммы
               *       если нет что подкачать:
               *           если parBuff_Очистить - вернет NULL (FEOF) и закончит микропрограмму
               *           если буфер длины #0   - продолжит микропрограмму
               *   В микрокоманде "I" (вернуть I-1 символов с учетом B и L, убирает возвращенное из буфера):
               *       I - вернет в R все содержимое буфера, или
               *       i - R не изменяется (т.е. можно вернуть что-то нетипичное),
               *       далее parBuff_Очистить (что приведет к возврату FEOF - NULL)
               iКонецБлока_НеНайден

               IF !xyzIsТэг  && 1й тэг в начале буфера не наблюдается
                  IF eЕстьЧтоПодкачать
                     * подкачать в буфер (и снова прогнать всю микропрограмму), поскольку есть такая возможность (вернем iКонецБлока_НеНайден)
                  ELSE  && FEOF близок
                     parBuff_Очистить  && раз в хвосте файла тэг не обозначен, то не будем возвращать голимое МТС, внешние программы XML,XMLcr ожидают только: преамбула <тэг>..</тэг> && комментарий
                  ENDIF
                  EXIT
               ENDIF  && 1й тэг в начале буфера не наблюдается
               
               * Итак, 1й тэг в начале буфера наблюдается в позициях X..Y
               m.i = m.y + 1  && полюбому надо вернуть (микрокоманда I) эти I-1 символов (+1 - т.е. включая 1й символ ">")
               
               IF m.x>1  && тэг начинается не сначала буфера. Поищем начало преамбулы (форматные пробелы перед тэгом) ЛЕВЕЕ начала тэга, но именно в ВКПС-строке возвращаемого тэга
                  IF cРежимXML_игнорироватьМеждутэг
                     m.b = m.x - 1
                  ELSE
                     m.u = LEFT(m.parBuff, m.x-1)
                     m.u = MAX(RAT(ВК, m.u), RAT(ПС, m.u), RAT(ПФ, m.u), RAT(ВТ, m.u))  && ищем начало строки с тэгом
                     IF m.u>0  && в преамбуле (перед тэгом X..Y) найден символ ВК/ПС. Не будем его возвращать
                        m.b = m.u  && длина невозвращаемого начала
                     ENDIF
                  ENDIF
               ENDIF  && тэг начинается не сначала буфера. Нашли невозвращаемое начало преамбулы B.

               m.t = xyТэг  && полное содержимое 1го тэга в буфере, оно м.б. с атрибутами, причем (2015.05) перечень атрибутов мб задан и с символами ВКПС (для удобства создания шаблона)!

               IF LIKE("*/", m.t) .OR.;  && это т.н. "пустой" тэг <тэг/>, точно должен быть единственным в выходной строке ф-ии
                  LIKE("/*", m.t)        && это   завершающий тэг </тэг>, точно должен быть единственным в выходной строке ф-ии
                  * m.i = m.i  && оставим предварительно возвращаемый тэг
                  m.d = 2  && 2 - для поиска конца комментария МТС искать 2й тэг "<"
                  EXIT
               ENDIF

               * тэг может иметь ближайший тэг "завершающий". Тогда это будет называться "простой" тэг. Вернем их оба вместе!
               m.x = AT("<", m.parBuff, 2)    && поищем начало 2го тэга (он м.б. закрывающим для T, а может просто следующим по уровню вложения)
               m.y = AT(">", m.parBuff, 2)    && поищем конец  2го тэга (-"-)
               m.z = AT("<", m.parBuff, 2+1)  && чтобы отследить неверную конструкцию <..<..>
               IF !xyzIsТэг  && нет 2го тэга, т.е. нельзя проверить, завершающий ли он первому
                  IF eЕстьЧтоПодкачать
                     iКонецБлока_НеНайден  && 2й тэг вообще не виден, надо подкачать в буфер (и снова прогнать всю микропрограмму), поскольку есть такая возможность (вернем iКонецБлока_НеНайден)
                  ELSE  && так и не нашлось конца 2го тэга
                     * m.i = m.i  && оставим предварительно возвращаемый 1й тэг
                     m.d = -1  && -1 - для поиска конца комментария МТС можно брать остаток строки начиная с I, вся остальная строка и есть весь МТС
                  ENDIF
                  EXIT
               ENDIF  && нет 2го тэга, т.е. нельзя проверить, завершающий ли он первому
                       
               * Посмотрим на 2й тэг (не является ли он завершающим 1му)...
               * N - краткое имя 1го тэга, убрали атрибуты тэга T (если они есть), оставим только: <тэг> , <тэг/> , <тэг , </тэг , <!--коммент--> ...
               m.n = GETWORDNUM(m.t, 1, " "+ВК+ПС+ТАБ)

               * найден конец 2го тэга, значит можно определить завершающий он первому или нет
               IF INLIST(xyТэг+">",;    && проверим имя 1го тэга на то, что 2й тэг - это:
                         "/"+m.n+" ",;  && завершающий 1му тэг, с атрибутами, наверное, таких не бывает
                         "/"+m.n+">")   && или простой завершающий 1му тэг
                  m.i = m.y + 1  && обнаружен 2й тэг [X..Y] - завершающий 1му, значит 1й и 2й тэги - "простой" начальный и конечный тэг. Вернем их вместе!
                  m.d = 3  && 3 - для поиска комментария искать 3й тэг "<"
                  EXIT
               ENDIF  && 2й тэг - завершающий для 1го

               * m.i = m.i  && возвращаем последнее найденное
            EXIT
            ENDDO  && конец GOTO (поиск возвращаемого тэга) ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

            DO WHILE cРежимXMLcr_возвращатьМеждутэг  && GOTO (поиск комментария МТС к возвращаемому тэгу) vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
               IF NOT iКонецБлокаНайден
                  EXIT
               ENDIF
               
               * какой-то тэг возвращаем в I-1 символов.
               * D - но в конце мб комментариий в МТС (искать вот этот № вхождения ограничивающего тэга).
               * Внимание! На комментарий расчитывает FILExmlFILE, и именно в смысле "комментарий в той же строке, где тэг, между ВКПС"
               IF m.d=0  && не задано № вхождения символа "<" ограничивающего комментарий
                  EXIT
               ENDIF

               m.x = ICASE(m.i>LEN(m.parBuff), 0,;           && буфер пуст
                           m.d>0, AT("<", m.parBuff, m.d),;  && ищем начало следующего (3го, например) тэга, но < может находиться и в комментарии (в комментарии мб ТОЛЬКО обусловленные слова!)
                           m.d<0, LEN(m.parBuff) + 1,;       && для поиска конца комментария МТС можно брать остаток строки начиная с I, вся остальная строка и есть весь МТС
                                               0)
               IF m.x=0 .OR. !m.x-m.i>0
                  IF eЕстьЧтоПодкачать
                     iКонецБлока_НеНайден  && пусть подкачает
                  ENDIF
                  EXIT
               ENDIF
               
               * нечего уже подкачивать. В X лежит все что есть о конце МТС после возвращаемого тэга I-1 символов
               * найдено начало тэга D (т.е. следующего после предполагаемых к возвращению I символов). Проанализируем МТС I..X-1 на предмет нужности к возврату в микрокоманде I
               m.y = SUBSTR(m.parBuff, m.i, m.x-m.i)  && это МТС до начала следующего тэга
               m.v = AT(ВК, m.y)  && ВК и ПС ограничивают возвращаемое содержимое МТС Y
               m.w = AT(ПС, m.y)
               * в подстроке комментрария МТС Y вернем в L:
               *   - в целой части   - количество возвращаемых символов Y
               *   - в дробной части - длину невозвращаемого суффикса, типа ВК/ПС
               m.l = ICASE(m.v=0 .AND. m.w=0,     LEN(m.y) + 0.0,;  && нет ВК и ПС в МТС Y
                           m.v>0 .AND. m.w=m.v+1, (m.v-1)  + 0.2,;  && есть хорошая пара ВКПС
                           m.v>0 .AND. m.w>m.v,   (m.v-1)  + 0.1,;  && есть ВК ххх ПС
                           m.w>0 .AND. m.v=0,     (m.w-1)  + 0.1,;  && есть ПС (не видно ВК)
                           m.w>0 .AND. m.v>m.w,   (m.w-1)  + 0.1,;  && есть ПС ххх ВК
                                                  0)
               m.i = m.i + INT(m.l)  && вернем из FGETSs вот такой тэг с комментарием
               m.l = ROUND(10 * (m.l%1), 0)  && эти символы после комментария можно проигнорировать (это ВК, ПС)
            EXIT
            ENDDO  && конец GOTO (поиск комментария МТС к возвращаемому тэгу) ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
       #UNDEFINE cРежимXML_игнорироватьМеждутэг
       #UNDEFINE cРежимXMLcr_возвращатьМеждутэг
       #UNDEFINE xyIsТэг
       #UNDEFINE xyТэг 


       * Попытаться найти в начале буфера ZIP-блок (в ZIP-файле).
       * Если микрокоманда задана м.буквой, то в возвращаемом блоке не будет присутствовать ППД-часть - собственно ZIP-составляющая блока (.zip), и все что после ее
       * (это бывает, когда интересуются только именами содержимого в ZIP-файле)
       CASE m.c="Z"
            m.l = 0  && нет разделителя между ZIP-блоками в файле
            m.x = IIF(ISUPPER(m.c), "", "zip")  && имя ППД-части блока, начиная с которой физ. наличие в буфере не обязательно (если ="zip", т.е. реально не читать собственно ZIP-составляющую блока)
            m.o = FREADs_ZIP_jflosdbgdsdpofug(m.parBuff, m.x, "")  && ищем в буфере заголовок ZIP-блока, возвращает ZIP-обьект, или N - число байт, которые д.б. в буфере
            DO CASE
               CASE ISNULL(m.o)  && в буфере вообще не ZIP-блок, дальнейший разбор буфера невозможен (будет возвращен NULL)
                    EXIT
               CASE VARTYPE(m.o)="O"  && начало буфера опознано и считано как ZIP-блок!
                    *********************************************************************************************************************************
                    m.x = 0  && переместимся на столько позиций от текущего положения в файле
                    m.x = xLowLevelFSEEK  && абсолютная позиция в файле (указатель на 1й байт ПОСЛЕ буфера, 1й байт файла - 0)
                    IF VARTYPE(m.x)="N"  && в 32-версии вызова FSEEKs возвращает обычное 32-число
                       m.y = m.x - LEN(m.parBuff)  && позиция блока: вычитаем длину буфера из абсолютного положения указателя в файле (N-числа)
                    ELSE  && FSEEKs возвращает 8-байтовое число, в Q-виде, младшие байты - в начале строки
                       m.y = qEVAL(m.x, "-", LEN(m.parBuff))  && позиция блока: из абсолютного положения указателя в файле (Q-числа) вычитаем длину буфера
                    ENDIF
                    =ADDPROPERTY(m.o, "_offset_", m.y)  && чтобы указать в возвращаемом блоке его (блока) положение в файле. Потребуется при записи блока, и при коррекции полей (например, offset)
                    *********************************************************************************************************************************
                    m.i = m.o._lenght_+1  && позиция следующего блока (следует сразу за текущим), при большой длине ППД может быть очень большим (до 2Г, однако >2/4Г вряд ли...)
                    m.r = m.o             && вернем этот ZIP-блок в виде обьекта
               CASE VARTYPE(m.o)="N" .AND. m.o<0  && ошибка чтения файла
                    m.r = "Ошибка чтения файла: "+TRANSFORM(m.o)
                    EXIT
               CASE VARTYPE(m.o)="C"  && ошибка чтения файла
                    m.r = m.o
                    EXIT
               OTHERWISE  && чтобы этот ZIP-блок был принят, в буфере д.б. не менее чем (N)=m.o байтов. Если m.o<0 - сообщение об ошибке
                    iКонецБлока_НеНайден
            ENDCASE

       * ПОДКАЧКА БУФЕРА И ГЛАВНЫЙ ВЕТВИТЕЛЬ: Подкачка в буфер, если разделитель в буфере не найден.
       *   - если конец блока (конечный разделитель) найден - то ничего не делает, а ПРОДОЛЖАЕТ МИКРОПРОГРАММУ
       *   - если подкачка возможна,                          то подкачка и ВОЗВРАТ К НАЧАЛУ МИКРОПРОГРАММЫ
       *   - если подкачка невозможна, и буфер пуст,          то возврат NULL и ВЫХОД ИЗ МИКРОПРОГРАММЫ
       CASE m.c="?"
            DO CASE
               CASE iКонецБлокаНайден  && если конец блока найден, то подкачивать не надо, а надо просто вернуть блок...
               CASE eЕстьЧтоПодкачать  && если файл еще можно дочитать (не достигнут EOF, см. микрокоманду "E")
               * SET STEP ON 
                    **********************************************************************************************************************************************************
                    m.x = LowLevelFREADbuff
                    m.x = xLowLevelFREAD  && собственно дочтение из файла, это единственное место чтения из файла, чтение последовательное, примерно по 100К за раз считываем...
                    **********************************************************************************************************************************************************
                    IF LEN(m.x)<LowLevelFREADbuff  && 2017.05: прочитали МЕНЬШЕ чем спросили, значит файл закончился (было просто LEN(m.x)=0)
                       eЕстьЧтоПодкачать = .F.
                    ENDIF
                    IF LEN(m.x)>0  && считали #0 байтов из файла
                       m.parBuff = m.parBuff + m.x  && нарастим буфер дочитанными данными, и попробуем микропрограмму еще раз с увеличенным буфером:
                       IF LEN(m.parBuff) > 3 * LowLevelFREADbuff
                          ERROR "Переполнение буфера"+CHR(13)+LEFT(m.parBuff,100)
                          m.r = .NULL.
                          EXIT
                       ENDIF
                       m.h = 0  && обнуляем счетчик микрокоманд, т.е. выполним микропрограмму снова
                    ENDIF  && читали из файла
               CASE LEN(m.parBuff)=0  && parBuff_Очистить. Файл уже нельзя дочитать (FEOF). Просто закончим микропрограмму и вернем NULL (FEOF)
                    m.r = .NULL.
                    EXIT
            ENDCASE  && в остальных случаях (буфер не пуст) продолжим выполнение микропрограммы

       * Вернуть I символов из буфера (I - положение разделителя, или след. блока данных)
       * L символов начиная с I - удалить (это разделитель), буфер урезать слева в соотв с I и L
       * Если микрокоманда задана м.буквой, то считается, что выходное значение уже присутствует в R, осталось только отрезать начало буфера (иногда переместиться в файле за пределы буфера)
       CASE m.c="I"
            IF iКонецБлокаНайден  && разделитель блоков найден, вырежем его из буфера и вернем блок
               IF ISUPPER(m.c)
                  m.r = LEFT(m.parBuff, m.i-1)  && возвращаем элемент файла (строку 1..I), без разделителя в конце (длиной L)
                  IF m.b>0  && если задана длина невозвращаемого начала
                     m.r = SUBSTR(m.r, m.b+1)  && то не будем возвращать первые B символов
                  ENDIF
               ENDIF
               m.x = m.i-1+m.l-LEN(m.parBuff)  && положение следующего блока информации отн. конца блока. -1-последний байт блока, 0 - примыкающий справа к блоку, 1 - далеко за блоком
               IF m.x<=0  && следующий блок находится в пределах буфера, или примыкает к нему справа
                  m.parBuff = SUBSTR(m.parBuff, m.i+m.l)  && в буфере, слева, отрезаем возвращаемую строку I и разделитель L. Долгая операция при большом буфере!
               ELSE  && следующий блок находится ДАЛЕКО ВНЕ буфера, т.е даже не примыкает к нему. Значит надо переместить указатель в файле вправо на X байт, чтобы встать на начало след. блока
                  m.parBuff = ""
                  *******************************************************************************************************
                  =xLowLevelFSEEK  && перемещаемся в файле ВПРАВО на x байт (исп. в микрокоманде "Z" - чтение ZIP-блоков)
                  *******************************************************************************************************
               ENDIF
            ELSE  && разделитель не найден (и EOF достигнут), но надо что-то вернуть, наверное последний остаток от буфера
               IF ISUPPER(m.c)
                  m.r = m.parBuff  && вернем весь остаток буфера... Но если буфер длиной 0, то зачем возвращать пустую строку... Аа, в микрокоманде "?" в этом случае возвращается NULL (FEOF) и делается EXIT из микропрограммы!
               ENDIF
               parBuff_Очистить  && сброс буфера, следующее обращение к ф-ии приведет к возврату NULL (FEOF) - т.е. "закончено чтение элементов"
            ENDIF

       * Постобработка r (возвращаемое значение) на предмет ЕСЛИ ПУСТОЕ ЗНАЧЕНИЕ, ТО НЕ ВОЗВРАЩАТЬ
       *  "1" - для значений из XML-тэгов не возвращать пустые строки МТС, они обычно, форматные, для красоты текста файла
       *  "2" - для блоков из двоичных файлов (пока не исп.)
       CASE INLIST(m.c,"1","2")
            IF !LIKE("*<*>*", m.r)  && это чисто МТС
            IF LEN(m.r)=0 .OR.;
               ICASE(m.c="1", LEN(CHRTRAN(m.r, ВК+ПС+ТАБ+" ", ""))=0,;
                     m.c="2", LEN(CHRTRAN(m.r, CHR(0),        ""))=0,;
                              .F.)    
               m.h = 0  && не возвращать пустое МТС, обнуляем счетчик микрокоманд, т.е. выполним микропрограмму снова
            ENDIF
            ENDIF  && это чисто МТС

       * 2017.05: Бывает, что в самодельном шаблоне XML атрибуты внутри тэга отделены не пробелом, и символами ВКПС, просто сторонний шаблон так удобнее наблюдать.
       *          Удалим лишние ВКПС внутри тэга, т.е. "причешем" ...Может и внутритэговое содержимое тоже надо причесать? 
       *          А вот МТС - не надо причесывать, т.к. оно сделано для красоты, и имеет право присутствовать в XML!
       CASE m.c="3"  && коррекция внутритэгового содержимого в R на предмет удаления ВКПС
            IF LIKE("*<*>*", m.r)  && это действительно внутритэговое содержимое (а не МТС), правда, возможно, с преамбулой и комментарием
               m.v = AT("<",  m.r)
               m.w = RAT(">", m.r)
               m.y = SUBSTR(m.r, m.v, m.w-m.v+1)
               IF ВК$m.y .OR. ПС$m.y .OR. ТАБ$m.y
                  m.y = STRTRAN(m.y, ВКПС, ВК)
                  m.y = CHRTRAN(m.y, ТАБ,  " ")
                  m.y = CHRTRAN(m.y, ПС,   ВК)
                  DO WHILE "  "$m.y
                     m.y = STRTRAN(m.y, "  ", " ")
                  ENDDO
                  IF ВК$m.y
                     DO WHILE ВК+" "+ВК$m.y
                        m.y = STRTRAN(m.y, ВК+" "+ВК, ВК+ВК)
                     ENDDO
                  ENDIF
               ENDIF
               IF ВК$m.y
                  DO WHILE ВК+ВК$m.y  && может заменить на ALINES, который умеет отличать пустые строки?
                     m.y = STRTRAN(m.y, ВК+ВК, ВК)
                  ENDDO
                  * [3N] - [0]/1/2 - удалить пробелы: вокруг, только слева от символа, только справа от символа. +4 - добавлять пробелы с противоположной стороны
                  * [3C] - заменять символы вот на это. В данном случае стираем пробелы вокруг ВК, далее ВК заменяем на ОДИНОЧНЫЙ пробел
                  m.y = УдалитьПробелыВокругСимволов(m.y, ВК, " ")
               ENDIF
               m.r = LEFT(m.r, m.v-1) + m.y + SUBSTR(m.r, m.w+1)  && тэг Y привели в состояние без ВКПС,ТАБ...
            ENDIF  && это действительно внутритэговое содержимое (а не МТС)

       * Ошибка программиста
       OTHERWISE
            ERROR "Неверная микрокоманда "+m.c+" в "+m.q
    ENDCASE
ENDDO  && перебирали микрокоманды. H - счетчик микрокоманд, C - микрокоманда, Q - микропрограмма,  I,E,L - регистры (iКонецБлокаНайден, eЕстьЧтоПодкачать, длина разделителя)

RETURN m.r  && FGETSs
#UNDEFINE mКончаетсяЗнакомВПР
#UNDEFINE Самовызов

#UNDEFINE iКонецБлокаНайден
#UNDEFINE iКонецБлока_НеНайден
#UNDEFINE parBuff_Очистить
#UNDEFINE eЕстьЧтоПодкачать



  
  

  

      
          Закрыть      
  

    FUNCTION write
    LPARAMETERS lcText, lnLevel
        IF EMPTY( lnLevel )
            lnLevel = log_level_info
        ENDIF 
        
        if lnLevel < This.level &&or EMPTY( lcText )
            RETURN goApp.error_id = no_error 
        ENDIF     
        
        LOCAL loFso, loFsoFile, loFsoStream
        
        loFso  = CREATEOBJECT('Scripting.FileSystemObject')
        IF !FILE( This.File )
            loFso.CreateTextFile( This.File )
        ENDIF 

        loFsoFile     = loFso.GetFile( This.File )
        loFsoStream = loFsoFile.OpenAsTextStream( ForAppending, TristateUseDefault )
    
        for lnLine = 1 TO MEMLINES( lcText )
            lcLine = TIME(1) + TAB + "["+log_level_name( lnLevel )+"]" + TAB + MLINE(lcText,lnLine) + CRLF
            loFsoStream.Write( NVL(lcLine,'') )
        endfor 
        
        loFsoStream.Close()

        RETURN goApp.error_id = no_error 
    ENDfunc