******* ОТДЕЛЕНИЕ / ФИЛИАЛ :   0001 / 0001
 
------------------------------------------------------------------------------------------------------------------------------------
История по карточному счету клиента за период :  01.06.2011 - 30.06.2011
Банк :                 01                     Дата обработки в системе UniCard : 09.08.2011
Карточка :             600000000000000006     MAESTRO
Счет номер : 40000000000000000003   /   Валюта счета : 810  /  Кредит.лимит : 0
Фамилия И.О. : ИВАНОВ И.И.
Отделение / Филиал :   0001 / 0001            Дата открытия счета : 23MAY05
------------------------------------------------------------------------------------------------------------------------------------
Номер держат.  Дата       Тип     Номер     Дата          Приход          Расход    Описание транзакции
Номер выпуска  транзакции транз.  транз.    платежа                                 
------------------------------------------------------------------------------------------------------------------------------------
1/0            03JUN11    0000    000000     306         3288.63            0.00                                              
1/0            06JUN11    0100    000000     606            0.00         -300.00    BANKOMAT ... 
1/0            14JUN11    0000    000007    1406            0.00         -500.00    BANKOMAT ... 
1/0            17JUN11    0010     20003    1706            0.00         -100.00    BEE-..... 
1/0            17JUN11    0000     00073    1706            0.00         -100.00    BANKOMAT ... 
1/0            17JUN11    0100    100001    1706            0.00          -20.00    BANKOMAT ... 
1/0            17JUN11    0000    300001    1706         1000.00            0.00                                              
1/0            17JUN11    0010    900039    1706            0.00          -10.00    BANKOMAT ... 
1/0            20JUN11    0000    200003    2006            0.00         -200.00    MOB.. .
1/0            22JUN11    0100    200004    2206            0.00          -60.00                                
1/0            27JUN11    0000    900000    2606            0.00         -500.00    BANKOMAT  
------------------------------------------------------------------------------------------------------------------------------------
Итого :                                                  4288.63        -1790.00
Остаток на начало периода :                              5018.52
Остаток на конец  периода :                              7517.15
 

' =======================================
Option Compare Database
Option Explicit
Option Base 0
' =======================================

' =======================================
' Define private const
Private Const m_csModuleName As String = "CXml4Db"
Private Const cnMaxXmlSize As Long = 1073741823          ' максимальный размер xml, которые сервер сможет принять

Private Const cstrXmlQuot As String = """
Private Const cstrXmlAmp As String = "&"
Private Const cstrXmlApos As String = "'"
Private Const cstrXmlLt As String = "<"
Private Const cstrXmlGt As String = ">"

'Private Const cstrQuot As String = """ ' & Chr(34)" ' ну и как же мне блин это объявить константой?!!
Private Const cstrAmp As String = "&"
Private Const cstrApos As String = "`"
Private Const cstrLt As String = "<"
Private Const cstrGt As String = ">"

' =======================================

' =======================================
' define private var's
Private conn As New ADODB.Connection                     ' соединение с базой данных
Private cmdAddXml As New ADODB.Command                   ' команда выполнение которой позволит загрузить xml в бд
Private cmdRs As ADODB.Recordset                         ' для взятия результата выполнения команды

Private strStorageProcedureName As String                ' имя хранимой процедуры, которую необходимо выполнить для
                                                         ' загрузки xml в базу данных
Private strStorageProcedureParam As String               ' имя параметра хранимой процедуры, подразумевается, что
                                                         ' параметр имеет тип xml
                                                         
Private strMainBuffer As String                          ' основной буфер для хранения xml

Private colTagStack As New Collection                    ' Стэк открытых тэгов
Private nTagStackCharLen As Long                         ' длина стэка в символах

Private bPrepared As Boolean                             ' признак инициализации

Private cstrQuot As String

' =======================================

' =======================================
Private Sub Class_Initialize()
   strStorageProcedureName = vbNullString
   strStorageProcedureParam = vbNullString
   strMainBuffer = vbNullString
   
   cstrQuot = "" & Chr(34)
   
   bPrepared = False
   nTagStackCharLen = 0
End Sub
' =======================================

' =======================================
' чистит буфер
Private Sub ClearBuffer()
   strMainBuffer = vbNullString
End Sub
' =======================================

' =======================================
Private Sub Class_Terminate()
End Sub
' =======================================

' =======================================
' уровень заполнения буфера в процентах
' =======================================
Property Get FillLevel() As Long
   FillLevel = Fix((Len(strMainBuffer) + nTagStackCharLen) / cnMaxXmlSize * 100)
End Property
' =======================================

' =======================================
' максимальный размер буфера
' =======================================
Property Get MaxSize() As Long
   MaxSize = cnMaxXmlSize
End Property
' =======================================

' =======================================
' максимальный размер буфера
' =======================================
Property Get CurrentSize() As Long
   CurrentSize = Len(strMainBuffer)
End Property
' =======================================

' =======================================
' был ли инициализирован объект
' =======================================
Property Get IsPrepared() As Long
   IsPrepared = bPrepared
End Property
' =======================================

' =======================================
' инициализирующая функция, необходимо передать строку соединения, имя хранимой процедуры
' и имя параметра хранимой процедуры
' =======================================
Public Function Prepare(strConnectionString As String, strSpName As String, strSpParamName As String) As Boolean
   On Error GoTo Error_Prepare
   
   bPrepared = False
   Prepare = False
   
   strStorageProcedureName = strSpName
   strStorageProcedureParam = strSpParamName
   
   conn.CursorLocation = adUseClient
   Call conn.Open(strConnectionString)
   
   ' ------------------
   cmdAddXml.ActiveConnection = conn
   cmdAddXml.CommandText = strSpName
   cmdAddXml.CommandTimeout = 0
   cmdAddXml.CommandType = adCmdStoredProc
   
   Call cmdAddXml.Parameters.Append(cmdAddXml.CreateParameter("@return", adInteger, adParamReturnValue))
   Call cmdAddXml.Parameters.Append(cmdAddXml.CreateParameter(strSpParamName, adVarWChar, adParamInput, cnMaxXmlSize))
   ' ------------------
   
   Call ClearBuffer
   
   Prepare = True
   bPrepared = True
   Exit Function
   
Error_Prepare:
   Call ErrorMessage(m_csModuleName, "Prepare")
End Function
' =======================================

' =======================================
Private Function AddXml2Db() As Long
   On Error GoTo Error_AddXml2Db
   
   AddXml2Db = -1
   
   ' если не было инициализации, то работать не будем
   If (Not IsPrepared) Then Exit Function
   
   conn.BeginTrans
   
   cmdAddXml.Parameters("@return").value = 0
   cmdAddXml.Parameters(strStorageProcedureParam).value = strMainBuffer
   
   Set cmdRs = cmdAddXml.Execute()
   AddXml2Db = cmdAddXml.Parameters("@return").value
   
   conn.CommitTrans
   
   Exit Function

Error_AddXml2Db:
   Call ErrorMessage(m_csModuleName, "AddXml2Db")
   conn.RollbackTrans
   'Resume Next
End Function
' =======================================

' =======================================
Public Function FlushBuffer() As Long
   On Error GoTo ErrorHandler
   
   FlushBuffer = -1
   Exit Function
   
   ' на всякий случай закроем все тэги из стэка
   Call CloseAllTag
   
   ' если буфер пусть, то ни чего выполнять не будем.
   'If (nMainBufferLen = 0) Then Exit Function
   If (Len(strMainBuffer) = 0) Then Exit Function
   
   ' собственно отправляем данные в БД
   FlushBuffer = AddXml2Db()
   
   ' чистим буфер
   Call ClearBuffer
   
   Exit Function
   
ErrorHandler:
   Stop
   
End Function
' =======================================

' =======================================
' открывает новый тэг, фактически заменяет предустановленные константы, если они есть в имени тэга
' добавляет тэг в стэк, вычисляет длину стэка в символах
' =======================================
Public Sub OpenTag(strTagName As String)
   On Error GoTo ErrorHandler
   
   ' добавим в стэк
   Call colTagStack.Add(strTagName)

   ' добавим в буффер
   strMainBuffer = strMainBuffer & "<" & strTagName & ">" & vbCrLf

   ' вычислим длину стэка
   nTagStackCharLen = nTagStackCharLen + Len(strTagName)
   
   Exit Sub
   
ErrorHandler:
   Stop
   
End Sub
' =======================================

' =======================================
' закрывает тэг, если существует открытый тэг в стэке
' =======================================
Public Sub CloseTag()
   On Error GoTo ErrorHandler
   
   Dim nItemCount As Long, strTagName As String
   
   ' закрывать будем с хвоста
   nItemCount = colTagStack.Count
   
   ' если в стэке что-то есть, то будем закрывать
   If (nItemCount > 0) Then
      ' формируем тэг xml
      strTagName = "</" & colTagStack.item(nItemCount) & ">"
      
      ' кладем его в главный буфер
      strMainBuffer = strMainBuffer & strTagName & vbCrLf
      
      ' правим длину стэка в символах
      nTagStackCharLen = nTagStackCharLen - Len(strTagName) + 3 ' "</ >" --> 3
      
      ' удаляем элемент из стэка
      Call colTagStack.Remove(nItemCount)
   End If
   
   Exit Sub
   
ErrorHandler:
   Stop
   
End Sub
' =======================================

' =======================================
' закрывает все тэги, которые существуют в стэке
Public Sub CloseAllTag()
   On Error GoTo ErrorHandler
   
   ' цикл по всем элементам стэка
   While colTagStack.Count > 0
      Call CloseTag
   Wend
   
   ' на всякий случай обнулим, возможно я где-то ошибся в вычислениях ...
   nTagStackCharLen = 0
   
   Exit Sub
   
ErrorHandler:
   Stop
   
End Sub
' =======================================

' =======================================
' добавляет данные, обернутые в тэг, данные и тэги просматриваются на предмет наличия предустановленных констант
Public Sub AddData(strTagName As String, strData As String)
   On Error GoTo ErrorHandler
   
   ' локальные переменные
   Dim strTrueData As String, strOpenTag As String, strCloseTag As String, strItem As String
   
   strOpenTag = "<" & strTagName & ">"
   strCloseTag = "</" & strTagName & ">"
   
   ' заменим предустановленные константы для данных
   strTrueData = strData
   strTrueData = Replace(strTrueData, cstrQuot, cstrXmlQuot)
   strTrueData = Replace(strTrueData, cstrAmp, cstrXmlAmp)
   strTrueData = Replace(strTrueData, cstrApos, cstrXmlApos)
   strTrueData = Replace(strTrueData, cstrLt, cstrXmlLt)
   strTrueData = Replace(strTrueData, cstrGt, cstrXmlGt)
   
   strItem = strOpenTag & strTrueData & strCloseTag
   strMainBuffer = strMainBuffer & strItem & vbCrLf
    
   Exit Sub
   
ErrorHandler:
   Stop
End Sub
' =======================================

' =======================================
' добавляет текст в основной буфер, предполается, что текст правильный и его не нужно фильтровать
Public Sub AddText(strText As String)
   On Error GoTo ErrorHandler
   
   strMainBuffer = strMainBuffer & strText
   
   Exit Sub
   
ErrorHandler:
   Stop
End Sub
' =======================================

' =======================================
Option Compare Database
Option Explicit
Option Base 0
' =======================================

' =======================================
' Define private const
Private Const m_csModuleName = "CImportSvvSve"

Private Const csFileType1 = "EUROPAY INTERNATIONAL"
Private Const csFileType2 = "VISA INTERNATIONAL"
Private Const csFileType3 = "**** ОТДЕЛЕНИЕ / ФИЛИАЛ :"

Private Const csSqlAddCard = "prc_AddCard"
Private Const csSqlAddCardFile = "prc_AddCardFile"
Private Const csSqlGetCardFileId = "prc_GetCardFileId"
Private Const csSqlCardFileEndLoad = "prc_CardFileEndLoad"
Private Const csSqlAddCardHistory = "prc_AddCardHistory"
Private Const csSqlUpdateCardHistory = "prc_UpdateCardHistory"
Private Const csSqlAddCardOperation = "prc_AddCardOperation"

Private Const csSqlXmlProcedureName = "prc_Add"
Private Const csSqlXmlProcedureParam = "@XmlDoc"
' =======================================

' =======================================
' define private var's
Private monthListRus As Variant
Private monthListEng As Variant

Private conn As New ADODB.Connection
Private cmdAddCard As New ADODB.Command
Private cmdAddCardFile As New ADODB.Command
Private cmdGetCardFileId As New ADODB.Command
Private cmdCardFileEndLoad As New ADODB.Command
Private cmdAddCardHistory As New ADODB.Command
Private cmdUpdateCardHistory As New ADODB.Command
Private cmdAddCardOperation As New ADODB.Command

Private cmdRs As ADODB.Recordset

Private TrueDecDelimiter As String
' =======================================

' =======================================
Private Sub Class_Initialize()
   ' Array index - 0 To 11 - option base 0
   monthListEng = Array("JAN", "FEB", "MAR", "APR", "MAY", "JUN", "JUL", "AUG", "SEP", "OCT", "NOV", "DEC")
   monthListRus = Array("ЯНВ", "ФЕВ", "МАР", "АПР", "МАЙ", "ИЮН", "ИЮЛ", "АВГ", "СЕН", "ОКТ", "НОЯ", "ДЕК")
   
   TrueDecDelimiter = Trim(GetSysLocaleInfo(LOCALE_SDECIMAL))
End Sub
' =======================================

' =======================================
Private Function Prepare(strConnectionString As String) As Boolean
   On Error GoTo Error_Prepare
   
   Prepare = False
   
   conn.CursorLocation = adUseClient
   Call conn.Open(strConnectionString)
   
   ' ------------------
   cmdAddCard.ActiveConnection = conn
   cmdAddCard.CommandText = csSqlAddCard
   cmdAddCard.CommandTimeout = 0
   cmdAddCard.CommandType = adCmdStoredProc
   
   Call cmdAddCard.Parameters.Append(cmdAddCard.CreateParameter("@return", adInteger, adParamReturnValue))
   Call cmdAddCard.Parameters.Append(cmdAddCard.CreateParameter("@pCardNum", adVarChar, adParamInput, 25))
   Call cmdAddCard.Parameters.Append(cmdAddCard.CreateParameter("@pAccountNum", adVarChar, adParamInput, 20))
   Call cmdAddCard.Parameters.Append(cmdAddCard.CreateParameter("@pCardType", adVarChar, adParamInput, 50))
   Call cmdAddCard.Parameters.Append(cmdAddCard.CreateParameter("@pCurrencyCode", adChar, adParamInput, 3))
   Call cmdAddCard.Parameters.Append(cmdAddCard.CreateParameter("@pClientName", adVarChar, adParamInput, 100))
   Call cmdAddCard.Parameters.Append(cmdAddCard.CreateParameter("@pAccountOpenDate", adDate, adParamInput))
   Call cmdAddCard.Parameters.Append(cmdAddCard.CreateParameter("@pBankCode", adChar, adParamInput, 2))
   Call cmdAddCard.Parameters.Append(cmdAddCard.CreateParameter("@pOsbNum", adVarChar, adParamInput, 4))
   Call cmdAddCard.Parameters.Append(cmdAddCard.CreateParameter("@pVspNum", adVarChar, adParamInput, 5))
   ' ------------------
   
   ' ------------------
   cmdAddCardFile.ActiveConnection = conn
   cmdAddCardFile.CommandText = csSqlAddCardFile
   cmdAddCardFile.CommandTimeout = 0
   cmdAddCardFile.CommandType = adCmdStoredProc
   
   Call cmdAddCardFile.Parameters.Append(cmdAddCardFile.CreateParameter("@return", adInteger, adParamReturnValue))
   Call cmdAddCardFile.Parameters.Append(cmdAddCardFile.CreateParameter("@pCardFileName", adVarChar, adParamInput, 800))
   Call cmdAddCardFile.Parameters.Append(cmdAddCardFile.CreateParameter("@pCardFileSize", adBigInt, adParamInput))
   ' ------------------
   
   ' ------------------
   cmdGetCardFileId.ActiveConnection = conn
   cmdGetCardFileId.CommandText = csSqlGetCardFileId
   cmdGetCardFileId.CommandTimeout = 0
   cmdGetCardFileId.CommandType = adCmdStoredProc
   
   Call cmdGetCardFileId.Parameters.Append(cmdGetCardFileId.CreateParameter("@return", adInteger, adParamReturnValue))
   Call cmdGetCardFileId.Parameters.Append(cmdGetCardFileId.CreateParameter("@pCardFileName", adVarChar, adParamInput, 800))
   Call cmdGetCardFileId.Parameters.Append(cmdGetCardFileId.CreateParameter("@pCardFileSize", adBigInt, adParamInput))
   ' ------------------
   
   ' ------------------
   cmdCardFileEndLoad.ActiveConnection = conn
   cmdCardFileEndLoad.CommandText = csSqlCardFileEndLoad
   cmdCardFileEndLoad.CommandTimeout = 0
   cmdCardFileEndLoad.CommandType = adCmdStoredProc
   
   Call cmdCardFileEndLoad.Parameters.Append(cmdCardFileEndLoad.CreateParameter("@return", adInteger, adParamReturnValue))
   Call cmdCardFileEndLoad.Parameters.Append(cmdCardFileEndLoad.CreateParameter("@pIdCardFile", adInteger, adParamInput))
   ' ------------------
   
   ' ------------------
   cmdAddCardHistory.ActiveConnection = conn
   cmdAddCardHistory.CommandText = csSqlAddCardHistory
   cmdAddCardHistory.CommandTimeout = 0
   cmdAddCardHistory.CommandType = adCmdStoredProc
   
   Call cmdAddCardHistory.Parameters.Append(cmdAddCardHistory.CreateParameter("@return", adInteger, adParamReturnValue))
   Call cmdAddCardHistory.Parameters.Append(cmdAddCardHistory.CreateParameter("@pBegDate", adDate, adParamInput))
   Call cmdAddCardHistory.Parameters.Append(cmdAddCardHistory.CreateParameter("@pEndDate", adDate, adParamInput))
   Call cmdAddCardHistory.Parameters.Append(cmdAddCardHistory.CreateParameter("@pCardLimit", adDouble, adParamInput))
   Call cmdAddCardHistory.Parameters.Append(cmdAddCardHistory.CreateParameter("@pUnicardDate", adDate, adParamInput))
   Call cmdAddCardHistory.Parameters.Append(cmdAddCardHistory.CreateParameter("@pIdCardFile", adInteger, adParamInput))
   Call cmdAddCardHistory.Parameters.Append(cmdAddCardHistory.CreateParameter("@pIdCard", adInteger, adParamInput))
   ' ------------------
   
   ' ------------------
   cmdUpdateCardHistory.ActiveConnection = conn
   cmdUpdateCardHistory.CommandText = csSqlUpdateCardHistory
   cmdUpdateCardHistory.CommandTimeout = 0
   cmdUpdateCardHistory.CommandType = adCmdStoredProc
   
   Call cmdUpdateCardHistory.Parameters.Append(cmdUpdateCardHistory.CreateParameter("@return", adInteger, adParamReturnValue))
   Call cmdUpdateCardHistory.Parameters.Append(cmdUpdateCardHistory.CreateParameter("@pIdCardHistory", adInteger, adParamInput))
   Call cmdUpdateCardHistory.Parameters.Append(cmdUpdateCardHistory.CreateParameter("@pBegRest", adDouble, adParamInput))
   Call cmdUpdateCardHistory.Parameters.Append(cmdUpdateCardHistory.CreateParameter("@pEndRest", adDouble, adParamInput))
   Call cmdUpdateCardHistory.Parameters.Append(cmdUpdateCardHistory.CreateParameter("@pTurnoverIn", adDouble, adParamInput))
   Call cmdUpdateCardHistory.Parameters.Append(cmdUpdateCardHistory.CreateParameter("@pTurnoverOut", adDouble, adParamInput))
   ' ------------------
   
   ' ------------------
   cmdAddCardOperation.ActiveConnection = conn
   cmdAddCardOperation.CommandText = csSqlAddCardOperation
   cmdAddCardOperation.CommandTimeout = 0
   cmdAddCardOperation.CommandType = adCmdStoredProc
   
   Call cmdAddCardOperation.Parameters.Append(cmdAddCardOperation.CreateParameter("@return", adInteger, adParamReturnValue))
   Call cmdAddCardOperation.Parameters.Append(cmdAddCardOperation.CreateParameter("@pNumD", adInteger, adParamInput))
   Call cmdAddCardOperation.Parameters.Append(cmdAddCardOperation.CreateParameter("@pNumV", adInteger, adParamInput))
   Call cmdAddCardOperation.Parameters.Append(cmdAddCardOperation.CreateParameter("@pTransDate", adDate, adParamInput))
   Call cmdAddCardOperation.Parameters.Append(cmdAddCardOperation.CreateParameter("@pTransType", adInteger, adParamInput))
   Call cmdAddCardOperation.Parameters.Append(cmdAddCardOperation.CreateParameter("@pTransNum", adInteger, adParamInput))
   Call cmdAddCardOperation.Parameters.Append(cmdAddCardOperation.CreateParameter("@pPayDate", adDate, adParamInput))
   Call cmdAddCardOperation.Parameters.Append(cmdAddCardOperation.CreateParameter("@pSummIn", adDouble, adParamInput))
   Call cmdAddCardOperation.Parameters.Append(cmdAddCardOperation.CreateParameter("@pSummOut", adDouble, adParamInput))
   Call cmdAddCardOperation.Parameters.Append(cmdAddCardOperation.CreateParameter("@pTransRem", adVarChar, adParamInput, 50))
   Call cmdAddCardOperation.Parameters.Append(cmdAddCardOperation.CreateParameter("@pIdCardHistory", adInteger, adParamInput))
   ' ------------------
   
   Prepare = True
   Exit Function
   
Error_Prepare:
   Call ErrorMessage(m_csModuleName, "Prepare")
End Function
' =======================================

' =======================================
Private Function AddCardFile(strCardFileName As String, strCardFileSize As String) As Long
   On Error GoTo Error_AddCardFile
   
   AddCardFile = 0
   
   conn.BeginTrans
   
   cmdAddCardFile.Parameters("@return").value = 0
   cmdAddCardFile.Parameters("@pCardFileName").value = strCardFileName
   cmdAddCardFile.Parameters("@pCardFileSize").value = strCardFileSize
   
   Set cmdRs = cmdAddCardFile.Execute()
   AddCardFile = cmdAddCardFile.Parameters("@return").value
   
   conn.CommitTrans
   
   Exit Function
   
Error_AddCardFile:
   Call ErrorMessage(m_csModuleName, "AddCardFile")
   conn.RollbackTrans
   'Resume Next
End Function
' =======================================

' =======================================
Private Function GetCardFileId(strCardFileName As String, strCardFileSize As String) As Long
   On Error GoTo Error_GetCardFileId
   
   GetCardFileId = 0
   conn.BeginTrans
   
   cmdGetCardFileId.Parameters("@return").value = 0
   cmdGetCardFileId.Parameters("@pCardFileName").value = strCardFileName
   cmdGetCardFileId.Parameters("@pCardFileSize").value = strCardFileSize
   
   Set cmdRs = cmdGetCardFileId.Execute()
   GetCardFileId = cmdGetCardFileId.Parameters("@return").value
   
   conn.CommitTrans
   
   Exit Function
   
Error_GetCardFileId:
   Call ErrorMessage(m_csModuleName, "GetCardFileId")
   conn.RollbackTrans
   'Resume Next
End Function
' =======================================

' =======================================
Private Function CardFileEndLoad(strIdCardFile As String) As Long
   On Error GoTo Error_GetCardFileId
   
   CardFileEndLoad = 0
   conn.BeginTrans
   
   cmdCardFileEndLoad.Parameters("@return").value = 0
   cmdCardFileEndLoad.Parameters("@pIdCardFile").value = strIdCardFile
   
   Set cmdRs = cmdCardFileEndLoad.Execute()
   CardFileEndLoad = cmdCardFileEndLoad.Parameters("@return").value
   
   conn.CommitTrans
   
   Exit Function
   
Error_GetCardFileId:
   Call ErrorMessage(m_csModuleName, "CardFileEndLoad")
   conn.RollbackTrans
   'Resume Next
End Function
' =======================================

' =======================================
Private Function AddCard(strCardNum As String, strAccountNum As String, strCardType As String, _
   strCurrencyCode As String, strClientName As String, strAccountOpenDate As String, _
   strBankCode As String, strOsbNum As String, strVspNum As String) As Long
   On Error GoTo Error_AddCard
   
   AddCard = 0
   conn.BeginTrans
   
   cmdAddCard.Parameters("@return").value = 0
   cmdAddCard.Parameters("@pCardNum").value = strCardNum
   cmdAddCard.Parameters("@pAccountNum").value = strAccountNum
   cmdAddCard.Parameters("@pCardType").value = strCardType
   cmdAddCard.Parameters("@pCurrencyCode").value = strCurrencyCode
   cmdAddCard.Parameters("@pClientName").value = strClientName
   cmdAddCard.Parameters("@pAccountOpenDate").value = strAccountOpenDate
   cmdAddCard.Parameters("@pBankCode").value = strBankCode
   cmdAddCard.Parameters("@pOsbNum").value = strOsbNum
   cmdAddCard.Parameters("@pVspNum").value = strVspNum
      
   Set cmdRs = cmdAddCard.Execute()
   AddCard = cmdAddCard.Parameters("@return").value
   
   conn.CommitTrans
   
   Exit Function
   
Error_AddCard:
   Call ErrorMessage(m_csModuleName, "AddCard")
   conn.RollbackTrans
   'Resume Next
End Function
' =======================================

' =======================================
Private Function AddCardHistory(strBegDate As String, strEndDate As String, strCardLimit As String, _
   strUnicardDate As String, strIdCardFile As String, strIdCard As String) As Long
   On Error GoTo Error_AddCardHistory
   
   AddCardHistory = 0
   conn.BeginTrans
   
   cmdAddCardHistory.Parameters("@return").value = 0
   cmdAddCardHistory.Parameters("@pBegDate").value = strBegDate
   cmdAddCardHistory.Parameters("@pEndDate").value = strEndDate
   cmdAddCardHistory.Parameters("@pCardLimit").value = strCardLimit
   cmdAddCardHistory.Parameters("@pUnicardDate").value = strUnicardDate
   cmdAddCardHistory.Parameters("@pIdCardFile").value = strIdCardFile
   cmdAddCardHistory.Parameters("@pIdCard").value = strIdCard
   
   Set cmdRs = cmdAddCardHistory.Execute()
   AddCardHistory = cmdAddCardHistory.Parameters("@return").value
   
   conn.CommitTrans
   
   Exit Function
   
Error_AddCardHistory:
   Call ErrorMessage(m_csModuleName, "AddCardHistory")
   conn.RollbackTrans
   'Resume Next
End Function
' =======================================

' =======================================
Private Function UpdateCardHistory(strIdCardHistory As String, strBegRest As String, strEndRest As String, _
   strTurnoverIn As String, strTurnoverOut As String) As Long
   On Error GoTo Error_UpdateCardHistory
   
   UpdateCardHistory = 0
   conn.BeginTrans
   
   cmdUpdateCardHistory.Parameters("@return").value = 0
   cmdUpdateCardHistory.Parameters("@pIdCardHistory").value = strIdCardHistory
   cmdUpdateCardHistory.Parameters("@pBegRest").value = strBegRest
   cmdUpdateCardHistory.Parameters("@pEndRest").value = strEndRest
   cmdUpdateCardHistory.Parameters("@pTurnoverIn").value = strTurnoverIn
   cmdUpdateCardHistory.Parameters("@pTurnoverOut").value = strTurnoverOut
   
   Set cmdRs = cmdUpdateCardHistory.Execute()
   UpdateCardHistory = cmdUpdateCardHistory.Parameters("@return").value
   
   conn.CommitTrans
   
   Exit Function
   
Error_UpdateCardHistory:
   Call ErrorMessage(m_csModuleName, "UpdateCardHistory")
   conn.RollbackTrans
   'Resume Next
End Function
' =======================================

' =======================================
Private Function AddCardOperation(strNumD As String, strNumV As String, strTransDate As String, _
   strTransType As String, strTransNum As String, strPayDate As String, strSummIn As String, _
   strSummOut As String, strTransRem As String, strIdCardHistory As String) As Long
   On Error GoTo Error_AddCardOperation
   
   AddCardOperation = 0
   conn.BeginTrans
   
   cmdAddCardOperation.Parameters("@return").value = 0
   cmdAddCardOperation.Parameters("@pNumD").value = strNumD
   cmdAddCardOperation.Parameters("@pNumV").value = strNumV
   cmdAddCardOperation.Parameters("@pTransDate").value = strTransDate
   cmdAddCardOperation.Parameters("@pTransType").value = strTransType
   cmdAddCardOperation.Parameters("@pTransNum").value = strTransNum
   cmdAddCardOperation.Parameters("@pPayDate").value = strPayDate
   cmdAddCardOperation.Parameters("@pSummIn").value = strSummIn
   cmdAddCardOperation.Parameters("@pSummOut").value = strSummOut
   cmdAddCardOperation.Parameters("@pTransRem").value = strTransRem
   cmdAddCardOperation.Parameters("@pIdCardHistory").value = strIdCardHistory
   
   Set cmdRs = cmdAddCardOperation.Execute()
   AddCardOperation = cmdAddCardOperation.Parameters("@return").value
   
   conn.CommitTrans
   
   Exit Function
   
Error_AddCardOperation:
   Call ErrorMessage(m_csModuleName, "AddCardOperation")
   conn.RollbackTrans
   'Resume Next
End Function
' =======================================

' =======================================
Private Sub Class_Terminate()
   ' add your code this
End Sub
' =======================================

' =======================================
'************************************************************************************
'* Функция форматирующая дату, переводит дату из формата 15NOV05 в формат 15.11.05  *
'************************************************************************************
Private Function ConvertDate(strDate As String) As String
   On Error Resume Next

   Dim strNewDate As String, i As Long, strStr As String
   strNewDate = strDate
    
   For i = 0 To 11
      If (InStr(strNewDate, monthListEng(i)) > 0) Then
         strStr = "00" & CStr(i + 1)
         strStr = "." & right(strStr, 2) & "."
         strNewDate = Replace(strNewDate, monthListEng(i), strStr)
         Exit For
      End If
      
      If (InStr(strNewDate, monthListRus(i)) > 0) Then
         strStr = "00" & CStr(i + 1)
         strStr = "." & right(strStr, 2) & "."
         strNewDate = Replace(strNewDate, monthListRus(i), strStr)
         Exit For
      End If
   Next i
   
   ConvertDate = strNewDate
End Function
' =======================================

' =======================================
Private Function Convert2TrueNumber(strNumber As String) As String
   If (TrueDecDelimiter = ",") Then
      Convert2TrueNumber = Replace(strNumber, ".", ",")
   Else
      Convert2TrueNumber = Replace(strNumber, ",", ".")
   End If
End Function
' =======================================

' =======================================
' импорт одного файла *.svv либо *.sve с импользованием xml
' на входе:
' strFileName - имя исходного файла *.svv либо *.sve
' strTextCode - кодировка исходного файла
' pForm - форма для отображения процесса
' strConnectionString - строка соединения
' на выходе код результата
' =======================================
Private Function Import_One_SvvSveWithXml(strFileName As String, strTextCode As String, _
   pForm As cProgressForm, strConnectionString As String) As Byte
   
   ' установим обработчик ошибок
   On Error GoTo Error_Import_One_SvvSveWithXml
   
   ' изначально полагаем, что все прекрасно, при наличии ошибок отметим это
   Import_One_SvvSveWithXml = cnResultOk
   
   ' объект для генерации xml и последующей его передачи на сервер
   Dim xml As New CXml4Db, bResult As Boolean
   bResult = xml.Prepare(strConnectionString, csSqlXmlProcedureName, csSqlXmlProcedureParam)
   
   ' локальные переменные
   Dim fso As Variant, InFile As Variant, TextStream As Variant
   Dim strInText As String ', strTmp As String
   Dim nFileSize As Long, nLoadSize As Long, nLoadPercent As Long, nLen As Long
   
   ' покажем какой файл мы импортируем
   pForm.Label3 = strFileName
   
   ' открываем входной файл
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set InFile = fso.GetFile(strFileName)
   Set TextStream = InFile.OpenAsTextStream(1)
   
   ' инициализация счетчиков
   nFileSize = InFile.Size
   nLoadSize = 0
   nLoadPercent = 0
   
   ' определение типа используемой кодировки кодировки
   Dim nEncode As Byte
   nEncode = 0
   
   If UCase(strTextCode) = UCase("DOS -> Windows") Then nEncode = 1
   If UCase(strTextCode) = UCase("Windows -> DOS") Then nEncode = 2
   
   ' еще локальные переменные
   Dim bStart As Boolean, bDataBlock As Boolean
   Dim BankCode As String, OsbNum As String, VspNum As String, CardType As String
   Dim CardNum As String, AccountNum As String, CurrencyCode As String
   Dim ClientName As String, AccountOpenDate As String, BegDate As String, EndDate As String
   Dim CardLimit As String, UnicardDate As String, BegRest As String, EndRest As String
   Dim TurnoverIn As String, TurnoverOut As String, NumD As String, NumV As String
   Dim TransDate As String, TransType As String, TransNum As String, PayDate As String
   Dim SummIn As String, SummOut As String, TransRem As String, strStr As String
   Dim strSplitArray As Variant
   Dim IdCardHistory As String, IdCardFile As String, IdCard As String
   Dim IdCardOperation As String  ', IdBank As String, IdCardType As String
   'Dim nPos As Long, nPos2 As Long, nPos3 As Long, nLocLen As Long,
   Dim i As Long, strTrueFileName As String, nResult As Long, nFlushCount As Long
   
   nFlushCount = 0
   ' в идеале конечно же нужно вычислить хэш файла, тогда можно утверждать, что файл уникален ...
   
   ' проверим был ли файл загружен ранее
   strTrueFileName = left(strFileName, 800)
'   IdCardFile = GetCardFileId(strTrueFileName, CStr(nFileSize))
   IdCardFile = "0"           ' заглушка пока пробуем без базы
   ' если файл бы загружен ранее, то на выход.
   If (Val(IdCardFile) > 0) Then GoTo Exit_Import_One_SvvSveWithXml
   
   ' зарегистрируем данный файл
'   IdCardFile = AddCardFile(strTrueFileName, CStr(nFileSize))
   
   ' флажки для парсинга
   bStart = False
   bDataBlock = False
   
   ' main loop
   Do While Not TextStream.AtEndOfStream
      ' читаем очередную строку
      strInText = TextStream.ReadLine
      
      ' optimize ecoding string
      If (nEncode = 1) Then strInText = Dos2Win(CStr(strInText))
      If (nEncode = 2) Then strInText = Win2Dos(CStr(strInText))
      
      ' определяем длину и все приводим к верхнему регистру
      nLen = Len(strInText)
      strInText = UCase(strInText)
      
      ' разбираем текст, если был дан старт
      If bStart Then
         If (InStr(strInText, "Остаток на конец  периода :") > 0) Then
         
            ' если нашли "Остаток на конец  периода :" значит блок данных закончился,
            ' ставим соответствующий признак и определяем сумму остатка
            bDataBlock = False
            EndRest = Convert2TrueNumber(Trim(Replace(strInText, "Остаток на конец  периода :", "")))
            
            ' теперь необходимо выполнить prc_UpdateCardHistory
            'IdCardHistory = UpdateCardHistory(IdCardHistory, BegRest, EndRest, TurnoverIn, TurnoverOut)
            
            ' формируем xml
            ' данные по истории
' ---------------------------------------------
            Call xml.AddData("BegRest", BegRest)
            Call xml.AddData("EndRest", EndRest)
            Call xml.AddData("TurnoverIn", TurnoverIn)
            Call xml.AddData("TurnoverOut", TurnoverOut)
            
            ' закроем тэг Main
            Call xml.CloseTag
            
            ' теперь нужно определить необходимость сброса данных в базу данных на ms sql server
            If (xml.FillLevel > 50) Then
               nResult = xml.FlushBuffer()
               nFlushCount = nFlushCount + 1
               Call SysCmd(acSysCmdSetStatus, "Flush count: " & nFlushCount)
            End If
' ---------------------------------------------

            ' clear all var's
            BankCode = ""
            OsbNum = ""
            VspNum = ""
            CardType = ""
            CardNum = ""
            AccountNum = ""
            CurrencyCode = ""
            ClientName = ""
            AccountOpenDate = ""
            BegDate = ""
            EndDate = ""
            CardLimit = ""
            UnicardDate = ""
            BegRest = ""
            EndRest = ""
            TurnoverIn = ""
            TurnoverOut = ""
            NumD = ""
            NumV = ""
            TransDate = ""
            TransType = ""
            TransNum = ""
            PayDate = ""
            SummIn = ""
            SummOut = ""
            TransRem = ""
            IdCardHistory = ""
            IdCardOperation = ""
            'IdCardFile = ""
            IdCard = ""
            'IdBank = ""
            'IdCardType = ""
            
         ElseIf (InStr(strInText, "Остаток на начало периода :") > 0) Then
         
            ' определяем остаток на начало периода
            BegRest = Convert2TrueNumber(Trim(Replace(strInText, "Остаток на начало периода :", "")))
            
         ElseIf (InStr(strInText, "Итого :") > 0) Then
         
            ' определяем обороты по приходу и расходу
            strStr = Trim(Replace(strInText, "Итого :", ""))
            
            ' убираем задвоенность пробелов
            Do While (InStr(strStr, "  ") > 0)
               strStr = Replace(strStr, "  ", " ")
            Loop
            
            strSplitArray = Split(strStr, " ")
            TurnoverIn = Convert2TrueNumber(Trim(strSplitArray(LBound(strSplitArray))))
            TurnoverOut = Convert2TrueNumber(Trim(strSplitArray(LBound(strSplitArray) + 1)))
         
         ElseIf (InStr(strInText, "История по карточному счету клиента за период :") > 0) Then
         
            ' парсим данные
            strStr = Trim(Replace(strInText, "История по карточному счету клиента за период :", ""))
            strSplitArray = Split(strStr, "-")
            BegDate = Trim(strSplitArray(LBound(strSplitArray)))
            EndDate = Trim(strSplitArray(LBound(strSplitArray) + 1))
            
            ' отмечаем, что найден блок данных
            bDataBlock = True
            
            ' формируем xml
            ' если еще ни чего нет, то нужно вставить первые тэги
' ---------------------------------------------
            If (xml.CurrentSize = 0) Then
               Call xml.OpenTag("Root")
               Call xml.AddData("FileId", IdCardFile)
            End If
' ---------------------------------------------

         ElseIf (InStr(strInText, "Банк :") > 0) Then
         
            strStr = Replace(strInText, "Банк :", "")
            strStr = Trim(Replace(strStr, "Дата обработки в системе UniCard :", ""))
            
            ' убираем задвоенность пробелов
            Do While (InStr(strStr, "  ") > 0)
               strStr = Replace(strStr, "  ", " ")
            Loop
            
            strSplitArray = Split(strStr, " ")
            BankCode = left(Trim(strSplitArray(LBound(strSplitArray))), 2)
            UnicardDate = Trim(strSplitArray(LBound(strSplitArray) + 1))
            
         ElseIf (InStr(strInText, "Карточка :") > 0) Then
         
            strStr = Trim(Replace(strInText, "Карточка :", ""))
            
            ' убираем задвоенность пробелов
            Do While (InStr(strStr, "  ") > 0)
               strStr = Replace(strStr, "  ", " ")
            Loop
            
            strSplitArray = Split(strStr, " ")
            CardNum = left(Trim(strSplitArray(LBound(strSplitArray))), 25)
            
            CardType = ""
            For i = LBound(strSplitArray) + 1 To UBound(strSplitArray)
               CardType = CardType & " " & Trim(strSplitArray(i))
            Next i
            
            CardType = left(Trim(CardType), 50)
            
         ElseIf (strInText Like "*Счет номер : ####################* /   Валюта счета : * /  Кредит.лимит :*") Then
         
            ' вариант обработки с номером счета
            
            strStr = Replace(strInText, "Счет номер :", "")
            strStr = Replace(strStr, "/   Валюта счета :", "")
            strStr = Trim(Replace(strStr, "/  Кредит.лимит :", ""))
            
            ' убираем задвоенность пробелов
            Do While (InStr(strStr, "  ") > 0)
               strStr = Replace(strStr, "  ", " ")
            Loop
            
            strSplitArray = Split(strStr, " ")
            AccountNum = left(Trim(strSplitArray(LBound(strSplitArray))), 20)
            CurrencyCode = left(Trim(strSplitArray(LBound(strSplitArray) + 1)), 3)
            CardLimit = Convert2TrueNumber(Trim(strSplitArray(LBound(strSplitArray) + 2)))
            
            ' если нет номера счета, все рушится!
            
         ElseIf (strInText Like "*Счет номер :    /   Валюта счета : * /  Кредит.лимит :*") Then
            
            ' вариант обработки, когда отсутствует номер счета, без которого все рушится.
            
            strStr = Replace(strInText, "Счет номер :    /   Валюта счета :", "")
            strStr = Trim(Replace(strStr, "/  Кредит.лимит :", ""))
            
            ' убираем задвоенность пробелов
            Do While (InStr(strStr, "  ") > 0)
               strStr = Replace(strStr, "  ", " ")
            Loop
            
            strSplitArray = Split(strStr, " ")
            AccountNum = ""
            CurrencyCode = left(Trim(strSplitArray(LBound(strSplitArray))), 3)
            CardLimit = Convert2TrueNumber(Trim(strSplitArray(LBound(strSplitArray) + 1)))
            
            ' если нет номера счета, все рушится!
            
         ElseIf ((InStr(strInText, "Счет номер :") > 0) And (InStr(strInText, "/  Кредит.лимит :") < 1)) Then
         
            ' еще один вариант, видимо что-то упорно падало ...
            
            strStr = Replace(strInText, "Счет номер :", "")
            strStr = Trim(Replace(strStr, "/   Валюта счета :", ""))
            
            ' убираем задвоенность пробелов
            Do While (InStr(strStr, "  ") > 0)
               strStr = Replace(strStr, "  ", " ")
            Loop
            
            strSplitArray = Split(strStr, " ")
            AccountNum = left(Trim(strSplitArray(LBound(strSplitArray))), 20)
            CurrencyCode = left(Trim(strSplitArray(LBound(strSplitArray) + 1)), 3)
            CardLimit = "0"
            
         ElseIf (InStr(strInText, "Фамилия И.О. :") > 0) Then
         
            ClientName = left(Trim(Replace(strInText, "Фамилия И.О. :", "")), 100)
            
         ElseIf (strInText Like "*Отделение / Филиал :*Дата открытия счета :*") Then
         
            strStr = Replace(strInText, "Отделение / Филиал :", "")
            strStr = Replace(strStr, "Дата открытия счета :", "")
            strStr = Replace(strStr, "/", "")
            
            ' убираем задвоенность пробелов
            Do While (InStr(strStr, "  ") > 0)
               strStr = Replace(strStr, "  ", " ")
            Loop
            
            strStr = Trim(strStr)
            strSplitArray = Split(strStr, " ")
            OsbNum = left(Trim(strSplitArray(LBound(strSplitArray))), 4)
            VspNum = left(Trim(strSplitArray(LBound(strSplitArray) + 1)), 5)
            AccountOpenDate = ConvertDate(Trim(strSplitArray(LBound(strSplitArray) + 2)))
            
            ' нужно записать собранные данные по карте
            'IdCard = AddCard(CardNum, AccountNum, CardType, CurrencyCode, ClientName, AccountOpenDate, BankCode, OsbNum, VspNum)
            
            ' нужно записать собранные данные по истории
            'IdCardHistory = AddCardHistory(BegDate, EndDate, CardLimit, UnicardDate, IdCardFile, IdCard)
            
            ' формирование xml
            ' откроем основной тэг
' ---------------------------------------------
            Call xml.OpenTag("Main")
         
            ' данные по карте
            Call xml.AddData("CardNum", CardNum)
            Call xml.AddData("AccountNum", AccountNum)
            Call xml.AddData("CardType", CardType)
            Call xml.AddData("CurrencyCode", CurrencyCode)
            Call xml.AddData("ClientName", ClientName)
            Call xml.AddData("AccountOpenDate", AccountOpenDate)
            Call xml.AddData("BankCode", BankCode)
            Call xml.AddData("OsbNum", OsbNum)
            Call xml.AddData("VspNum", VspNum)
            
            ' данные по истории
            Call xml.AddData("BegDate", BegDate)
            Call xml.AddData("EndDate", EndDate)
            Call xml.AddData("CardLimit", CardLimit)
            Call xml.AddData("UnicardDate", UnicardDate)
' ---------------------------------------------
            
         ElseIf ((InStr(strInText, "Отделение / Филиал :") > 0) _
            And (InStr(strInText, "Дата открытия счета :") < 1) _
            And (InStr(strInText, csFileType3) < 1)) Then
         
            ' Есть файлы в которых отсутствует "Дата открытия счета :", в таком случает программка падает :-(
            strStr = Replace(strInText, "Отделение / Филиал :", "")
            
            ' убираем задвоенность пробелов
            Do While (InStr(strStr, "  ") > 0)
               strStr = Replace(strStr, "  ", " ")
            Loop
            
            strStr = Trim(strStr)
            strSplitArray = Split(strStr, "/")
            OsbNum = left(Trim(strSplitArray(LBound(strSplitArray))), 4)
            VspNum = left(Trim(strSplitArray(LBound(strSplitArray) + 1)), 5)
            AccountOpenDate = "01.01.1900"      ' very old data - for not error
            
            ' нужно записать собранные данные карте
            'IdCard = AddCard(CardNum, AccountNum, CardType, CurrencyCode, ClientName, AccountOpenDate, BankCode, OsbNum, VspNum)
            
            ' нужно записать собранные данные по истории
            'IdCardHistory = AddCardHistory(BegDate, EndDate, CardLimit, UnicardDate, IdCardFile, IdCard)
            
            ' формирование xml
            ' откроем основной тэг
' ---------------------------------------------
            Call xml.OpenTag("Main")
            
            ' данные по карте
            Call xml.AddData("CardNum", CardNum)
            Call xml.AddData("AccountNum", AccountNum)
            Call xml.AddData("CardType", CardType)
            Call xml.AddData("CurrencyCode", CurrencyCode)
            Call xml.AddData("ClientName", ClientName)
            Call xml.AddData("AccountOpenDate", AccountOpenDate)
            Call xml.AddData("BankCode", BankCode)
            Call xml.AddData("OsbNum", OsbNum)
            Call xml.AddData("VspNum", VspNum)
            
            ' данные по истории
            Call xml.AddData("BegDate", BegDate)
            Call xml.AddData("EndDate", EndDate)
            Call xml.AddData("CardLimit", CardLimit)
            Call xml.AddData("UnicardDate", UnicardDate)
' ---------------------------------------------
            
         Else
            strStr = Mid(strInText, 1, 1)
            
            If (IsNumeric(strStr) And bDataBlock) Then
               strStr = Trim(Mid(strInText, 1, 15))
               strSplitArray = Split(strStr, "/")
               
               NumD = Trim(strSplitArray(LBound(strSplitArray)))
               NumV = Trim(strSplitArray(LBound(strSplitArray) + 1))
               
               TransDate = ConvertDate(Trim(Mid(strInText, 16, 10)))
               TransType = Trim(Mid(strInText, 27, 6))
               TransNum = Trim(Mid(strInText, 35, 8))
               
               PayDate = right("00" & Trim(Mid(strInText, 45, 6)), 4)
               If (Val(left(PayDate, 2)) > 31) Then PayDate = "0" & left(PayDate, 3)
               PayDate = left(PayDate, 2) & "." & right(PayDate, 2) & "." & right(BegDate, 4)
               
               SummIn = Convert2TrueNumber(Trim(Mid(strInText, 49, 16)))
               SummOut = Convert2TrueNumber(Trim(Mid(strInText, 65, 16)))
               TransRem = left(Trim(Mid(strInText, 85)), 50)
               
               'If (Len(TransRem) < 1) Then TransRem = "-"
               
               ' нужно записать накопленное!
               'IdCardOperation = AddCardOperation(NumD, NumV, TransDate, TransType, TransNum, PayDate, SummIn, SummOut, TransRem, IdCardHistory)
               
               ' формирование xml
               ' откроем дополнительный тэг
' ---------------------------------------------
               Call xml.OpenTag("Add")
               
               ' данные по истории
               Call xml.AddData("NumD", NumD)
               Call xml.AddData("NumV", NumV)
               Call xml.AddData("TransDate", TransDate)
               Call xml.AddData("TransType", TransType)
               Call xml.AddData("TransNum", TransNum)
               Call xml.AddData("PayDate", PayDate)
               Call xml.AddData("SummIn", SummIn)
               Call xml.AddData("SummOut", SummOut)
               Call xml.AddData("TransRem", TransRem)
               
               ' закроем тэг add
               Call xml.CloseTag
' ---------------------------------------------
            End If
         End If
      Else
         ' поиск признака файла svv либо sve
         'If ((InStr(strInText, csFileType1) > 0) Or _
            (InStr(strInText, csFileType2) > 0) Or _
            (InStr(strInText, csFileType3) > 0)) Then
         If (InStr(strInText, csFileType3) > 0) Then
               ' если признак найден, то запускаем парсер
               bStart = True
         End If
      End If
      
      ' calc progress bar, update info & show
      nLoadSize = nLoadSize + nLen ' + 2 ' 2 bytes = char 13 + char 10
      nLoadPercent = Fix(nLoadSize / nFileSize * 100)
        
      pForm.ProgressBar1 = nLoadPercent
        
      If (pForm.Update) Then
         Import_One_SvvSveWithXml = cnResultCancel
         Exit Do
      End If
   Loop
   
   ' set time of card file end load
   IdCardFile = CardFileEndLoad(IdCardFile)
   
Exit_Import_One_SvvSveWithXml:
   TextStream.Close
   Set TextStream = Nothing
   Set InFile = Nothing
   Set fso = Nothing
   Exit Function
   
Error_Import_One_SvvSveWithXml:
   'Call ErrorMessage(m_csModuleName, "Import_One_SvvSveWithXml")
   Import_One_SvvSveWithXml = cnResultError
   Debug.Print Err.Description
   Resume Next
End Function
' =======================================

' =======================================
' Импортер файлов *.svv, *.sve, через технологию xml
' =======================================
Public Function Import_Group_SvvSve_WithXml(strFilePath As String, strFileMask As String, strTextCode As String, _
   strConnectionString As String) As Byte
   
   ' установим обработчик событий
   On Error GoTo Error_Import_Group_SvvSve_WithXml
   
   ' локальные переменны
   Dim pFileList As New Collection
   Dim nFileCount As Long, i As Long, nLoadPercent As Long, nFileImport As Long
   Dim prgForm As New cProgressForm
   Dim strFileName As Variant, nResult As Byte
   Dim strMsg As String
   
   ' предварительно полагаем, что все нормально
   Import_Group_SvvSve_WithXml = cnResultOk
   
   'If (Not Prepare(strConnectionString)) Then
      'Import_Group_SvvSve = cnResultError
      'Exit Function
   'End If
   
   ' создадим для пользователя форму
   Call prgForm.CreateForm(3)
   
   prgForm.EventPeriod = 3000
   prgForm.Caption = "Мастер импорта историй по карточному счету"
   prgForm.Label1 = "Импорт файлов историй по карточному счету (*.svv, *.sve)"
   prgForm.Label2 = "Импортируется файл: "
   
   Call prgForm.FormShow
   Call prgForm.FormSetFocus
   
   ' сформируем список файлов, которые необходимо импортировать
   Call GetFileList(strFilePath, strFileMask, pFileList)
   
   ' инициализируем количество файлов для импорта и количество импортированных файлов
   nFileCount = pFileList.Count
   nFileImport = 0
   
   ' если не найдено файлов, то завершает работу
   If (nFileCount <= 0) Then
      Exit Function
   End If
   
   ' цикл по списку файлов
   For Each strFileName In pFileList
      nResult = Import_One_SvvSveWithXml(CStr(strFileName), strTextCode, prgForm, strConnectionString)
      'nResult = Import_One_SvvSve(CStr(strFileName), strTextCode, prgForm)
      Import_Group_SvvSve_WithXml = nResult
      
      ' проверка действий пользователя
      If (nResult = cnResultCancel) Then Exit Function
      
      ' вычисление статистики
      nFileImport = nFileImport + 1
      nLoadPercent = Fix(nFileImport / nFileCount * 100)
      
      strMsg = "Импортированно " & nFileImport & " (" & nLoadPercent & _
         "%) из " & nFileCount & " файлов."
      
      ' отображение статистики
      prgForm.Label4 = strMsg
      prgForm.ProgressBar2 = nLoadPercent
      Call prgForm.FormRepaint
   Next strFileName
   
Exit_Import_Group_SvvSve_WithXml:
   Exit Function
   
   ' обработчик ошибок
Error_Import_Group_SvvSve_WithXml:
   Call ErrorMessage(m_csModuleName, "Import_Group_SvvSve_WithXml")
   Import_Group_SvvSve_WithXml = cnResultError
   Resume Next
End Function
' =======================================