RTF в *ML

[GB826]

Привет

На самом деле нужны совет и функция (готовая желательно)

Проблема в размере rtf текста

Компилю файл проекта(не в VB, а в своей программе) в xml, необходимо cжать rtf и запихать в этот же XML-файл c сохранением форматирования, потом, скорее всего, при его(xml) "проигрывании" для отображения текста (бывшего rtf) буду использовать WebBrowser

[alibek]

У RTF и HTML разные принципы форматирования, точно преобразовать не получится. И готовых функций, насколько помню, тоже нет.

[GB826]

Млин, есть еще идея просто сжать текст, пихнуть в XML, а из XML его извлечь потом и разжать (XML, вроде, бинарные данные умеет хранить). Тогда просто функции не помешали бы :о|, типа

arh(string) as string
extract(string) as string

ЗЫ Слазил бы в поиск, но форум тяжелый, а инета 2 метра осталось :о(

[kif]

алгоритм хаффмана, zlib, rar

[Antonariy]

rar

И где же? Что-то я не видел библиотек для компрессии.

GB826
Идешь на последнюю страницу темы "Методы зашиты VB программы от копирования.", там я давал ссылку на сборник алгоритмов компрессии.
Свою стринговую переменную преобразуешь в байтовый массив, сжимаешь, получившийся массив конвертируешь в hex. Эту строку и пишешь в xml.

[Antonariy]

Мой способ преобразования в хекс

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

Const rsShema = "<xml xmlns:s='uuid:BDC6E3F0-6DA3-11d1-A2A3-00AA00C14882' xmlns:dt='uuid:C2F41010-65B3-11d1-A29F-00AA00C14882' xmlns:rs='urn:schemas-microsoft-com:rowset' xmlns:z='#RowsetSchema'>" & _
                "<s:Schema id='RowsetSchema'>" & _
                "<s:ElementType name='row' content='eltOnly' rs:updatable='true'>" & _
                "<s:AttributeType name='Image' rs:number='41' rs:nullable='true' rs:maydefer='true' rs:writeunknown='true'>" & _
                "<s:datatype dt:type='bin.hex' dt:maxLength='2147483647' rs:long='true' />" & _
                "</s:AttributeType><s:extends type='rs:rowbase' />" & _
                "</s:ElementType></s:Schema><rs:data>" & _
                "<z:row Image='' /></rs:data></xml>"

Private Function Bin2Hex(BinDT) As String
Dim rs As New ADODB.Recordset
Dim nd As New MSXML.DOMDocument
Dim bdt() As Byte
    On Error GoTo errh
    nd.loadXML rsShema
    rs.Open nd
    bdt = BinDT
    rs.Fields(0).AppendChunk bdt
    rs.Save nd, adPersistXML
    Bin2Hex = nd.childNodes(0).childNodes(1).childNodes(0).childNodes(1).Attributes(0).Text
errh:
End Function

Private Function Hex2Bin(HexDt As String)
Dim rs As New ADODB.Recordset
Dim nd As New MSXML.DOMDocument
    If Len(HexDt) = 0 Then Exit Function
    On Error GoTo errh
    nd.loadXML rsShema
    nd.childNodes(0).childNodes(1).childNodes(0).Attributes(0).Text = HexDt
    rs.Open nd
    Hex2Bin = rs(0).GetChunk(rs(0).ActualSize)
errh:
End Function