Экспорт пакетов УРМ

Все вопросы по УРМ
Аватара пользователя
Val
зам. председателя совета директоров
зам. председателя совета директоров
Сообщения: 2029
Зарегистрирован: 09.06.2004 08:52
Откуда: Ейск
Контактная информация:

Экспорт пакетов УРМ

Сообщение Val » 30.06.2011 11:19

В организациях, которые получают в УРМ большое количество пакетов с ЭЦП (эл. выписок), возникает ситуация, в которой ответственный работник вынужден заходить в каждый пакет УРМ и сохранять каждое вложение. Это достаточно трудоемко.
Возможно в новых версиях что-то изменилось.
Сделал программу, которая работает независимо от УРМ, обращается напрямую к базе УРМ для получения пакетов, разбирает пакеты, экспортирует содержимое пакетов в виде cll и xls файлов, умеет отправлять их по электронной почте (нужен справочник связок лс -> эл. адрес) и проверять корректность ЭЦП.
Главное окно:
main.gif

Окно настроек:
options.gif

Контекстное меню:
context.gif


В результате экспорта (по указанному в настройках пути) создается подкаталог с именем-номером лс, в него попадают zip файлы вида z_(дата_пакета_формат_криста)_(id_пакета).zip.
В случае соответствующих настроек по эл.почте эти файлы рассылаются.

Описание настроек
Имя хоста - ip адрес или сетевое имя компьютера, на котором запущен IB/Yaffil, поддерживающий базу УРМ.
Путь к базе - локальный для этого компьютера путь к базе данных.
Имя файла базы бюджета - имя файла базы данных, содержащей бюджетные данные.
Имя файла базы внебюджета - имя файла базы данных, содержащей внебюджетные данные.
(в случае, если разделения бюджет/внебюджет нет, можно указывать одну базу)
Путь к файлам - путь к каталогу, содержащему оригинальные файлы пакетов (тип dse). В данном каталоге должны быть подкаталоги с именами-датами в формате кристы.
Путь экспорта - путь к каталогу, в который будут экспортироваться файлы.
Путь к файлу адресов - файл-справочник соответствий лс->эл.адрес. В нем указывается лс (без пробелов и точек), "точкасзапятой",эл.адрес.
Отправлять почтой - вкл/выкл. функцию отправки почтой данных обработанного пакета.
Хост - адрес или имя почтового сервера SMTP.
Порт - порт почтового сервера.
Имя - имя пользователя SMTP, имеющего право на пересылку через данный почтовый сервер.
Пароль - пароль пользователя SMTP, имеющего право на пересылку через данный почтовый сервер.
Обр.адрес - адрес возврата для писем.

Принцип работы
Содержимое файла dse грузится в память.
Декомпрессия всего содержимого.
В данных содержится сам пакет и подпись, и то и другое компрессовано.
Декомпрессия пакета.
Декомпрессия подписи.
Из подписи выделяем сертификат.
Анализируем пакет (формат xml).

Поля основного окна
disk - флаг присутствия обработанного пакета на диске.
bv - бюджет/внебюджет.
email - признак наличия адреса электронной почты в справочнике для лицевого счета данного пакета.
packetid - id пакета в базе УРМ.
packetcreatedate - дата создания пакета в формате кристы.
facialacc_cls - лицевой счет данного пакета.
reportdate - дата в формате кристы на которую сделан отчет.
ecpname - сведения о эцп, которой подписан пакет / результат контроля эцп (теперь через контекстное меню можно вызвать отображение сертификата)
name - наименование лицевого счета данного пакета.

Основной объект, реализующий функции обработке dse файла

Код: Выделить всё

' Val, 2011, SOPUBP3
' v.2.0.0.0
' Объект выполняющий обработку dse файлов (распаковку, разбор, отправку)
' В рамках поддержки недокументированных функций УРМ АС Бюджет.

Option Explicit On
Imports System.Xml
Imports System.Security.Cryptography
Imports System.Security.Cryptography.X509Certificates
Imports System.Runtime.InteropServices
Imports ICSharpCode.SharpZipLib.Zip
Imports CAPICOM
Public Class dse2
    Private Const CAPICOM_TRUST_IS_NOT_TIME_VALID = 1
    Private Const CAPICOM_TRUST_IS_NOT_TIME_NESTED = 2
    Private Const CAPICOM_TRUST_IS_REVOKED = 4
    Private Const CAPICOM_TRUST_IS_NOT_SIGNATURE_VALID = 8
    Private Const CAPICOM_TRUST_IS_NOT_VALID_FOR_USAGE = 16
    Private Const CAPICOM_TRUST_IS_UNTRUSTED_ROOT = 32
    Private Const CAPICOM_TRUST_REVOCATION_STATUS_UNKNOWN = 64
    Private Const CAPICOM_TRUST_IS_CYCLIC = 128
    Private Const CAPICOM_TRUST_INVALID_EXTENSION = 256
    Private Const CAPICOM_TRUST_INVALID_POLICY_CONSTRAINTS = 512
    Private Const CAPICOM_TRUST_INVALID_BASIC_CONSTRAINTS = 1024
    Private Const CAPICOM_TRUST_INVALID_NAME_CONSTRAINTS = 2048
    Private Const CAPICOM_TRUST_HAS_NOT_SUPPORTED_NAME_CONSTRAINT = 4096
    Private Const CAPICOM_TRUST_HAS_NOT_DEFINED_NAME_CONSTRAINT = 8192
    Private Const CAPICOM_TRUST_HAS_NOT_PERMITTED_NAME_CONSTRAINT = 16384
    Private Const CAPICOM_TRUST_HAS_EXCLUDED_NAME_CONSTRAINT = 32768
    Private Const CAPICOM_TRUST_IS_OFFLINE_REVOCATION = 16777216
    Private Const CAPICOM_TRUST_NO_ISSUANCE_CHAIN_POLICY = 33554432
    Private Const CAPICOM_TRUST_IS_PARTIAL_CHAIN = 65536
    Private Const CAPICOM_TRUST_CTL_IS_NOT_TIME_VALID = 131072
    Private Const CAPICOM_TRUST_CTL_IS_NOT_SIGNATURE_VALID = 262144
    Private Const CAPICOM_TRUST_CTL_IS_NOT_VALID_FOR_USAGE = 524288

    Private Const CAPICOM_CHECK_NONE = 0
    Private Const CAPICOM_CHECK_TRUSTED_ROOT = 1
    Private Const CAPICOM_CHECK_TIME_VALIDITY = 2
    Private Const CAPICOM_CHECK_SIGNATURE_VALIDITY = 4
    Private Const CAPICOM_CHECK_ONLINE_REVOCATION_STATUS = 8
    Private Const CAPICOM_CHECK_OFFLINE_REVOCATION_STATUS = 16
    Private Const CAPICOM_CHECK_COMPLETE_CHAIN = 32
    Private Const CAPICOM_CHECK_NAME_CONSTRAINTS = 64
    Private Const CAPICOM_CHECK_BASIC_CONSTRAINTS = 128
    Private Const CAPICOM_CHECK_NESTED_VALIDITY_PERIOD = 256
    Private Const CAPICOM_CHECK_ONLINE_ALL = 495
    Private Const CAPICOM_CHECK_OFFLINE_ALL = 503

    Private Const CAPICOM_MEMORY_STORE = 0
    Private Const CAPICOM_LOCAL_MACHINE_STORE = 1
    Private Const CAPICOM_CURRENT_USER_STORE = 2
    Private Const CAPICOM_ACTIVE_DIRECTORY_USER_STORE = 3
    Private Const CAPICOM_SMART_CARD_USER_STORE = 4

    Private Const CAPICOM_STORE_OPEN_READ_ONLY = 0
    Private Const CAPICOM_STORE_OPEN_READ_WRITE = 1
    Private Const CAPICOM_STORE_OPEN_MAXIMUM_ALLOWED = 2
    Private Const CAPICOM_STORE_OPEN_EXISTING_ONLY = 128
    Private Const CAPICOM_STORE_OPEN_INCLUDE_ARCHIVED = 256

    Private Const CAPICOM_MY_STORE = "My"
    Private Const CAPICOM_CA_STORE = "Ca"
    Private Const CAPICOM_ROOT_STORE = "Root"
    Private Const CAPICOM_OTHER_STORE = "AddressBook"

    Private Const const_pref_packet = "B_"
    Private Const const_pref_zip = "z_"
    Private Const const_ex_main = ".dse"
    Private Const const_xml_file_name = "autogen"
    Private Const const_node_list_name = "/Packet/Section"

    Private Const const_ex_cll = ".cll"
    Private Const const_ex_xls = ".xls"
    Private Const const_ex_zip = ".zip"

    ' смещения, которые я не смог рассчитать
    Private Const const_level2_offset_len_data = 32
    Private Const const_level2_offset_data = 71
    Private Const const_level2_inc = 4

    Private Const UNCOMPRESSION_OFS1 = 20
    '

    Private Const ERR_EMAIL = 84
    Private Const ERR_COMPRESSION = 80
    Private Const ERR_COMPRESSION1 = 81
    Private Const ERR_MAIN = 79
    Private Const ERR_ARH = 78

    Private l_pathin As String
    Private l_pathout As String
    Private l_file() As Byte
    Private l_file1() As Byte
    Private l_file2_data() As Byte
    Private l_file2_sign() As Byte
    Private l_filename As String
    Private l_id As String
    Private l_packetdate As String
    Private l_facialacc_cls As String
    Private l_reportdate As String
    Private dt As DataTable
    Private addrs As Hashtable
    Private l_cert As X509Certificate2
    Private l_last_error_ecp As String
    Private logg As log
    ' Возвращает целое из 4 байт
    Private Function getint(ByRef arr As Byte(), ByVal offset As Integer) As Integer
        Dim buf(3) As Byte
        Array.Copy(arr, offset, buf, 0, 4)
        Return BitConverter.ToInt32(buf, 0)
    End Function
    ' конвертация даты из формата кристы в сроку вида dd.mm.yyyy
    Private Function convert_date_from_krista(ByVal str As String) As String
        Return str.Substring(6, 2) & "." & str.Substring(4, 2) & "." & str.Substring(0, 4)
    End Function
    ' Возвращает свободное имя для файла версия2
    Private Function getfreename2(ByVal fns As String, ByVal ex As String) As String
        Dim count As Integer
        count = 0
        Do While System.IO.File.Exists(fns & "_" & count.ToString & ex)
            count += 1
        Loop
        Return fns & "_" & count.ToString & ex
    End Function
    ' вызов декомпрессии
    Private Function uncompress(ByRef rb() As Byte) As Integer
        Try
            Dim len As Long
            If len = 0 Then len = rb.Length
            DelSole.DotZLibCompressor.DotZLib.DeCompressBytes(rb, len * 100)
            Return 0
        Catch myException As Exception
            Return ERR_COMPRESSION
        Finally
        End Try
    End Function
    ' анализ xml файла
    Private Sub uncxml(ByVal buf() As Byte, ByRef dt_l As DataTable)
        Dim m_xmld As XmlDocument
        Dim m_nodelist As XmlNodeList
        Dim m_node As XmlNode
        Dim a As Xml.XmlAttribute
        m_xmld = New XmlDocument()
        Dim x As New System.IO.MemoryStream(buf)
        m_xmld.Load(x)
        x.Close()
        m_nodelist = m_xmld.SelectNodes(const_node_list_name)
        For Each m_node In m_nodelist
            For Each a In m_node.Attributes
                If a.Name = "Type" And a.Value = "3" Then getxmlstring(m_node, const_ex_xls, dt_l)
                If a.Name = "Type" And a.Value = "4" Then getxmlstring(m_node, const_ex_cll, dt_l)
            Next
        Next
        m_node = Nothing
        m_nodelist = Nothing
        m_xmld = Nothing
    End Sub
    ' запись значений нодов в datatable
    Private Sub getxmlstring(ByRef m_node_l As XmlNode, ByVal ext_l As String, ByRef dt_l As DataTable)
        Dim buf_name_l As String
        Dim m_nodelist_l2 As XmlNodeList
        Dim m_node_l2 As XmlNode
        buf_name_l = m_node_l.Attributes.ItemOf("DisplayName").Value
        buf_name_l = buf_name_l.Remove(0, 7)
        buf_name_l = buf_name_l.Replace(" ", "_")
        m_nodelist_l2 = m_node_l.ChildNodes
        For Each m_node_l2 In m_nodelist_l2
            If m_node_l2.Attributes("Name").Value = const_xml_file_name & ext_l Then
                dt_l.Rows.Add(ext_l, buf_name_l, m_node_l2.InnerText)
            End If
        Next
        m_node_l2 = Nothing
        m_nodelist_l2 = Nothing
    End Sub
    ' проверка сертификата подписи + наличие такого же в MY
    Public Function verifycert() As Boolean
        Try
            Dim cert_my As New X509Certificate2
            Dim certs As X509Certificate2Collection
            Dim flag As Boolean = False

            Dim chain As New X509Chain(False)
            chain.ChainPolicy.RevocationMode = X509RevocationMode.NoCheck
            If chain.Build(l_cert) Then
                flag = True
            Else
                Dim cs As X509ChainStatus
                For Each cs In chain.ChainStatus
                    flag = False
                Next
            End If
            'flag = flag And l_cert.Verify
            chain = Nothing

            Dim store As New X509Store(X509Certificates.StoreName.My, StoreLocation.CurrentUser)
            store.Open(OpenFlags.ReadOnly)
            certs = store.Certificates.Find(X509FindType.FindBySerialNumber, l_cert.GetSerialNumberString, True)
            store.Close()
            store = Nothing
            If certs.Count > 0 Then
                cert_my = certs(0)
                If X509Certificate.Equals(l_cert, cert_my) Then
                    flag = True And flag
                Else
                    flag = False
                End If
            Else
                flag = False
            End If
            cert_my = Nothing
            Return flag
        Catch ex As Exception
            pE("Ошибка verifycert" & ex.Message, 0)
            Return False
        End Try
    End Function
    ' функция показа сертификата
    Public Function showcert(ByVal index As Integer) As Boolean
        Dim SignedData As New CAPICOM.SignedData
        Dim utility = New CAPICOM.UtilitiesClass
        Try
            Dim store As New CAPICOM.Store
            SignedData = New CAPICOM.SignedDataClass()
            SignedData.Content = l_file2_data
            SignedData.Verify(l_file2_sign, True, CAPICOM.CAPICOM_SIGNED_DATA_VERIFY_FLAG.CAPICOM_VERIFY_SIGNATURE_AND_CERTIFICATE)
            Dim cert As CAPICOM.Certificate
            cert = SignedData.Certificates(index)
            cert.Display()
        Catch ex As Exception
            pE("Ошибка showcert " & ex.Message, 0)
        End Try
    End Function
    ' функций проверки эцп
    ' на входе массивы данных и эцп
    Public Function verifyecp(ByVal index As Integer) As Boolean
        Dim res As Boolean = False
        Dim SignedData As New CAPICOM.SignedData
        Dim utility = New CAPICOM.UtilitiesClass
        l_last_error_ecp = ""
        Try
            Dim store As New CAPICOM.Store
            SignedData = New CAPICOM.SignedDataClass()
            SignedData.Content = l_file2_data
            SignedData.Verify(l_file2_sign, True, CAPICOM.CAPICOM_SIGNED_DATA_VERIFY_FLAG.CAPICOM_VERIFY_SIGNATURE_AND_CERTIFICATE)
            Dim cert As CAPICOM.Certificate
            cert = SignedData.Certificates(index)
            For Each cert In SignedData.Certificates
                cert.IsValid.CheckFlag = CAPICOM_CHECK_TRUSTED_ROOT Or _
                CAPICOM_CHECK_TIME_VALIDITY Or _
                CAPICOM_CHECK_SIGNATURE_VALIDITY Or _
                CAPICOM_CHECK_COMPLETE_CHAIN Or _
                CAPICOM_CHECK_NAME_CONSTRAINTS Or _
                CAPICOM_CHECK_BASIC_CONSTRAINTS Or _
                CAPICOM_CHECK_NESTED_VALIDITY_PERIOD
                If cert.IsValid.Result Then
                    res = True
                Else
                    Dim chain As New Chain
                    chain.Build(cert)
                    If CAPICOM_TRUST_IS_NOT_TIME_VALID And chain.Status Then l_last_error_ecp = "CAPICOM_TRUST_IS_NOT_TIME_VALID"
                    If CAPICOM_TRUST_IS_NOT_TIME_NESTED And chain.Status Then l_last_error_ecp = "CAPICOM_TRUST_IS_NOT_TIME_NESTED"
                    If CAPICOM_TRUST_IS_REVOKED And chain.Status Then l_last_error_ecp = "CAPICOM_TRUST_IS_REVOKED"
                    If CAPICOM_TRUST_IS_NOT_SIGNATURE_VALID And chain.Status Then l_last_error_ecp = "CAPICOM_TRUST_IS_NOT_SIGNATURE_VALID"
                    If CAPICOM_TRUST_IS_NOT_VALID_FOR_USAGE And chain.Status Then l_last_error_ecp = "CAPICOM_TRUST_IS_NOT_VALID_FOR_USAGE"
                    If CAPICOM_TRUST_IS_UNTRUSTED_ROOT And chain.Status Then l_last_error_ecp = "CAPICOM_TRUST_IS_UNTRUSTED_ROOT"
                    If CAPICOM_TRUST_REVOCATION_STATUS_UNKNOWN And chain.Status Then l_last_error_ecp = "CAPICOM_TRUST_REVOCATION_STATUS_UNKNOWN"
                    If CAPICOM_TRUST_IS_CYCLIC And chain.Status Then l_last_error_ecp = "CAPICOM_TRUST_IS_CYCLIC"
                    If CAPICOM_TRUST_INVALID_EXTENSION And chain.Status Then l_last_error_ecp = "CAPICOM_TRUST_INVALID_EXTENSION"
                    If CAPICOM_TRUST_INVALID_POLICY_CONSTRAINTS And chain.Status Then l_last_error_ecp = "CAPICOM_TRUST_INVALID_POLICY_CONSTRAINTS"
                    If CAPICOM_TRUST_INVALID_BASIC_CONSTRAINTS And chain.Status Then l_last_error_ecp = "CAPICOM_TRUST_INVALID_BASIC_CONSTRAINTS"
                    If CAPICOM_TRUST_INVALID_NAME_CONSTRAINTS And chain.Status Then l_last_error_ecp = "CAPICOM_TRUST_INVALID_NAME_CONSTRAINTS"
                    If CAPICOM_TRUST_HAS_NOT_SUPPORTED_NAME_CONSTRAINT And chain.Status Then l_last_error_ecp = "CAPICOM_TRUST_HAS_NOT_SUPPORTED_NAME_CONSTRAINT"
                    If CAPICOM_TRUST_HAS_NOT_DEFINED_NAME_CONSTRAINT And chain.Status Then l_last_error_ecp = "CAPICOM_TRUST_HAS_NOT_DEFINED_NAME_CONSTRAINT"
                    If CAPICOM_TRUST_HAS_NOT_PERMITTED_NAME_CONSTRAINT And chain.Status Then l_last_error_ecp = "CAPICOM_TRUST_HAS_NOT_PERMITTED_NAME_CONSTRAINT"
                    If CAPICOM_TRUST_HAS_EXCLUDED_NAME_CONSTRAINT And chain.Status Then l_last_error_ecp = "CAPICOM_TRUST_HAS_EXCLUDED_NAME_CONSTRAINT"
                    If CAPICOM_TRUST_IS_OFFLINE_REVOCATION And chain.Status Then l_last_error_ecp = "CAPICOM_TRUST_IS_OFFLINE_REVOCATION"
                    If CAPICOM_TRUST_NO_ISSUANCE_CHAIN_POLICY And chain.Status Then l_last_error_ecp = "CAPICOM_TRUST_NO_ISSUANCE_CHAIN_POLICY"
                    If CAPICOM_TRUST_IS_PARTIAL_CHAIN And chain.Status Then l_last_error_ecp = "CAPICOM_TRUST_IS_PARTIAL_CHAIN"
                    If CAPICOM_TRUST_CTL_IS_NOT_TIME_VALID And chain.Status Then l_last_error_ecp = "CAPICOM_TRUST_CTL_IS_NOT_TIME_VALID"
                    If CAPICOM_TRUST_CTL_IS_NOT_SIGNATURE_VALID And chain.Status Then l_last_error_ecp = "CAPICOM_TRUST_CTL_IS_NOT_SIGNATURE_VALID"
                    If CAPICOM_TRUST_CTL_IS_NOT_VALID_FOR_USAGE And chain.Status Then l_last_error_ecp = "CAPICOM_TRUST_CTL_IS_NOT_VALID_FOR_USAGE"
                    res = False
                    Return res
                    Exit Function
                End If
            Next
            Return res
        Catch ex As Exception
            pE("Ошибка verify_ecp " & ex.Message, 0)
            Return False
        End Try
    End Function
    '  возращает путь и имя без расширения исходного файла по id и дате создания пакета
    Public Function getfilenameinshort(ByVal pathin As String, ByVal id As String, ByVal packetdate As String) As String
        Try
            Dim dir_day As String
            Dim filename As String
            'dir_day = packetdate.Substring(0, 4) & "_" & packetdate.Substring(4, 2) & "\" & packetdate.Substring(6, 2)
            dir_day = packetdate.Substring(0, 4) & packetdate.Substring(4, 2) & packetdate.Substring(6, 2)
            'filename = pathin & "\" & dir_day & "\" & const_pref_packet & id
            filename = pathin & "\" & dir_day & "\" & const_pref_packet & id
            Return filename
        Catch ex As Exception
            pE("Ошибка getfilenameinshort " & ex.Message, 0)
            Return ""
        End Try
    End Function
    '
    Private Function getpathout(ByVal pathout As String, ByVal id As String, ByVal facialacccls As String, ByVal packetdate As String) As String
        Dim filename As String
        filename = l_pathout & "\" & facialacccls
        Return filename
    End Function
    '
    Private Function getfilenameoutshort(ByVal pathout As String, ByVal id As String, ByVal facialacccls As String, ByVal packetdate As String) As String
        Dim filename As String
        filename = l_pathout & "\" & facialacccls & "\" & const_pref_zip & packetdate & "_" & id
        Return filename
    End Function
    Private Function converts16(ByVal s As String) As Byte()
        Dim buf() As Byte
        ReDim buf((s.Length + 1) / 2 - 2)
        Dim index As Integer
        For index = 0 To buf.Length - 1
            buf(index) = Convert.ToByte(s.Chars(index * 2), 16) * 16
            buf(index) += Convert.ToByte(s.Chars(index * 2 + 1), 16)
        Next
        Return buf
    End Function
    ' архивация файлов перед отправкой
    Public Function arh() As Integer
        Try
            Dim index As Integer
            If Not IO.Directory.Exists(l_pathout & "\" & l_facialacc_cls) Then IO.Directory.CreateDirectory(l_pathout & "\" & l_facialacc_cls)
            Dim ws As New IO.FileStream(getfilenameoutshort(l_pathout, l_id, l_facialacc_cls, l_packetdate) & const_ex_zip, IO.FileMode.Create, IO.FileAccess.Write)
            Dim b() As Byte
            Dim ms As New System.IO.MemoryStream()
            Dim file = New ICSharpCode.SharpZipLib.Zip.ZipFile(ms)
            Dim s As String = ICSharpCode.SharpZipLib.Zip.ZipConstants.ConvertToString(l_file2_sign)
            file.BeginUpdate()
            If dt.Rows.Count = 0 Then
                Return ERR_ARH
                Exit Function
            End If
            For index = 0 To dt.Rows.Count - 1
                b = converts16(dt.Rows(index).Item("cvalue"))
                pE("Добавляем в архив " & dt.Rows(index).Item("cname") & "_" & index & dt.Rows(index).Item("ctype"), 5)
                file.Add(New MemoryStreamStaticDataSource(b), dt.Rows(index).Item("cname") & "_" & index & dt.Rows(index).Item("ctype"))
            Next
            file.CommitUpdate()
            ms.WriteTo(ws)
            ws.Flush()
            ws.Close()
            ws = Nothing
            b = Nothing
            Return 0
        Catch ex As Exception
            pE("Ошибка arh " & ex.Message, 0)
            Return ERR_ARH
        End Try
    End Function
    ' удаление файлов после добавления их в архив
    Public Sub deletearh()
        Try
            If IO.File.Exists(getfilenameoutshort(l_pathout, l_id, l_facialacc_cls, l_packetdate) & const_ex_zip) Then
                IO.File.Delete(getfilenameoutshort(l_pathout, l_id, l_facialacc_cls, l_packetdate) & const_ex_zip)
            End If
        Catch ex As Exception
            pE("Ошибка deletearh " & ex.Message, 0)
        End Try
    End Sub
    ' отправка почты
    Public Function send_mail(ByVal from_l As String, ByVal addr As String, ByVal host As String, ByVal port As String, ByVal postname As String, ByVal postpass As String) As Integer
        Dim subject As String
        Dim body As String
        Dim file As String
        Try
            If l_packetdate.Substring(6, 2) = "99" Then
                subject = "Отчет за " & l_packetdate.Substring(4, 2) & "-й месяц " & l_packetdate.Substring(0, 4) & " года для лс " & Format(Val(l_facialacc_cls), "000\.00\.000\.0")
            Else
                subject = "Документы за " & convert_date_from_krista(l_packetdate) & " для лс " & Format(Val(l_facialacc_cls), "000\.00\.000\.0")
            End If
            body = "Документы за " & convert_date_from_krista(l_packetdate) & " для лс " & Format(Val(l_facialacc_cls), "000\.00\.000\.0") & " формирование " & Now.ToString
            file = getfilenameoutshort(l_pathout, l_id, l_facialacc_cls, l_packetdate) & const_ex_zip
            pE("Попытка отправки почты от " & from_l & " адрес " & addr, 5)
            If smtpm.sendmail(from_l, addr, subject, body, host, port, postname, postpass, file) <> 0 Then
                Err.Raise(84, Nothing, "Ошибка отправки почты")
            End If
            Return 0
        Catch ex As Exception
            pE("Ошибка send_mail " & ex.Message, 0)
            Return ERR_EMAIL
        End Try
    End Function
    ' декомпрессия
    Private Function uncsmall(ByRef src() As Byte, ByVal ofs As Long, ByRef dst() As Byte, ByVal len As Long)
        Try
            ReDim dst(len - 1)
            Array.Copy(src, ofs, dst, 0, len)
            uncompress(dst)
            Return True
        Catch myException As Exception
            Return False
        End Try
    End Function

    Sub New(ByVal pathin As String, ByVal pathout As String, ByVal id As String, ByVal packetdate As String, ByVal facialacc_cls As String, ByVal reportdate As String, ByRef log_l As log)
        Try
            logg = log_l
            dt = New DataTable("info")
            dt.Columns.Add("ctype", GetType(String))
            dt.Columns.Add("cname", GetType(String))
            dt.Columns.Add("cvalue", GetType(String))
            l_id = id
            l_packetdate = packetdate
            l_facialacc_cls = facialacc_cls
            l_pathin = pathin
            l_pathout = pathout
            l_filename = getfilenameinshort(pathin, id, packetdate) & const_ex_main
            pE("Параметры пакета" & " pathin:" & l_pathin & " pathout:" & l_pathout & " id:" & l_id & " packetdate:" & l_packetdate & " facialacc_cls:" & l_facialacc_cls & " filename:" & l_filename, 5)
            Dim rs As New System.IO.FileStream(l_filename, IO.FileMode.Open)
            ReDim l_file(rs.Length - 1)
            rs.Read(l_file, 0, rs.Length)
            rs.Dispose()
            rs.Close()
            pE("Первая декомпрессия общая", 5)
            uncsmall(l_file, UNCOMPRESSION_OFS1, l_file1, l_file.Length - UNCOMPRESSION_OFS1)
            Dim l_len_data As Long = getint(l_file1, const_level2_offset_len_data)
            Dim l_ofs_ecp As Long = l_len_data + const_level2_offset_data + const_level2_inc
            Dim l_len_ecp As Long = l_file1.Length - l_ofs_ecp - 1
            pE("Вторая декомпрессия данных", 5)
            uncsmall(l_file1, const_level2_offset_data, l_file2_data, l_len_data)
            pE("Вторая декомпрессия подписи", 5)
            uncsmall(l_file1, l_ofs_ecp, l_file2_sign, l_len_ecp)
            pE("Берем сертификат из подписи", 5)
            l_cert = New X509Certificate2
            l_cert.Import(l_file2_sign, "", X509KeyStorageFlags.DefaultKeySet)
            pE("Запускаем анализ XML", 5)
            uncxml(l_file2_data, dt)
        Catch ex As Exception
            pE("Ошибка инициализации объекта dse2 " & ex.Message, 0)
        End Try
    End Sub
    Function pE(ByVal str As String, ByVal loglevel As Integer)
        On Error Resume Next
        If Not logg Is Nothing Then logg.print(str, loglevel)
        Return 0
    End Function
    Protected Overrides Sub Finalize()
        dt = Nothing
        l_file = Nothing
        l_file1 = Nothing
        l_file2_data = Nothing
        l_file2_sign = Nothing
        l_cert = Nothing
        MyBase.Finalize()
    End Sub
    'ReDim l_file1(l_file.Length - UNCOMPRESSION_OFS1 - 1)
    'Array.Copy(l_file, UNCOMPRESSION_OFS1, l_file1, 0, l_file.Length - UNCOMPRESSION_OFS1)
    'uncompress(l_file1)
    'ReDim l_file2_data(l_len_data - 1)
    'Array.Copy(l_file1, const_level2_offset_data, l_file2_data, 0, l_len_data)
    'uncompress(l_file2_data)
    'ReDim l_file2_sign(l_len_ecp - 1)
    'Array.Copy(l_file1, l_ofs_ecp, l_file2_sign, 0, l_len_ecp)
    'uncompress(l_file2_sign)
End Class
У вас нет необходимых прав для просмотра вложений в этом сообщении.

Cronenberg
кандидат 1го уровня
кандидат 1го уровня
Сообщения: 2
Зарегистрирован: 23.11.2011 11:44

Re: Экспорт пакетов УРМ

Сообщение Cronenberg » 01.12.2011 09:12

Уважаемый, Val. Пишет Вам программист централизованной бухгалтерии города Армавира. Приходится работать в УРМе, получаем большое количество пакетов ЭЦП. По описанию программы, ваш вариант очень даже симпатичный. Но в сообщении не нашлось вложения с исполняемым файлом :oops: . Давайте будем делать добрые дела?
ICQ: 341427280

Cronenberg
кандидат 1го уровня
кандидат 1го уровня
Сообщения: 2
Зарегистрирован: 23.11.2011 11:44

Re: Экспорт пакетов УРМ

Сообщение Cronenberg » 09.12.2011 14:13

Уважаемый Val, ну поделитесь своей программой для служебных нужд?


Вернуться в «УРМ»

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и 2 гостя

cron