Visual Basic, .NET, ASP, VBScript
Новости | Примеры | Библиотека кодов | НеЧаВо | VBA | Справочник по VB | Справочник по WinAPI | ActiveX контролы | Статьи по VB | Мастерская разработчика | Форум VBNet | Яndex bar! | Голосование | Полезные программы | Магазин VBNet | Рассылка | Конкурсы | Юмор | Чат | Реклама на VBNet | Автора! | Ссылки | Бета-тестирование | Послать пример на сайт
 

   
   
     

Форум - Общий форум

Страница: 1 | 2 |

 

  Вопрос: ПоБИТовая работа с файлами Добавлено: 11.06.06 08:53  

Автор вопроса:  ZagZag | ICQ: 295002202 

Ответить

  Ответы Всего ответов: 18  

Номер ответа: 16
Автор ответа:
 ZagZag



ICQ: 295002202 

Вопросов: 87
Ответов: 1684
  Профиль | | #16 Добавлено: 14.06.06 16:29
Получилось!
Вот код архиватора. Только он нихрена не сжимает :) Но работает как надо.
Попробую другой алгоритм

#COMPILE EXE

Function UnQuote$(strString$) As String
REPLACE $DQ With $NUL IN strString$
Function = strString$
End Function

Sub SetBit(lngFileNumber As Long, lngBitOffset As Long, bitValue As Byte)
Dim lngByteOffset As Long
Dim byteData As Byte
lngByteOffset = (lngBitOffset-(lngBitOffset MOD 8))/8
Get #lngFileNumber, lngByteOffset, byteData
If bitValue=0 Then
BIT Reset byteData, 7 - (lngBitOffset MOD 8)
Else
BIT Set byteData, 7 - (lngBitOffset MOD 8)
End If
Put #lngFileNumber, lngByteOffset, byteData
End Sub

Function CompressFile(strFileName As String, strFileNameToArch As String) As Long
Dim lngSrcFile As Long
Dim lngDestFile As Long
Dim lngIndex As Long
Dim lngCount As Long
Dim lngWritedBitsCount As Long
Dim bytSymbol As Byte
Dim bytCurrentSymbol As Byte
Dim Symbols(0 TO 256) As Long
Dim Indexes(0 TO 256) As Byte
Dim bPutNull As Long
Dim bitData As Byte
Dim lngSrcFileLen As Long
lngSrcFile = FreeFile
lngDestFile = FreeFile

If Len(strFileNameToArch$)=0 Then strFileNameToArch$ = strFileName$ & ".tarch"
Open strFileName For BINARY ACCESS Read As #lngSrcFile
FILESCAN #lngSrcFile, RECORDS TO lngSrcFileLen&
Dim arData(0 TO lngSrcFileLen&;) As Byte
Open strFileNameToArch$ For BINARY ACCESS Read Write As #lngDestFile
'Build symbols table
Seek #lngSrcFile,1
Do UNTIL EOF(lngSrcFile)
Get #lngSrcFile,,bytSymbol
Symbols(bytSymbol) = Symbols(bytSymbol) + 1
Indexes(bytSymbol) = bytSymbol
LOOP

'Sort symbols table
Array SORT Symbols(), TAGARRAY Indexes(), DESCEND

'            Write SymbolTable in arch file
Put #lngDestFile,,Indexes()
lngWritedBitsCount = 2048 ' Из-за записи заголовка, смещение данных равно 2048бит (256байт)

'Build body
Seek #lngSrcFile,1
Do UNTIL EOF(lngSrcFile)
Get #lngSrcFile,,bytSymbol
! XOR eax, eax
! MOV lngCount, eax
Do UNTIL Indexes(lngCount) = bytSymbol
! Add lngCount, 1
LOOP
! Add lngCount, 1

bitData = Not bitData

For lngIndex = 1 TO lngCount
SetBit(lngDestFile, lngWritedBitsCount, bitData)
lngWritedBitsCount = lngWritedBitsCount + 1
Next
LOOP
Close #lngDestFile
Close #lngSrcFile
MsgBox "OK"
End Function

Function PBMAIN
Dim strFileName As String
strFileName$ = UnQuote$(Command$)

If Trim$(strFileName$) = "" Then
Exit Function
ELSEIF InStr(strFileName$, "/D";) Then
' Decompress
REPLACE " /D" With $NUL IN strFileName$
'UncompressFile(strFileName$)
Else
' Compress
CompressFile(strFileName$,"";)
End If
End Function

Ответить

Номер ответа: 17
Автор ответа:
 ZagZag



ICQ: 295002202 

Вопросов: 87
Ответов: 1684
  Профиль | | #17 Добавлено: 14.06.06 16:30
Всем спасибо.
Незнаю закрывать ли тему, т.к. мой алгоритм очень медленный.
Может чего предложите побыстрее?

Ответить

Номер ответа: 18
Автор ответа:
 Victor



ICQ: 345743490 

Вопросов: 42
Ответов: 385
  Web-сайт: vt-dbnz.narod.ru
 Профиль | | #18 		Добавлено: 14.06.06 17:44
Что тут предложить? Алгоритм хаффмана в сочетании с чем-нибудь примитивным. Уж про хаффмана написано много чего (правда мне понять его полностью так и не удалось).

Ответить

Страница: 1 | 2 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам