Экспорт пакетов УРМ
Добавлено: 30.06.2011 11:19
В организациях, которые получают в УРМ большое количество пакетов с ЭЦП (эл. выписок), возникает ситуация, в которой ответственный работник вынужден заходить в каждый пакет УРМ и сохранять каждое вложение. Это достаточно трудоемко.
Возможно в новых версиях что-то изменилось.
Сделал программу, которая работает независимо от УРМ, обращается напрямую к базе УРМ для получения пакетов, разбирает пакеты, экспортирует содержимое пакетов в виде cll и xls файлов, умеет отправлять их по электронной почте (нужен справочник связок лс -> эл. адрес) и проверять корректность ЭЦП.
Главное окно:
Окно настроек:
Контекстное меню:
В результате экспорта (по указанному в настройках пути) создается подкаталог с именем-номером лс, в него попадают 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 файла
Возможно в новых версиях что-то изменилось.
Сделал программу, которая работает независимо от УРМ, обращается напрямую к базе УРМ для получения пакетов, разбирает пакеты, экспортирует содержимое пакетов в виде cll и xls файлов, умеет отправлять их по электронной почте (нужен справочник связок лс -> эл. адрес) и проверять корректность ЭЦП.
Главное окно:
Окно настроек:
Контекстное меню:
В результате экспорта (по указанному в настройках пути) создается подкаталог с именем-номером лс, в него попадают 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
. Давайте будем делать добрые дела?