Форум на Исходниках.RU

Кому надо DGM ?

HackerVlad — Thu, 21 Nov 2024 17:25:48 +0000

HackerVlad: Вы просили код для упаковки CAB из Cabinet.dll (на VB6). Вот пожалуйста:

Option Explicit

'////////////////////////////////////////////

'// Модуль упаковки CAB-архивов //

'// Copyright (c) 21.11.2024 by HackerVlad //

'// e-mail: vladislavpeshkov@yandex.ru //

'// Версия 1.2 //

'////////////////////////////////////////////

' Декларации API ...

Private Declare Function FCICreate CDecl Lib "cabinet.dll" (perf As TERF, ByVal fnFilePlaced As Long, ByVal fnAlloc As Long, ByVal fnFree As Long, ByVal fnOpen As Long, ByVal fnRead As Long, ByVal fnWrite As Long, ByVal fnClose As Long, ByVal fnSeek As Long, ByVal fnDelete As Long, ByVal fnFciGTF As Long, ByVal ccab As Long, Optional ByVal pv As Long) As Long

Private Declare Function FCIAddFile CDecl Lib "cabinet.dll" (ByVal hfci As Long, ByVal pszSourceFile As Long, ByVal pszFileName As Long, ByVal fExecute As BOOL, ByVal pfnGetNextCabinet As Long, ByVal pfnProgress As Long, ByVal pfnOpenInfo As Long, ByVal typeCompress As Long) As Long

Private Declare Function FCIFlushCabinet CDecl Lib "cabinet.dll" (ByVal hfci As Long, ByVal fGetNextCab As BOOL, ByVal pfnfcignc As Long, ByVal pfnfcis As Long) As BOOL

Private Declare Function FCIDestroy CDecl Lib "cabinet.dll" (ByVal hfci As Long) As BOOL

Private Declare Function SHCreateMemStream Lib "shlwapi.dll" Alias "#12" (ByVal pInit As Long, ByVal cbInit As Long) As Long

Private Declare Function PathStripPathW Lib "shlwapi.dll" (ByVal pszPath As Long) As Long

Private Declare Function PathRemoveFileSpecW Lib "shlwapi.dll" (ByVal pszPath As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)

Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long

Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long

Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As Long) As Long

Private Declare Function GetFileTime Lib "kernel32" (ByVal hFile As Long, lpCreationTime As FILETIME, lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME) As Long

Private Declare Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long

Private Declare Function FileTimeToDosDateTime Lib "kernel32" (lpFileTime As FILETIME, lpFatDate As Integer, lpFatTime As Integer) As Long

Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long

Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, ByVal lpBuffer As Long, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Any) As BOOL

Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, ByVal lpBuffer As Long, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Any) As BOOL

Private Declare Function OpenFile Lib "kernel32" (ByVal lpFileName As Long, lpReOpenBuff As OFSTRUCT, ByVal wStyle As Long) As Long

Private Declare Function CreateFileA Lib "kernel32" (ByVal lpFileName As Long, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long

Private Declare Function CreateFileW Lib "kernel32" (ByVal lpFileName As Long, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long

Private Declare Function GetMem4 Lib "msvbvm60" (ByVal Addr As Long, ByRef dstValue As Long) As Long

' Константы ...

Private Const CB_MAX_DISK_NAME = 256

Private Const CB_MAX_CABINET_NAME = 256

Private Const CB_MAX_CAB_PATH = 256

Private Const OFS_MAXPATHNAME = 128

Private Const GENERIC_READ As Long = &H80000000

Private Const GENERIC_WRITE As Long = &H40000000

Private Const FILE_SHARE_READ = &H1

Private Const OPEN_EXISTING As Long = 3

Private Const FILE_ATTRIBUTE_ARCHIVE = &H20

Private Const FILE_ATTRIBUTE_NORMAL = &H80

Private Const INVALID_HANDLE_VALUE As Long = -1

Private Const CREATE_ALWAYS = 2

Private Const MAX_PATH As Long = 260

Private Const tcompTYPE_MSZIP = &H1&

Private Const tcompTYPE_LZX = &H3& ' 0x0003

Private Const tcompLZX_WINDOW_LO = &HF00& ' 0x0F00

Private Const tcompLZX_WINDOW_HI = &H1500& ' 0x1500

' Типы ...

Private Type TCCAB

cb As Long ' size available for cabinet on this media

cbFolderThresh As Long ' Thresshold for forcing a new Folder

cbReserveCFHeader As Long ' Space to reserve in CFHEADER

cbReserveCFFolder As Long ' Space to reserve in CFFOLDER

cbReserveCFData As Long ' Space to reserve in CFDATA

iCab As Long ' sequential numbers for cabinets

iDisk As Long ' Disk number

fFailOnIncompressible As Long ' TRUE => Fail if a block is incompressible

setID As Integer ' Cabinet set ID

szDisk(0 To (CB_MAX_DISK_NAME - 1)) As Byte ' current disk name

szCab(0 To (CB_MAX_CABINET_NAME - 1)) As Byte ' current cabinet name

szCabPath(0 To (CB_MAX_CAB_PATH - 1)) As Byte ' path for creating cabinet

End Type

Private Type TERF

erfOper As Long

erfType As Long

fError As Byte

End Type

Private Type OFSTRUCT

cBytes As Byte

fFixedDisk As Byte

nErrCode As Integer

Reserved1 As Integer

Reserved2 As Integer

szPathName(0 To (OFS_MAXPATHNAME - 1)) As Byte

End Type

Private Type FILETIME

dwLowDateTime As Long

dwHighDateTime As Long

End Type

' Переменные для временного хранения данных ...

Dim fh As Long

Dim fh_cab As Long

Dim cabFileName As String

' Енумы ...

Private Enum BOOL

cFalse

cTrue

End Enum

Private Enum Stream_Seek

STREAM_SEEK_SET

STREAM_SEEK_CUR

STREAM_SEEK_END

End Enum

Public Enum cabCompressionMethod

cm_MSZIP = tcompTYPE_MSZIP

cm_LZX15 = tcompTYPE_LZX Or tcompLZX_WINDOW_LO

cm_LZX16 = &H1003&

cm_LZX17 = &H1103&

cm_LZX18 = &H1203&

cm_LZX19 = &H1303&

cm_LZX20 = &H1403&

cm_LZX21 = tcompTYPE_LZX Or tcompLZX_WINDOW_HI

End Enum

' Для совместимости с TwinBasic и VBA7

#If (VBA7 <> 0) Or (TWINBASIC <> 0) Then

Private Declare PtrSafe Function DispCallFunc Lib "oleaut32" (ByVal pvInstance As LongPtr, ByVal oVft As LongPtr, ByVal lCc As Long, ByVal vtReturn As VbVarType, ByVal cActuals As Long, prgVt As Any, prgpVarg As Any, pvargResult As Variant) As Long

#Else

Private Declare Function DispCallFunc Lib "oleaut32" (ByVal pvInstance As LongPtr, ByVal oVft As LongPtr, ByVal lCc As Long, ByVal vtReturn As VbVarType, ByVal cActuals As Long, prgVt As Any, prgpVarg As Any, pvargResult As Variant) As Long

Private Enum LongPtr

[_]

End Enum

#End If

Private Function DispCallByVtbl(ByVal pUnk As LongPtr, ByVal lIndex As Long, ParamArray A() As Variant) As Variant

Const CC_STDCALL As Long = 4

#If Win64 Then

Const PTR_SIZE As Long = 8

#Else

Const PTR_SIZE As Long = 4

#End If

Dim lIdx As Long

Dim vParam() As Variant

Dim vType(0 To 63) As Integer

Dim vPtr(0 To 63) As LongPtr

Dim hResult As Long

vParam = A

For lIdx = 0 To UBound(vParam)

vType(lIdx) = VarType(vParam(lIdx))

vPtr(lIdx) = VarPtr(vParam(lIdx))

hResult = DispCallFunc(pUnk, lIndex * PTR_SIZE, CC_STDCALL, vbLong, lIdx, vType(0), vPtr(0), DispCallByVtbl)

If hResult < 0 Then

Err.Raise hResult, "DispCallFunc"

End If

End Function

Private Function IStream_Read(ByVal ptrIStream As Long, ByVal pv As Long, ByVal BytesRead As Long) As Long

Dim BytesReaded As Long

DispCallByVtbl ptrIStream, 3, pv, BytesRead, VarPtr(BytesReaded)

IStream_Read = BytesReaded

End Function

Private Function IStream_Write(ByVal ptrIStream As Long, ByVal pv As Long, ByVal BytesWrite As Long) As Long

Dim BytesWritten As Long

DispCallByVtbl ptrIStream, 4, pv, BytesWrite, VarPtr(BytesWritten)

IStream_Write = BytesWritten

End Function

Private Function IStream_Seek(ByVal ptrIStream As Long, ByVal Offset As Currency, ByVal Origin As Stream_Seek) As Long

Dim NewPosition As Currency

DispCallByVtbl ptrIStream, 5, Offset, Origin, VarPtr(NewPosition)

IStream_Seek = NewPosition * 10000@

End Function

Private Sub IStream_Release(ByVal ptrIStream As Long)

DispCallByVtbl ptrIStream, 2

End Sub

' +++ FCICreate CallBack's +++

' 1. Выделение памяти

' Описание макроса: https://learn.microsoft.com/en-us/windows/win32/api/fdi/nf-fdi-fnalloc

' Delphi: function fnAlloc(Size: ULONG): Pointer; cdecl;

Private Function fnAlloc CDecl(ByVal lngSize As Long) As Long

fnAlloc = GlobalAlloc(0, lngSize)

End Function

' 2. Создание временного файла (потока)

' Delphi: function fnFciGTF(pszTempName: PAnsiChar; cbTempName: Integer; pv: Pointer): BOOL; cdecl;

Private Function fnFciGTF CDecl(ByRef pszTempName As Long, ByVal cbTempName As Long, ByVal pv As Long) As BOOL

' Специальный хак:

' Обманываем операционную систему, которая будет "думать", что работает с TMP-файлами на диске

' Вместо временного файла на диске, мы будем создавать поток IStream в оперативной памяти своего процесса

Dim hStream As Long

hStream = SHCreateMemStream(0, 0) ' Создать новый поток IStream для временного файла

pszTempName = hStream ' Здесь мы будем использовать хак: засовываем в переменную String значение Long

fnFciGTF = 1

End Function

' 3. Открытие файла (потока)

' Описание макроса: https://learn.microsoft.com/en-us/windows/win32/api/fdi/nf-fdi-fnopen

' Delphi: function fnOpen(pszFile: PAnsiChar; oflag: Integer; pmode: Integer; err: PInteger; pv: Pointer): Integer; cdecl;

Private Function fnOpen CDecl(ByRef pszFile As Long, ByVal oFlag As Long, ByVal pMode As Long, ByRef ErrNo As Long, ByVal pv As Long) As Long

If oFlag <> &H8302& Then ' Хак

fnOpen = pszFile

Else

fh_cab = CreateFileW(StrPtr(cabFileName), GENERIC_WRITE, FILE_SHARE_READ, ByVal 0&, CREATE_ALWAYS, FILE_ATTRIBUTE_ARCHIVE, 0)

If fh_cab <> INVALID_HANDLE_VALUE Then

ErrNo = Err.LastDllError

fnOpen = fh_cab

Else

ErrNo = Err.LastDllError

fnOpen = -1

End If

End Function

' 4. Чтение данных

' Описание макроса: https://learn.microsoft.com/en-us/windows/win32/api/fdi/nf-fdi-fnread

' Delphi: function fnRead(hf: Integer; memory: Pointer; cb: UINT; err: PInteger; pv: Pointer): UINT; cdecl;

Private Function fnRead CDecl(ByVal hf As Long, ByVal hMemory As Long, ByVal cbSize As Long, ByRef ErrNo As Long, ByVal pv As Long) As Long

Dim dwBytesRead As Long

If hf = fh Then ' Если открывается на чтение файл, который добавляется в архив

If ReadFile(fh, hMemory, cbSize, dwBytesRead, ByVal 0&) = cFalse Then

ErrNo = Err.LastDllError

fnRead = -1

Exit Function

End If

Else ' Если открывается на чтение временный поток IStream

dwBytesRead = IStream_Read(hf, hMemory, cbSize)

End If

fnRead = dwBytesRead

End Function

' 5. Запись данных

' Описание макроса: https://learn.microsoft.com/en-us/windows/win32/api/fdi/nf-fdi-fnwrite

' Delphi: function fnWrite(hf: Integer; memory: Pointer; cb: UINT; err: PInteger; pv: Pointer): UINT; cdecl;

Private Function fnWrite CDecl(ByVal hf As Long, ByVal hMemory As Long, ByVal cbSize As Long, ByRef ErrNo As Long, ByVal pv As Long) As Long

Dim dwBytesWritten As Long

If hf = fh_cab Then ' Если открывается на запись файл архива

If WriteFile(fh_cab, hMemory, cbSize, dwBytesWritten, ByVal 0&) = cFalse Then

ErrNo = Err.LastDllError

fnWrite = -1

Exit Function

End If

Else ' Если открывается на запись временный поток IStream

dwBytesWritten = IStream_Write(hf, hMemory, cbSize)

End If

fnWrite = dwBytesWritten

End Function

' 6. Освобождение памяти

' Описание макроса: https://learn.microsoft.com/en-us/windows/win32/api/fdi/nf-fdi-fnfree

' Delphi: procedure fnFree(memory: Pointer); cdecl;

Private Sub fnFree CDecl(ByVal lngMemory As Long)

GlobalFree lngMemory

End Sub

' 7. Позиционирование указателя

' Описание макроса: https://learn.microsoft.com/en-us/windows/win32/api/fdi/nf-fdi-fnseek

' Delphi: function fnSeek(hf: Integer; dist: Longint; seektype: Integer; err: PInteger; pv: Pointer): Longint; cdecl;

Private Function fnSeek CDecl(ByVal hf As Long, ByVal dist As Long, ByVal seektype As Long, ByRef ErrNo As Long, pv As Long) As Long

Dim newPos As Long

If hf = fh Or hf = fh_cab Then ' Если открывается на позиционирование файл, который добавляется в архив, либо сам файл архива

newPos = SetFilePointer(hf, dist, ByVal 0&, seektype)

ErrNo = Err.LastDllError

Else ' Позиционирование "временного файла" то есть потока

newPos = IStream_Seek(hf, dist / 10000@, seektype)

End If

fnSeek = newPos

End Function

' 8. Закрытие файла (потока)

' Описание макроса: https://learn.microsoft.com/en-us/windows/win32/api/fdi/nf-fdi-fnclose

' Delphi: function fnClose(hf: Integer; err, pv: Pointer): Integer; cdecl;

Private Function fnClose CDecl(ByVal hf As Long, ErrNo As Long, pv As Long) As Long

If hf = fh Or hf = fh_cab Then ' Если закрывать нужно файл, который добавляется в архив, либо нужно закрывать сам файл архива

CloseHandle hf

End If

fnClose = 0

End Function

' 9. Удаление временного файла (потока)

' Delphi: function fnDelete(pszFile: PAnsiChar; err: PInteger; pv: Pointer): Integer; cdecl;

Private Function fnDelete CDecl(ByRef pszFile As Long, ErrNo As Long, pv As Long) As Long

IStream_Release pszFile

fnDelete = 0

End Function

' 10. Вызывается каждый раз при добавлении нового файла в архив

' Delphi: function fnFilePlaced(var ccab: TCCAB; pszFile: PAnsiChar; cbFile: Longint; fContinuation: BOOL; pv: Pointer): THandle; cdecl;

Private Function fnFilePlaced CDecl(ccab As TCCAB, ByVal pszFile As String, ByVal FileSize As Long, ByVal fContinuation As BOOL, ByVal pv As Long) As Long

' Здесь можно получить полезные данные:

' 1. FileSize

' 2. StrConv(ccab.szCabPath, vbUnicode)

' 3. StrConv(ccab.szCab, vbUnicode)

fnFilePlaced = 0

End Function

' --- FCICreate CallBack's ---

' +++ FCIAddFile CallBack's +++

' 11. Устанавливаем атрибуты файла

' Delphi: function fnOpenInfo(pszName: PAnsiChar; var pDate: WORD; var pTime: WORD; var pAttrib: WORD; err: PInteger; pv: Pointer): Integer; cdecl;

' Syntax C++

' ;; void FNFCIGETOPENINFO(

' ;; [in] LPSTR pszName,

' ;; USHORT *pdate,

' ;; USHORT *ptime,

' ;; USHORT *pattribs,

' ;; int FAR *err,

' ;; void FAR *pv

' ;; );

Private Function fnOpenInfo CDecl(ByVal pszName As String, pDate As Integer, pTime As Integer, pAttribs As Integer, ErrNo As Long, ByVal pv As Long) As Long

Dim LocalTime As FILETIME

Dim CreationTime As FILETIME

Dim LastAccessTime As FILETIME

Dim LastWriteTime As FILETIME

pAttribs = GetFileAttributes(StrPtr(pszName))

fh = CreateFileA(StrPtr(pszName), GENERIC_READ, FILE_SHARE_READ, ByVal 0&, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)

If fh <> INVALID_HANDLE_VALUE Then

GetFileTime fh, CreationTime, LastAccessTime, LastWriteTime

FileTimeToLocalFileTime LastWriteTime, LocalTime

FileTimeToDosDateTime LocalTime, pDate, pTime

fnOpenInfo = fh

Else

ErrNo = Err.LastDllError

fnOpenInfo = -1

End If

End Function

' 12. Вызывается на нескольких этапах обработки файла: сжатие блока, добавление сжатого блока и запись архива

' Delphi: function fnStatus(typeStatus: UINT; cb1, cb2: ULONG; pv: Pointer): Longint; cdecl;

Private Function fnStatus CDecl(ByVal typeStatus As Long, ByVal cb1 As Long, ByVal cb2 As Long, ByVal pv As Long) As Long

fnStatus = 0

End Function

' 13. Вызывается перед созданием нового тома архива

' Delphi: function fnGetNextCabinet(var ccab: TCCAB; cbPrevCab: ULONG; pv: Pointer): BOOL; cdecl;

Private Function fnGetNextCabinet CDecl(ccab As TCCAB, ByVal cbPrevCab As Long, ByVal pv As Long) As BOOL

fnGetNextCabinet = 0

End Function

' --- FCIAddFile CallBack's ---

' Упаковать файлы в архив CAB

' Функция принимает в качестве параметров SourceFullFileNames, DestFileNames строку (если файл один) либо массив строк (список файлов)

' DestFileNames - это необязательный параметр, это путь и имя файла внутри архива CAB

Public Function CabinetAddFiles(ByVal CabinetFullFileName As String, SourceFullFileNames As Variant, Optional DestFileNames As Variant, Optional CompressionMethod As cabCompressionMethod = cm_LZX21) As Boolean

Dim ccab As TCCAB

Dim erf As TERF

Dim fci As Long

Dim CabinetDisk As String

Dim CabinetName As String

Dim CabinetPath As String

Dim AnsiSourceFileName As String

Dim AnsiExtractFileName As String

Dim AnsiDestinationFileName As String

Dim AnsiSourceFullFileNames() As String

Dim AnsiDestFileNames() As String

Dim DestFileNamesArrayInitialized As Boolean

Dim i As Long

If Len(CabinetFullFileName) = 0 Then Exit Function

If IsArray(SourceFullFileNames) Then ' Если это массив

If CabinetIsArrayInitialized(SourceFullFileNames) = True Then ' Если массив инициализирован

For i = 0 To UBound(SourceFullFileNames)

AnsiSourceFileName = StrConv(SourceFullFileNames(i), vbFromUnicode) ' Преобразовать в ANSI

If InStrB(1, AnsiSourceFileName, ChrB(&H3F)) > 0 Then

' Cabinet.dll не поддерживает юникодные имена файлов для упаковки

Exit Function

End If

' Копируем массив, только в результатирующем массиве будут имена файлов в кодировке ANSI

CabinetInsertArrayString AnsiSourceFullFileNames, AnsiSourceFileName

Else

Exit Function

End If

Else

If VarType(SourceFullFileNames) = vbString Then

If SourceFullFileNames <> vbNullString Then

AnsiSourceFileName = StrConv(SourceFullFileNames, vbFromUnicode) ' Преобразовать в ANSI

If InStrB(1, AnsiSourceFileName, ChrB(&H3F)) > 0 Then

' Cabinet.dll не поддерживает юникодные имена файлов для упаковки

Exit Function

End If

CabinetInsertArrayString AnsiSourceFullFileNames, AnsiSourceFileName ' В массиве будет только одна строка

Else ' Строка не должна быть пустой

Exit Function

End If

Else ' Ошибка типа данных (не массив и не строка)

Exit Function

End If

If IsArray(DestFileNames) Then

If CabinetIsArrayInitialized(SourceFullFileNames) = True Then ' Если массив инициализирован

If UBound(SourceFullFileNames) <> UBound(DestFileNames) Then Exit Function ' Не совпадают границы массивов

For i = 0 To UBound(DestFileNames)

AnsiDestinationFileName = StrConv(DestFileNames(i), vbFromUnicode) ' Преобразовать в ANSI

If InStrB(1, AnsiDestinationFileName, ChrB(&H3F)) > 0 Then

' Cabinet.dll не поддерживает юникодные имена файлов для упаковки

Exit Function

End If

' Копируем массив, только в результатирующем массиве будут имена файлов в кодировке ANSI

CabinetInsertArrayString AnsiDestFileNames, AnsiDestinationFileName

DestFileNamesArrayInitialized = True

End If

Else

If VarType(DestFileNames) = vbString Then

If DestFileNames <> vbNullString Then

AnsiDestinationFileName = StrConv(DestFileNames, vbFromUnicode) ' Преобразовать в ANSI

If InStrB(1, AnsiDestinationFileName, ChrB(&H3F)) > 0 Then

' Cabinet.dll не поддерживает юникодные имена файлов для упаковки

Exit Function

End If

CabinetInsertArrayString AnsiDestFileNames, AnsiDestinationFileName ' В массиве будет только одна строка

DestFileNamesArrayInitialized = True

End If

' Прежде всего нужно взять FullFileName будущего архива и извлечь из него путь к папке и имя файла

CabinetName = StrConv(CabinetExtractFileName(CabinetFullFileName), vbFromUnicode) ' Преобразовать в ANSI

CabinetPath = StrConv(CabinetExtractFilePath(CabinetFullFileName), vbFromUnicode) ' Преобразовать в ANSI

' Определить значения структуры

ccab.cb = &H7FFFFFFF ' The maximum size, in bytes, of a cabinet created by FCI

ccab.iDisk = 1

CabinetDisk = StrConv("DISK1", vbFromUnicode) ' Я не знаю почему, но надо писать "DISK1"

CopyMemory VarPtr(ccab.setID) + 2, StrPtr(CabinetDisk), LenB(CabinetDisk) ' ccab.szDisk = CabinetDisk

CopyMemory VarPtr(ccab.setID) + 2 + 256, StrPtr(CabinetName), LenB(CabinetName) ' ccab.szCab = CabinetName

CopyMemory VarPtr(ccab.setID) + 2 + 512, StrPtr(CabinetPath), LenB(CabinetPath) ' ccab.szCabPath = CabinetPath

cabFileName = CabinetFullFileName ' Запомнить FileName будущего архива

fci = FCICreate(erf, AddressOf fnFilePlaced, AddressOf fnAlloc, AddressOf fnFree, AddressOf fnOpen, AddressOf fnRead, AddressOf fnWrite, AddressOf fnClose, AddressOf fnSeek, AddressOf fnDelete, AddressOf fnFciGTF, VarPtr(ccab))

If fci <> 0 Then

For i = 0 To UBound(AnsiSourceFullFileNames)

AnsiSourceFileName = AnsiSourceFullFileNames(i)

If DestFileNamesArrayInitialized = True Then

AnsiExtractFileName = AnsiDestFileNames(i)

Else

If IsArray(SourceFullFileNames) Then ' Если это массив

AnsiExtractFileName = StrConv(CabinetExtractFileName(SourceFullFileNames(i)), vbFromUnicode) ' Преобразовать в ANSI

Else

AnsiExtractFileName = StrConv(CabinetExtractFileName(SourceFullFileNames), vbFromUnicode) ' Преобразовать в ANSI

End If

FCIAddFile fci, StrPtr(AnsiSourceFileName), StrPtr(AnsiExtractFileName), 0, AddressOf fnGetNextCabinet, AddressOf fnStatus, AddressOf fnOpenInfo, CompressionMethod

If FCIFlushCabinet(fci, cFalse, AddressOf fnGetNextCabinet, AddressOf fnStatus) = cTrue Then

CabinetAddFiles = True

End If

FCIDestroy fci

End If

cabFileName = vbNullString

End Function

' Преобразовать полный путь кабинета в имя файла

Public Function CabinetExtractFileName(ByVal FileName As String) As String

Dim lNullPos As Long

Dim pszPath As String

pszPath = FileName

PathStripPathW StrPtr(pszPath)

lNullPos = InStr(1, pszPath, vbNullChar)

If lNullPos Then

CabinetExtractFileName = Left$(pszPath, lNullPos - 1)

Else

CabinetExtractFileName = FileName

End If

End Function

' Преобразовать полный путь кабинета в путь к папке (всегда возвращает на конце "\")

Public Function CabinetExtractFilePath(ByVal FileName As String) As String

Dim lNullPos As Long

Dim pszPath As String

pszPath = FileName

PathRemoveFileSpecW StrPtr(pszPath)

lNullPos = InStr(1, pszPath, vbNullChar)

If lNullPos Then

pszPath = Left$(pszPath, lNullPos - 1)

If Right$(pszPath, 1) <> "\" Then pszPath = pszPath & "\"

CabinetExtractFilePath = pszPath

Else

CabinetExtractFilePath = FileName

End If

End Function

' Добавить строку в массив, в не зависимости от того, был ли он инициализирован

Public Sub CabinetInsertArrayString(ByRef strArr() As String, ByVal InsertString As String)

Dim NewIndex As Long

If CabinetIsArrayInitialized(strArr) = False Then

ReDim strArr(0)

strArr(0) = InsertString

Else

NewIndex = UBound(strArr) + 1

ReDim Preserve strArr(NewIndex)

strArr(NewIndex) = InsertString

End If

End Sub

' Инициализирован ли массив

Public Function CabinetIsArrayInitialized(arr) As Boolean

Dim saAddress As Long

GetMem4 VarPtr(arr) + 8, saAddress

GetMem4 saAddress, saAddress

CabinetIsArrayInitialized = (saAddress <> 0)

If CabinetIsArrayInitialized Then CabinetIsArrayInitialized = UBound(arr) >= LBound(arr)

End Function

Добавлено 21.11.24, 17:27
Теперь давайте мне DGM, чтобы это ни значило бы) надеюсь это что-то хорошее)))

Кому надо DGM ?

Vasya2000 — Thu, 24 Mar 2005 02:09:26 +0000

Vasya2000: Это только создание архива, да еще и не через cabinet.dll, короче это не то.

Кому надо DGM ?

SCAT123 — Wed, 23 Mar 2005 16:26:01 +0000

SCAT123: Можно сделать через COM (см. здесь), но, как я понял, будет работать только под Win2k и выше

Кому надо DGM ?

f33l — Fri, 25 Feb 2005 11:43:28 +0000

f33l: Пока никак =) Щас у мя вообще мало времени, как освобожусь, займусь вплотную. Мне что-то всё-таки влом колупаться с этими cdecl, т.к. это будет очень трудно отлаживать, поэтому я попробую разобраться в реализации MSZIP- или LZX-сжатия.

Кому надо DGM ?

miksayer — Thu, 24 Feb 2005 19:50:56 +0000

miksayer: ну и как даела?

Кому надо DGM ?

f33l — Sat, 19 Feb 2005 15:45:54 +0000

f33l: SmK, т.е. я был прав насчёт чистки стека..

Цитата SmK @ 19.02.05, 07:47

Вылетает ошибка Rumtime Error 0

Странно...

Цитата nash @ 19.02.05, 14:14

да там половина функций неправильно задекларирована

Хм? А по-подробней?

Кому надо DGM ?

nash — Sat, 19 Feb 2005 14:14:44 +0000

nash: да там половина функций неправильно задекларирована.

Кому надо DGM ?

SmK — Sat, 19 Feb 2005 07:47:36 +0000

SmK:

Цитата

вызов cdecl-функций отличается только тем, что нужно чистить стек.. правильно я понял?

Цитата

; F(A,B,C,D)

_cdecl: ; прямой порядок расположения данных на стеке
; обратный по времени способ запихивания
; допускает переменное число параметров
; поскольку стек очищает тот, кто вызвал функцию
push D
push C
push B
push A
call F
; ret
inc esp, 16 ; очистка стека здесь

_stdcall: ; порядок данных - тот же самый
; но стек очищает функция
; поэтому число параметров фиксировано
push D
push C
push B
push A
call F
; ret 16 ; очистка стека - в функции

_fastcall: ; аналогично stdcall, но два первых параметра передаются через регистры
push D
push C
mov edx, B
mov eax, A
call F
; ret 8 ; очистка стека - в функции

_pascal: ; обратный порядок данных на стеке, прямой порядок запихивания
; поэтому число параметров фиксировано, и следовательно, стек очищает функция
push A
push B
push C
push D
call F
; ret 16

Цитата

ОДНАКО хочу заметить, ведь мой код всё-таки работает.. если подебажить, можно увидеть, что структуры и правда заполняются, даже вроде правильно, но криво (имя файла например вписывается правильно, но с каким-то смещением..) Т.е. я хочу сказать, что оно как-никак, но работает. Может быть баг просто только в коде?..

Хм... а у меня не заполняются. Вылетает ошибка Rumtime Error 0

Кому надо DGM ?

f33l — Wed, 16 Feb 2005 22:46:38 +0000

f33l: Насколько я понял из найденных примеров (там вставки, но вроде всё более-менее понятно..), вызов cdecl-функций отличается только тем, что нужно чистить стек.. правильно я понял?
И это:

Цитата SmK @ 15.02.05, 05:09

А обычные ф-ии типа fci_open вообще нельзя

Почему? Это никак не обойти (по аналогии с cdecl-API)?

ОДНАКО хочу заметить, ведь мой код всё-таки работает.. если подебажить, можно увидеть, что структуры и правда заполняются, даже вроде правильно, но криво (имя файла например вписывается правильно, но с каким-то смещением..) Т.е. я хочу сказать, что оно как-никак, но работает. Может быть баг просто только в коде?..

Подключайтесь, блин, а то трудновато в этом во всём разобраться..

И вот ещё, тот другой способ, про который я говорил. В CAB SDK подробно описывается формат CAB, т.е. его можно конструировать вручную. Там есть пример cab-архива (не код, просто структура бинарика), он прокомментирован, и разобраться легко. НО там очень мало и запутанно написано про сжатие.. И в том примере файлы не сжаты. Т.е. я могу реализовать ручную сборку, но только без сжатия файлов (т.к. фиг там разберёшься)
Если у кого есть примеры/ссылки реализации полностью совместимого со стандартом сжатия MSZIP (или LZX), выложите, плиз.
Вообще, конечно, это менее желательный вариант, но если нифига с этим [censored] cdecl не получится, то останется только это..

Кому надо DGM ?

f33l — Tue, 15 Feb 2005 17:14:38 +0000

f33l: Всё, я понял =) Блин, никогда не сталкивался на VB с cdecl-функциями..
Что ж придётся разбираться =)
Хотя, есть, в принципе, альтернатива, но геморная..
Попробую покувыркаться с этим cdecl, вроде что-то нашёл уже..

Кому надо DGM ?

SmK — Tue, 15 Feb 2005 05:09:39 +0000

SmK:

Цитата

Гм, и что, что cdecl?

А VB их вызывает как stdcall. У VB все stdcall.
Менять нельзя. Нуу... разве вроде импортируемы ф-ии можно, но там тоже косяки идут
(Bad DLL calling convercation)

Private Declare Function FCICreate CDecl& Lib "cabinet.dll"

А обычные ф-ии типа fci_open вообще нельзя.

Кому надо DGM ?

f33l — Mon, 14 Feb 2005 15:22:27 +0000

f33l:

Цитата SmK @ 14.02.05, 14:59

Нет, чтобы на сях сделать юзабельную длл и юзать в VB

Ну, во-первых, изначально это было нужно Скинеру для его спая, почитай посты выше. Во-вторых, конечно хорошо, когда есть возможность не юзать сторонние библиотеки/контролы (для этого, кстати, Скинер и поднял вопрос). А, в-третьих, это просто интересно как опыт, в том числе и перевода.

Цитата SmK @ 14.02.05, 14:59

Там все ф-ии CDECL ! И callback-и и FCICreate. ИМХО без ассемблерных вставок вряд ли обойтись

Гм, и что, что cdecl? И причём тут асмовые вставки?

Кому надо DGM ?

SmK — Mon, 14 Feb 2005 14:59:21 +0000

SmK: Блин,f33l, тебе делать нечего, как перегонять код из Сей в VB ? Нет, чтобы на сях сделать юзабельную длл и юзать в VB.
Посмотрел исходник. Там все ф-ии CDECL ! И callback-и и FCICreate
ИМХО без ассемблерных вставок вряд ли обойтись. А это такой гемор.
Предлагаю все же рассмотреть вариант с длл на сях :)

Кому надо DGM ?

f33l — Mon, 14 Feb 2005 09:19:20 +0000

f33l: Всё, выкладываю, блин.. Мы по-тихому =) договорились со Скинером устранить ошибочку, чтоб можно было сразу выложить полностью работоспособный модуль, однако он опять куда-то пропал.. <_<
Итак, в аттаче модуль на VB и несколько файлов из CAB SDK на C, которые, собственно, переводились..

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

Кому надо DGM ?

miksayer — Thu, 10 Feb 2005 13:38:27 +0000

miksayer:

Цитата f33l @ 06.02.05, 23:38

Всё переведено и подкорректировано, теперь отлавливаются и давятся злостные подлые баги...

может выложишь? вместе баги будет устранять

Кому надо DGM ?

SCINER — Mon, 07 Feb 2005 05:43:29 +0000

SCINER: cablib.dll не входит в стандартную поставку windows и является надстройкой для cabinet.d

Кому надо DGM ?

SmK — Mon, 07 Feb 2005 05:16:43 +0000

SmK: Извиняюсь, если не до конца въехал в тему, но
Project->References->CabLib интерфейс ля работы с архивами Cabinet
Это разве не то ?

Кому надо DGM ?

f33l — Sun, 06 Feb 2005 23:38:32 +0000

f33l: Всё переведено и подкорректировано, теперь отлавливаются и давятся злостные подлые баги...

Кому надо DGM ?

maxim84_ — Sun, 06 Feb 2005 11:32:14 +0000

maxim84_: Распокавал?

Кому надо DGM ?

SCINER — Sun, 06 Feb 2005 11:16:32 +0000

SCINER: че-то я непонял откуда в хафманском файле вот такая штука:

Цитата

HE4

2876
Rar!

помоему этот архив создан при помощи совсем другой программы

Кому надо DGM ?

maxim84_ — Sun, 06 Feb 2005 10:54:37 +0000

maxim84_: хммм! интиресно!!
вот попробуй

Кому надо DGM ?

SCINER — Sun, 06 Feb 2005 07:40:43 +0000

SCINER:

Цитата maxim84_ @ 05.02.05, 21:04

ну как это нет ничего на VB!!!
77 методов компресии
ооочень хорошие исходники!! а тебе уважаемый SCINER подойдет метод сжатия Huffman'а на называется он "Short 16 Chars"
WinRar 3.11 читает!! сам проверял!!

1. Short 16 Chars - там нет такого метода
2. WinRAR 3.42 пишет неверный формат на файлы сжатые всеми видами алгоритма Huffman

ооочень хорошие исходники!!

:no:
1. почти в каждом алгоритме ошибка
2. они не очень хорошо оптимизированы

Кому надо DGM ?

maxim84_ — Sat, 05 Feb 2005 21:04:35 +0000

maxim84_: ну как это нет ничего на VB!!!
77 методов компресии
ооочень хорошие исходники!! а тебе уважаемый SCINER подойдет метод сжатия Huffman'а на называется он "Short 16 Chars"
WinRar 3.11 читает!! сам проверял!!

Кому надо DGM ?

miksayer — Sat, 05 Feb 2005 20:02:57 +0000

miksayer:

Цитата SCINER @ 05.02.05, 20:00

мне нужно сжать кучку файлов в архив, который смогут распаковать WinZip и WinRAR

мне тоже

Цитата SCINER @ 05.02.05, 20:00

1. нет ничего на VB

раньше там к каждому алгоритму прилагался пример на VB, Pascal и C, а теперь почему-то нет

Кому надо DGM ?

SCINER — Sat, 05 Feb 2005 20:00:07 +0000

SCINER: 1. нет ничего на VB
2. там только алгоритмы сжатия, без формата архивов
3. алгоритмы ни капли не оптимизированные

мне нужно сжать кучку файлов в архив, который смогут распаковать WinZip и WinRAR

Кому надо DGM ?

f33l — Sat, 05 Feb 2005 19:59:33 +0000

f33l: Блин, зачем ты поднял это позорное

Цитата f33l @ 20.12.04, 15:15

где-то на выходных

=)) А если серьёзно, уже почти готово, осталось буквально переписать функцию да привести это всё в человеческий вид. Большое сорри за такую задержку, мне действительно несколько стыдно =)

Кому надо DGM ?

miksayer — Sat, 05 Feb 2005 19:55:35 +0000

miksayer:

Цитата f33l @ 20.12.04, 15:15

Неа, я сам =))) Если серьёзно, я выложу где-то на выходных наверно...

и где же? уже 2 месяца ждем

Цитата SCINER @ 19.12.04, 11:20

Можно ZIP
но для него придется писать сам алгоритм сжатия. Потом его потимизировать под VB.
А для каба есть готовая библа, надо только функции заюзать.
Вот так.
Если есть зип, можно и зип, я не против.

а если не zip?
вот нашел:
http://algolist.manual.ru/compress/standard/index.php

Кому надо DGM ?

f33l — Mon, 20 Dec 2004 15:15:19 +0000

f33l: Неа, я сам =))) Если серьёзно, я выложу где-то на выходных наверно...

Кому надо DGM ?

XPraptor — Mon, 20 Dec 2004 12:11:10 +0000

XPraptor: f33l, Там (в fci.h) основной момент как перевести указатели на функции обратного вызова (PFNFCIGETNEXTCABINET, PCCAB) и прочие. Если ты это уже сделал, то выкладывай, дальше всем аулом добъем очень быстро. ;)

Кому надо DGM ?

f33l — Sun, 19 Dec 2004 23:35:04 +0000

f33l: Переведён fci.h и бОльшая часть tesfci.c. В принципе это хорошо, но тестировать я пока ни разу не запустил, т.к. нужно перевести полностью. И не думаю, что когда я запущу, всё запашет с первого раза, т.к. там куча спорных мест, и это всё надо будет шлифовать долго...

Кому надо DGM ?

SCINER — Sun, 19 Dec 2004 23:32:35 +0000

SCINER: Блин.
кстати а что уже достигнуто на сегодняшний день ?

Кому надо DGM ?

f33l — Sun, 19 Dec 2004 23:23:12 +0000

f33l:

Цитата SCINER @ 20.12.04, 01:54

срочно

Блин, ну почему рочно? =) Моему переводу до рабочего варианта ещё очень далеко...

Кому надо DGM ?

SCINER — Sun, 19 Dec 2004 22:54:58 +0000

SCINER: В данный момент в моей проге юзается cablib.dll от Microsoft'a
Мне срочно(потому что уже достала) надо от нее избавится(любым способом).

Требуется запаковать кучку файлов из кода программы(без библиотек и прог) в такой архив, который потом смогли бы распаковать WinZip и WinRAR.

Кому надо DGM ?

f33l — Sun, 19 Dec 2004 17:51:13 +0000

f33l: Это не подходит, Sciner вроде говорил уже. Ему нужно без сторонних контролов и прог.

Кому надо DGM ?

miksayer — Sun, 19 Dec 2004 17:35:38 +0000

miksayer: SCINER, а как насчет утилиты MAKECAB.EXE(смотри аттач)?

Кому надо DGM ?

SCINER — Sun, 19 Dec 2004 11:20:53 +0000

SCINER: Можно ZIP
но для него придется писать сам алгоритм сжатия. Потом его потимизировать под VB.
А для каба есть готовая библа, надо только функции заюзать.
Вот так.
Если есть зип, можно и зип, я не против.

Кому надо DGM ?

miksayer — Sun, 19 Dec 2004 08:28:54 +0000

miksayer: SCINER, а тебе обязательно именно cab? Ведь можно просто архивировать по какому-нибудь другому алгоритму и все. Хотя я не думаю, что ты бы создавал эту тему, если бы ты мог обойтись без cab

Добавлено 19.12.04, 08:36
Кстати, я как-то находил прмер с 150 алгоритмами сжатия, но с моего винчестера он бесследно пропал. Теперь не могу его найти. Может у кого-то есть?

Кому надо DGM ?

f33l — Sun, 19 Dec 2004 00:06:04 +0000

f33l: Распаковка - это фигня.. Я тоже находил такой сурс, он не юзает cabinet.dll, там другой принцип. А про XML в комментах вроде написано, я уж не помню. Типа в таком формате там сохраняются сведения о cab-файлах (только, спрашивается, нафиг это нужно?)

Я вообще тут в напряге... У меня куча материалов по cab'ам на разных языках, но они пользы почти не приносят. Мне приходится почти с нуля переводить код из MS CAB SDK, там всё на Сях, а с Сей на ВБ переводить местами очень трудно.. Работа идёт, но медленно..

Кому надо DGM ?

SCINER — Sat, 18 Dec 2004 23:34:43 +0000

SCINER: Нашел распаковку.
Но она какая-то непонятная.
Причем тут вообще XML ?
Да и cabinet.dll че-то нигде не светится ???

Кому надо DGM ?

SCINER — Wed, 15 Dec 2004 20:49:37 +0000

SCINER: распаковка не нужна.

Кому надо DGM ?

f33l — Wed, 15 Dec 2004 15:01:37 +0000

f33l: То есть всё-таки общий класс делать...
А распаковвывать тебе надо?

Кому надо DGM ?

SCINER — Wed, 15 Dec 2004 01:28:25 +0000

SCINER: Мне надо типа:

Dim Cab As New Cabinet

For i=0 To File1.ListCount -1

Cab.AddFile File1.List(i)

Cab.Path = "C:\MyCabinet.Cab"

Call Cab.Compress

Msgbox "Archive create sucessfull!",32

Кому надо DGM ?

f33l — Tue, 14 Dec 2004 11:46:28 +0000

f33l: SCINER, я нашёл кое-что насчёт cab'ов в очень извратном виде, но это сильно поможет с переводом.
Так вот, скажи подробно, что ты хочешь делать со всем этим, т.е. опиши подробнее задачу и т.д.. Я могу узко заточить под конкретную задачу, а могу и сделать общий класс (хотя его всё равно придётся делать потом).

Кому надо DGM ?

Dufa — Mon, 06 Dec 2004 05:37:07 +0000

Dufa: SCINER, Очень много ошибок. В делфи тип Integer = 4 байтам

Кому надо DGM ?

SCINER — Mon, 06 Dec 2004 02:41:48 +0000

SCINER:

Цитата f33l,6.12.04, 01:53 @ 07.01.70, 04:17

Чем это ты переводил? имхо оочень криво переводит.
Вообще-то я имел ввиду пост#9: это конечный код или есть исправления?
кстати навскидку tcomp это не структура это typedef, который вроде-бы используется как набор констант

Переводил я сам :)
Я не силен в Delphi.
А насчет поста №9, я в нем ниче не понял, неработает он и все!

Кому надо DGM ?

f33l — Mon, 06 Dec 2004 01:53:55 +0000

f33l: Чем это ты переводил? имхо оочень криво переводит.
Вообще-то я имел ввиду пост#9: это конечный код или есть исправления?
кстати навскидку tcomp это не структура это typedef, который вроде-бы используется как набор констант

Кому надо DGM ?

SCINER — Mon, 06 Dec 2004 01:09:39 +0000

SCINER: Вот, но здесь стопудово ниче неправильно.
А еще доку отсюда брал: http://cvs.winehq.com/patch.py?id=6331

Кому надо DGM ?

f33l — Mon, 06 Dec 2004 00:46:53 +0000

f33l: Я такими вещами не занимался... и поподробней плиз что за баг
И ещё раз: выложи тут, что у тя в конечном варианте получилось по кабам

Кому надо DGM ?

f33l — Sun, 05 Dec 2004 22:18:04 +0000

f33l: Хм... трудновато.. Выложите плиз всё, что у вас пока получилось на эту тему, так будет проще.
з.ы. а на сях желательно под билдер нету исходников?

Кому надо DGM ?

SCINER — Sun, 05 Dec 2004 22:11:08 +0000

SCINER: Вообще-то здесь все помогают безвозмездно,
но если на то пошло, могу 2 DGM отдать (не больше)!
Об этом в 1-ом посте этого топика сказано.

Кому надо DGM ?

Vasya2000 — Sun, 05 Dec 2004 14:45:42 +0000

Vasya2000: А сколько вы хотите?

Кому надо DGM ?

Dufa — Sun, 05 Dec 2004 13:35:25 +0000

Dufa: Исходники большие, а сколько заплатите :blink: :D

Кому надо DGM ?

Vasya2000 — Sun, 05 Dec 2004 06:28:04 +0000

Vasya2000: Вот исходники на Делфи, перевести надо всё!

Кому надо DGM ?

SCINER — Sun, 05 Dec 2004 04:39:26 +0000

SCINER: Кусок кода который с которым можно запаковать файлы в архив.

Кому надо DGM ?

f33l — Sun, 05 Dec 2004 03:53:28 +0000

f33l: Уф... :rolleyes: Я долго долбился с експлорером, забил и поставил оперу... наконец-то зарегился
Так вот, в аттаче лежат исходники компонентов, которые работают с cab'ами - что конкретно тебе надо перевести? :D

Кому надо DGM ?

SCINER — Sun, 05 Dec 2004 00:27:42 +0000

SCINER: если я его кину на сайт у меня деньги на счету кончаться.
у меня выделенка с платным трафиком.

Остаток на счете: -0.94 у.е., порог отключения: -1 у.е.

а заплатить деньги немогу т.к. завтра воскресенье.
еще максимум килобайт 500 протяну.
а аттач весит 83кб!

Кому надо DGM ?

tmp — Sun, 05 Dec 2004 00:05:22 +0000

tmp: Блин Sciner )) Ты забыл что я не зареген? ) Кинь к себе на сайт плиз
а вообще, сорри, конечно... я вот щас попытаюсь осла переставить, может быть всё исправится..

Кому надо DGM ?

SCINER — Sat, 04 Dec 2004 17:41:19 +0000

SCINER: Блин, а я и не видел этого поста.
Вот, что-то на дельфи:

Кому надо DGM ?

tmp — Sat, 04 Dec 2004 17:10:11 +0000

tmp: Sciner см пост #40. Могу чем-нить помочь хоть в этом?

Кому надо DGM ?

SCINER — Sat, 04 Dec 2004 16:02:48 +0000

SCINER: Блин. Жаль что ниче нового.
На данный момент в SCINSpy я как раз эту библу и юзаю. Я только перебил ее немного(удалил инфу о версии, переименовал в ssreport.dll и сжал UPX'ом)
К сожалению это не на VB.

Проблема до сих пор актуальна!

Кому надо DGM ?

Vasya2000 — Sat, 04 Dec 2004 15:34:10 +0000

Vasya2000: Кхм. Собственно самих исходников библиотеки нету. Да и библиотека не на ВБ сделана. Жаль.

Кому надо DGM ?

Dr._S — Sat, 04 Dec 2004 15:03:04 +0000

Dr._S: SCINER, нашел пример по CAB'у архивировать/разархивировать, но не могу на форум выложить, хрень какая-то, не получается! Качать могу, все и сколько хочешь, а вот когда начинаю выкладывать - проблема. Если на сайт не получится выложить, то до понедельника.

1 часть

2 часть

Кому надо DGM ?

tmp — Sat, 04 Dec 2004 14:40:16 +0000

tmp:

Цитата

Пол инета перерыл, ничего готового не нашел.
Кроме как на C++ да на Delphi.

Если ты нашёл то, что тебе нужно, но есть проблемы с переводом на вб, выложи кусок кода (лучше на дельфях), может смогу помочь? :unsure:

Кому надо DGM ?

SCINER — Sat, 04 Dec 2004 05:01:04 +0000

SCINER: Так там же только распаковка и просмотр. Вроде :huh:.
Там нет запаковки в архив!

Кому надо DGM ?

Dr._S — Sat, 04 Dec 2004 04:36:24 +0000

Dr._S: Vasya2000,

Цитата

Наверное потому что zip и rar тоже сторонние архиваторы, их в винде может и не быть, а cab предустановлен в винде, так же как kernel или user32.

, Вася в примере используются только kernel32 и shell32

SCINER,

Цитата

zip or rar неподходят, в чистой винде нет ничего для работы с ними.
а cabinet.dll есть везде!

, если ты смотрел пример, то наверное заметил, что в нем используются только kernel32 и shell32. Никаких сторонних библиотек, тем более самих экзешников этих архиваторов и в помине нет.

Кому надо DGM ?

SCINER — Sat, 04 Dec 2004 01:11:48 +0000

SCINER: zip or rar неподходят, в чистой винде нет ничего для работы с ними.
а cabinet.dll есть везде!

Да в принципе мне подойдет любой алгоритм сжатия.
Лишь бы его поддерживал WinZip и WinRar.
А то как мне людям слать архивы, которые потом никак не распаковать ?

Короче CAB здесь подходит всех больше.
Если бы еще знать как им корректно пользоваться :)

Пол инета перерыл, ничего готового не нашел.
Кроме как на C++ да на Delphi.

Кому надо DGM ?

Vasya2000 — Wed, 01 Dec 2004 10:33:35 +0000

Vasya2000: Ну не знаю как там с зипом или раром, это вообще-то SCINER'у надо было. А по поводу cab'а - задача сама по себе интересная.

Кому надо DGM ?

Dr._S — Wed, 01 Dec 2004 10:17:01 +0000

Dr._S: Vasya2000,

Цитата

, так нет, как раз таки, не используя сами это архиваторы, а реальный код. Вот например посмотри это, там есть и CAB, но вот только он его может просматривать и все. Работает реально только с зипом, вроде, не разбирался сильно, смотри сам:

Кому надо DGM ?

Vasya2000 — Wed, 01 Dec 2004 09:49:05 +0000

Vasya2000: Наверное потому что zip и rar тоже сторонние архиваторы, их в винде может и не быть, а cab предустановлен в винде, так же как kernel или user32.

Кому надо DGM ?

Dr._S — Wed, 01 Dec 2004 09:28:44 +0000

Dr._S: Vasya2000,

Цитата

Нужны исходники на ВБ, работа с cabinet.dll напрямую, а не через посредников.

, а почему именно с CAB, а не ZIP или RAR например?

Кому надо DGM ?

Vasya2000 — Wed, 01 Dec 2004 07:32:51 +0000

Vasya2000: Нужны исходники на ВБ, работа с cabinet.dll напрямую, а не через посредников.

Кому надо DGM ?

Dr._S — Wed, 01 Dec 2004 04:57:38 +0000

Dr._S: Vasya2000, а expand.exe (для XP) и extract (win98) не подходит?

Кому надо DGM ?

tmp — Tue, 30 Nov 2004 14:21:30 +0000

tmp: 2Sciner: ну мне в полнейший лом переставлять... :'( потом как-нить
2Vasya2000: пасиб... и отдельно большое спасибо за ссылку на такой замечательный сайт =) не знал о нём..

Кому надо DGM ?

SCINER — Tue, 30 Nov 2004 14:05:55 +0000

SCINER:

Цитата miksayer @ 30.11.04, 12:41

мне тоже нужно с Cab'ами работать... А cabinet.dll с виндой поставляется?

Да! Помоему начиная с 98. А может даже и с 95.

Кому надо DGM ?

miksayer — Tue, 30 Nov 2004 12:41:21 +0000

miksayer: мне тоже нужно с Cab'ами работать... А cabinet.dll с виндой поставляется?