FreeBasic
Главная
Вход
Регистрация
Среда, 07.12.2022, 20:46Приветствую Вас Гость | RSS
[ Новые сообщения · Участники · Правила форума · Поиск · RSS ]
  • Страница 1 из 1
  • 1
Форум » Freebasic » Исходники » Неудачный архиватор (Неудачный архиватор)
Неудачный архиватор
haavДата: Четверг, 12.07.2012, 11:01 | Сообщение # 1
Генералиссимус
Группа: Администраторы
Сообщений: 1300
Репутация: 47
Статус: Offline
Неудачный архиватор


Когда я хотел сделать для библиотеки Window9 пакер, сначала пробовал функции из библиотеки NTDLL. Но как показали тесты, данные функции сжимают неплохо только файлы с большим кол-вом повторяющихся байтов. Их алгоритм целиком расчитан на это.

Так что потестировав, стало ясно что надо искать что-то другое, и конечно я нашел (ZLIB) , но написанные функции на основе NTDLL функций остались в моих "закромах" кода. Может кому будет интересно. Писал давно, возможны ошибки (исправлять уже ничего не буду, просто не надо)

Code

#Include once "window9.bi"
#Inclib "ntdll"

declare function RtlGetCompressionWorkSpaceSize alias "RtlGetCompressionWorkSpaceSize"( _
byval dwCompressionFormatAndEngine as DWORD,_
byval lpdwCompressBufferWorkSpaceSize as DWORD ptr, _
byval lpdwCompressFragmentWorkSpaceSize as DWORD ptr ) _
as Integer

declare function RtlCompressBuffer alias "RtlCompressBuffer"( _
byval dwCompressionFormatAndEngine as DWORD, _
byval lpUnCompressedBuffer as LPCVOID, _
byval dwUnCompressedBufferSize As DWORD, _
byval lpCompressedBuffer as LPCVOID, _
byval dwCompressedBufferSize As DWORD, _
byval dwUnCompressedChunkSize As DWORD, _
byval lpdwFinalCompressedSize as DWORD ptr, _
byval lpCompressBufferWorkspace as LPCVOID ) _
as Integer

Declare Function RtlDecompressBuffer alias "RtlDecompressBuffer"( _
byval dwCompressionFormat as DWORD, _
byval lpUnCompressedBuffer as LPCVOID, _
byval dwUnCompressedBufferSize As DWORD, _
byval lpCompressedBuffer as LPCVOID, _
byval dwCompressedBufferSize As DWORD, _
byval lpdwFinalDecompressedSize as DWORD ptr ) _
as integer

'*******************************************************************************************
Function CompressRtl(Byref BUF_DEST As Byte Ptr,byval SOURSEDATA As Byte ptr,Byval SIZEDATA As UInteger, byval typecompress As Integer=COMPRESSION_FORMAT_LZNT1 or COMPRESSION_ENGINE_STANDARD) As Integer
  Dim as UINT workSpaceSize,junk,finalSize
  Dim As Byte Ptr endbuf
  Dim lpWorkSpace as PVOID
  BUF_DEST=ReAllocate(BUF_DEST,SIZEDATA*2)  
  RtlGetCompressionWorkSpaceSize(typecompress,@workSpaceSize,@junk)
  lpWorkSpace = HeapAlloc(GetProcessHeap(),HEAP_NO_SERIALIZE    ,workSpaceSize)  
  RtlCompressBuffer(typecompress,soursedata,sizedata,_
  BUF_DEST,2 * sizedata ,0,@finalSize,lpWorkSpace )
  BUF_DEST=ReAllocate(BUF_DEST,finalSize+4)
  RtlCopyMemory(BUF_DEST+finalSize,@SIZEDATA,4)
  Function= finalSize
  HeapFree( GetProcessHeap( ), 0, lpWorkSpace )
End Function
'*******************************************************************************************
Function DeCompressRtl(Byref BUF_COMPRESSED As Byte Ptr,byval SIZECOMPRESSED As integer,ByRef BUFDESTDATA As Byte Ptr) As Integer
  Dim as UINT finalSize,sizedecompressAddress,sizedecompress
  Dim lpWorkSpace as PVOID
  sizedecompressAddress=Cast(UINT,BUF_COMPRESSED+SIZECOMPRESSED)
  sizedecompress=Peek(Integer,sizedecompressAddress)
  BUFDESTDATA=ReAllocate(BUFDESTDATA,sizedecompress)
  RtlDecompressBuffer(COMPRESSION_FORMAT_LZNT1,BUFDESTDATA,sizedecompress*2,_
  BUF_COMPRESSED,SIZECOMPRESSED,@finalSize )
  BUFDESTDATA=ReAllocate(BUFDESTDATA,finalSize)
  Function= finalSize
End Function

'*******************************************************************************************
Function CompressFileRtl(ByVal filename As String, ByVal filenameDest As String) As Integer
  Dim As HANDLE handle,handle1
  Dim As Uinteger numcikl,ostatok,sizesourse,endsize,fullend,SizeReadWrite
  Dim As Byte Ptr bufsourse,bufdest
  handle=Read_File(FileName)
  If handle<>-1 Then
   sizesourse=Size_File(handle)
   ? sizesourse
   If sizesourse>10000000 Then
    numcikl=sizesourse\10000000
    ostatok= sizesourse Mod 10000000
    Dim As Integer massvalue(numcikl)
    handle1=Create_File(filenameDest)
    If handle1<>-1 Then
     bufdest=Allocate(10000000)
     bufsourse=Allocate(10000000)
     For a As Integer =1 To numcikl
      ReadFile(Handle,bufsourse,10000000,Cast(LPDWORD,@SizeReadWrite),0)
      endsize=CompressRtl(bufdest,bufsourse,10000000)
      fullend=fullend+endsize+4
      massvalue(a)=endsize
      Write_Data(handle1,Cast(Integer,bufdest),endsize+4)
     Next

     If ostatok>0 Then
      ReadFile(Handle,bufsourse,ostatok,Cast(LPDWORD,@SizeReadWrite),0)
      endsize=CompressRtl(bufdest,bufsourse,ostatok)
      fullend=fullend+endsize+4
      Write_Data(handle1,Cast(Integer,bufdest),endsize+4)
     Else
      endsize=0
     EndIf
     For a As Integer =1 To numcikl
      Write_Integer(handle1,massvalue(a))
     Next
     Write_Integer(handle1,endsize)
     Write_Integer(handle1,numcikl)
     Close_File(handle1)
     Function=fullend+numcikl*4+8
    endif
   Else
    bufsourse=Allocate(sizesourse)
    ReadFile(Handle,bufsourse,sizesourse,Cast(LPDWORD,@SizeReadWrite),0)
    bufdest=Allocate(sizesourse)
    endsize=CompressRtl(bufdest,bufsourse,sizesourse)
    handle1=Create_File(filenameDest)
    If handle1<>-1 Then
     Write_Data(handle1,Cast(Integer,bufdest),endsize+4)
     Write_Integer(handle1,0)
     Close_File(handle1)
     Function=endsize+8
    EndIf
   EndIf
   Close_file(handle)
  EndIf
  DeAllocate(bufsourse)
  DeAllocate(bufdest)
End Function
'*******************************************************************************************
Function DeCompressFileRtl(ByVal filename As String, ByVal filenameDest As String) As Integer
  Dim As HANDLE handle,handle1
  Dim As integer numcikl,ostatok,sizesourse,endsize,fullend,SizeReadWrite
  Dim As Byte Ptr bufsourse,bufdest
  handle=Read_File(FileName)
  If handle<>-1 Then
   Set_File_Pointer(handle,-8,FILE_END)
   ostatok=Read_Integer(handle)
   numcikl=Read_Integer(handle)
   If numcikl<>0 Then
    handle1=Create_File(filenameDest)
    If handle1<>-1 Then
     Dim As UInteger massvalue(numcikl+1)
     Set_File_Pointer(handle,-(numcikl*4+8),FILE_END)
     For a As Integer=1 To numcikl
      massvalue(a)=Read_Integer(handle)
     Next
     If ostatok<>0 Then
      massvalue(numcikl+1)=ostatok
      massvalue(0)=numcikl+1
     Else
      massvalue(0)=numcikl
     EndIf
     Set_File_Pointer(handle,0,FILE_Begin)
     bufsourse=Allocate(15000000)
     bufdest=Allocate(10000000)
     For a As Integer=1 To massvalue(0)
      ReadFile(Handle,bufsourse,massvalue(a)+4,Cast(LPDWORD,@SizeReadWrite),0)
      endsize=DeCompressRtl(bufsourse,massvalue(a),bufdest)
      Write_Data(handle1,Cast(Integer,bufdest),endsize)
      fullend+=endsize
     Next
     Close_File(handle1)
    EndIf
   Else
    handle1=Create_File(filenameDest)
    If handle1<>-1 Then
     sizesourse=Size_File(handle)-8
     Set_File_Pointer(handle,0,FILE_BEGIN)
     bufsourse=Allocate(sizesourse+4)
     ReadFile(Handle,bufsourse,sizesourse+4,Cast(LPDWORD,@SizeReadWrite),0)
     bufdest=Allocate(sizesourse+4)
     endsize=DeCompressRtl(bufsourse,sizesourse,bufdest)
     Write_Data(handle1,Cast(Integer,bufdest),endsize)
     Close_File(handle1)
     fullend=endsize
    EndIf
   EndIf
   Close_File(handle)
  EndIf
  DeAllocate(bufdest)
  DeAllocate(bufsourse)
  Return fullend
End Function
'*******************************************************************************************

?  CompressFileRtl("55.txt","55.zip")
? DeCompressFileRtl("55.zip","55_1.txt")
Print  "Press any key to exit..."
Sleep
end


Вы сохраняете власть над людьми покуда оставляете им что-то…Отберите у человека все, и этот человек уже будет неподвластен вам…
 
Форум » Freebasic » Исходники » Неудачный архиватор (Неудачный архиватор)
  • Страница 1 из 1
  • 1
Поиск: