Кому надо DGM ? , за исходники 2-х алгоритмов

Заплачу за каждый исходник по 2 DGM.

1. Исходник на VB6.0 монитора файловой системы. <- Вопрос решен
2. Исходник на VB6.0 класса для работы с библиотекой CABINET.DLL

Сообщение отредактировано: SCINER - 29.11.04, 10:07

а что за библа такая!? CABINET.DLL?

maxim84_, Cab'ы юзает

Добавлено 28.11.04, 04:45
SCINER, Смотри здесь

Есть такая программка FileMon... Круче неё ничего не сделать на эту тему
>filemon<
Так вот, там есть пункт "How FileMon Works". Я из него можно понять, что в проге используется специальный vxd который перехватывает соответствующие вызовы и т.д. На VB пока ещё дрова писать нельзя, так что средствами VB тут не ограничишься...
Но, в принципе, можно глобально перехватывать вызовы файловых API, хотя это естественно менее эффективно, и таким образом будут отслеживаться не все изменения, т.к. не все проги используют API для работы с файлами.

По второму пункту - вообще темный лес.
В принципе декларации функций из библиотеки выглядят так:

Declare Function FCIAddFile Lib "cabinet.dll" ( _
                 ByRef hfci As hfci, _
                 ByVal pszSourceFile As String, _
                 ByVal pszFileName As String, _
                 ByVal fExecute As Long, _
                 ByRef pfnfcignc As PFNFCIGETNEXTCABINET, _
                 ByRef pfnfcis As PFNFCISTATUS, _
                 ByRef pfnfcigoi As PFNFCIGETOPENINFO, _
                 ByRef ltypeCompress As TCOMP) As Long
Declare Sub FCICreate Lib "cabinet.dll" ( _
            ByRef perf As perf, _
            ByRef pfnfcifp As PFNFCIFILEPLACED, _
            ByRef pfna As PFNFCIALLOC, _
            ByRef pfnf As PFNFCIFREE, _
            ByRef pfnopen As PFNFCIOPEN, _
            ByRef pfnread As PFNFCIREAD, _
            ByRef pfnwrite As PFNFCIWRITE, _
            ByRef pfnclose As PFNFCICLOSE, _
            ByRef pfnseek As PFNFCISEEK, _
            ByRef pfndelete As PFNFCIDELETE, _
            ByRef pfnfcigtf As PFNFCIGETTEMPFILE, _
            ByRef pccab As pccab, _
            pv As Any)
Declare Function FCIDestroy Lib "cabinet.dll" ( _
                 ByRef hfci As hfci) As Long
Declare Function FCIFlushCabinet Lib "cabinet.dll" ( _
                 ByRef hfci As hfci, _
                 ByVal fGetNextCab As Long, _
                 ByRef pfnfcignc As PFNFCIGETNEXTCABINET, _
                 ByRef pfnfcis As PFNFCISTATUS) As Long
Declare Function FCIFlushFolder Lib "cabinet.dll" ( _
                 ByRef hfci As hfci, _
                 ByRef pfnfcignc As PFNFCIGETNEXTCABINET, _
                 ByRef pfnfcis As PFNFCISTATUS) As Long
Declare Function FDICopy Lib "cabinet.dll" ( _
                 ByRef hfdi As hfdi, _
                 ByVal pszCabinet As String, _
                 ByVal pszCabPath As String, _
                 ByVal flags As Long, _
                 ByRef pfnfdin As PFNFDINOTIFY, _
                 ByRef pfnfdid As PFNFDIDECRYPT, _
                 pvUser As Any) As Long
Declare Sub FDICreate Lib "cabinet.dll" ( _
            ByRef pfnalloc As pfnalloc, _
            ByRef pfnfree As pfnfree, _
            ByRef pfnopen As pfnopen, _
            ByRef pfnread As pfnread, _
            ByRef pfnwrite As pfnwrite, _
            ByRef pfnclose As pfnclose, _
            ByRef pfnseek As pfnseek, _
            ByVal cpuType As Long, _
            ByRef perf As perf)
Declare Function FDIDestroy Lib "cabinet.dll" ( _
                 ByRef hfdi As hfdi) As Long
Declare Function FDIIsCabinet Lib "cabinet.dll" ( _
                 ByRef hfdi As hfdi, _
                 ByRef hf As INT_PTR, _
                 ByRef pfdici As PFDICABINETINFO) As Long
 
Declare Function FDITruncateCabinet Lib "cabinet.dll" ( _
                 ByRef hfdi As hfdi, _
                 ByVal pszCabinetName As String, _
                 ByVal iFolderToDelete As Integer) As Long

но вот такие вещи как TCOMP, PFNFCIGETNEXTCABINET и т.п. - даже и не знаю с какой стороны подойти к их декларированию.

Мне нужен именно код запаковки файлов в один архив.
Все функции отвечающие именно за запаковку начинаются на FCI,
те же которые начинаются на FDI отвечают за распаковку.

Насчет деклараций. Это еще не полное решение. Вот если бы еще эту структурку узнать

а что насчёт мониторинга?

Цитата Andrey_Kun @ 28.11.04, 04:35

maxim84_, Cab'ы юзает

Добавлено 28.11.04, 04:45
SCINER, Смотри здесь

Там все на С
Я в нем 0
и структуру PFNFCIGETNEXTCABINET я тоже не нашел

Вот, что откопал в инете:

Option Explicit
 
Private Declare Function lopen Lib "kernel32" Alias "_lopen" (ByVal lpPathName As String, ByVal iReadWrite As Long) As Long
Private Declare Function lclose Lib "kernel32" Alias "_lclose" (ByVal hFile As Long) As Long
Private Declare Function lcreat Lib "kernel32" Alias "_lcreat" (ByVal lpPathName As String, ByVal iAttribute As Long) As Long
Private Declare Function llseek Lib "kernel32" Alias "_llseek" (ByVal hFile As Long, ByVal lOffset As Long, ByVal iOrigin As Long) As Long
Private Declare Function lread Lib "kernel32" Alias "_lread" (ByVal hFile As Long, lpBuffer As Any, ByVal wBytes As Long) As Long
Private Declare Function lwrite Lib "kernel32" Alias "_lwrite" (ByVal hFile As Long, ByVal lpBuffer As String, ByVal wBytes As Long) As Long
Private Declare Function hread Lib "kernel32" Alias "_hread" (ByVal hFile As Long, lpBuffer As Any, ByVal lBytes As Long) As Long
Private Declare Function hwrite Lib "kernel32" Alias "_hwrite" (ByVal hFile As Long, ByVal lpBuffer As String, ByVal lBytes As Long) As Long
Private Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
Private Declare Function OpenFile Lib "kernel32" (ByVal lpFileName As String, lpReOpenBuff As OFSTRUCT, ByVal wStyle As Long) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
 
Public Const O_RDONLY = &H0     ' open for reading only */
Public Const O_WRONLY = &H1     ' open for writing only */
Public Const O_RDWR = &H2       ' open for reading and writing */
Public Const O_APPEND = &H8     ' writes done at eof */
Public Const O_CREAT = &H100    ' create and open file */
Public Const O_TRUNC = &H200    ' open and truncate */
Public Const O_EXCL = &H400     ' open only if file doesn't already exist */
 
Public Const OF_CREATE = &H1000
Public Const OF_READ = &H0
Public Const OF_READWRITE = &H2
Public Const OF_WRITE = &H1
 
Public Const OF_SHARE_EXCLUSIVE = &H10
Public Const MEDIA_SIZE = 300000
Public Const FOLDER_THRESHOLD = 900000
Public Const COMPRESSION_TYPE = &H1
 
Public Type ClientState
  total_compressed_size As Long   ' total compressed size so far */
  total_uncompressed_size As Long ' total uncompressed size so far */
End Type
 
'public const HFILE_ERROR ((HFILE)-1)
 
Public Const CB_MAX_CHUNK = 32768
Public Const CB_MAX_DISK = &H7FFFFFFF
Public Const CB_MAX_FILENAME = 256
Public Const CB_MAX_CABINET_NAME = 256
Public Const CB_MAX_CAB_PATH = 256
Public Const CB_MAX_DISK_NAME = 256
 
Public Type Ccab
  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
  setID As Integer                  ' Cabinet set ID
  szDisk As String * 256            ' current disk name
  szCab As String * 256             ' current cabinet name
  szCabPath As String * 256         ' path for creating cabinet
End Type
 
Public Type ErrorRF
  erfOper As Integer
  erfType As Integer
  fError As Boolean
End Type
 
Public Const OFS_MAXPATHNAME = 128
Public Type OFSTRUCT
  cBytes As Byte
  fFixedDisk As Byte
  nErrCode As Integer
  Reserved1 As Integer
  Reserved2 As Integer
  szPathName(OFS_MAXPATHNAME) As Byte
End Type
 
Public Const GMEM_FIXED = &H0
 
Public Declare Sub ZeroMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, ByVal numBytes As Long)
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Public Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Public Declare Function FCICreate Lib "CABINET.DLL" (perf As ErrorRF, pfnfiledest As Long, pfnalloc As Long, pfnfree As Long, pfnopen As Long, pfnread As Long, pfnwrite As Long, pfnclose As Long, pfnseek As Long, pfndelete As Long, pfnfcigtf As Long, pccab As Ccab, pv As Long) As Long
Public Declare Function FCIAddFile Lib "CABINET.DLL" (hfci As Long, ByVal pszSourceFile As Long, ByVal pszFileName As Long, ByVal fExecute As Boolean, ByVal pfnGetNextCabinet As Long, ByVal pfnProgress As Long, ByVal pfnOpenInfo As Long, ByVal typeCompress As Long) As Long
Public Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
 
Public Function FCIMalloc(ByVal lngSize As Long) As Long
  Dim hMem As Long
  hMem = GlobalAlloc(GMEM_FIXED, lngSize)
  If hMem = 0 Then
    MsgBox "error to malloc"
    FCIMalloc = 0
    Exit Function
  End If
  FCIMalloc = hMem
  End Function
 
Public Function FCIMemFree(ByVal lngMemory As Long) As Long
  If lngMemory Then
  FCIMemFree = GlobalFree(lngMemory)
  End If
  End Function
 
Public Function FCIRead(ByVal hf As Integer, ByVal hMemory As Long, ByVal lngSize As Long, ByVal ErrNo As Integer, ByVal pv As Long) As Long
  Dim result As Long
  result = lread(hf, hMemory, lngSize)
  If result <> lngSize Then
    MsgBox "error to _read"
    Exit Function
  End If
  FCIRead = result
  End Function
 
Public Function FCIWrite(ByVal hf As Integer, ByVal hMemory As Long, ByVal lngSize As Long, ByVal ErrNo As Integer, ByVal pv As Long) As Long
  Dim result As Long
  result = lwrite(hf, hMemory, lngSize)
  If result <> lngSize Then
    MsgBox "error to _write"
    Exit Function
  End If
  FCIWrite = result
  End Function
 
Public Function FCIClose(ByVal hf As Integer, ByVal ErrNo As Integer, ByVal pv As Long) As Long
  Dim result As Long
  result = lclose(hf)
  If result <> 0 Then
    MsgBox "error to _read"
    Exit Function
  End If
  FCIClose = result
  End Function
 
Public Function FCISeek(ByVal hf As Integer, ByVal dist As Long, ByVal seektype As Long, ByVal ErrNo As Integer, ByVal pv As Long) As Long
  Dim result As Long
  '''result = LSeek(hf, dist, seektype)
  If result = -1 Then
    MsgBox "error to _lseek"
    Exit Function
  End If
  FCISeek = result
  End Function
 
Public Function FCIDelete(ByVal pszfile As String, ByVal ErrNo As Integer, ByVal pv As Long) As Long
  Dim result As Long
  result = DeleteFile(pszfile)
  If result <> 0 Then
    MsgBox "error to remove"
    Exit Function
  End If
  FCIDelete = result
  End Function
 
Public Function FCIFilePlaced(pccab As Ccab, ByVal pszfile As String, ByVal FileSize As Long, fContinuation As Boolean, pv As Long) As Integer
  FCIFilePlaced = 0
  End Function
 
Public Function FCIGetTmpFile(ByVal pszTempName As Long, ByVal cbTempName As Long) As Boolean
  Dim result As Long
  Dim strTmp As String * 256
  strTmp = String$(256, Chr(0))
  'result = GetTempFileName("c:\", "xx", 0, strTmp)
  'strTmp = Left$(strTmp, InStr(strTmp, Chr(0)) - 1)
  'strTmp = Left$(strTmp, InStr(strTmp, Chr(32)) - 1)
  FCIGetTmpFile = (GetTempPath(Len(strTmp), strTmp) <> 0) And (GetTempFileName(strTmp, "cab", 0, pszTempName) <> 0)
  End Function
 
Public Function FCIOpen(ByVal pszfile As String, ByVal oFlag As Long, ByVal pMode As Long, ByVal ErrNo As Integer, ByVal pv As Long) As Integer
  Dim Style                          As Long
  Dim os                             As OFSTRUCT
  If (oFlag And O_CREAT) <> 0 Then
    Style = OF_CREATE
  Else
    Select Case (oFlag And 3)
    Case 0: Style = OF_READ
    Case 1: Style = OF_WRITE
    Case Else: Style = OF_READWRITE
    End Select
  End If
  If (oFlag And O_EXCL) <> 0 Then Style = Style Or OF_SHARE_EXCLUSIVE
  FCIOpen = OpenFile(pszfile, os, Style)
 
  End Function
 
Public Function FCIGetOpenInfo(ByVal pszName As String, pdate As Long, ptime As Long, pAttribs As Long, ByVal ErrNo As Integer, pv As Long) As Long
  Dim os                             As OFSTRUCT
  FCIGetOpenInfo = OpenFile(pszName, os, OF_READ)
  End Function
 
Public Function FCIStatus(ByVal typeStatus As Integer, ByVal cb1 As Long, ByVal cb2 As Long, ByVal pv As Long) As Boolean
  End Function
 
Public Function FCIGetNextCabinet(pccab As Ccab, cbPrevCab As Long, pv As Long) As Boolean
  End Function
 
Public Function CabinetAddFiles(strCabinet As String)
 
  Dim i                              As Integer
  Dim fci                            As Long
  Dim erf                            As ErrorRF
  Dim cab                            As Ccab
  Dim hMem                           As Long
  Dim LibHandle                      As Long
 
  Dim pfnFCICreate                   As Long
  Dim pfnFCIAddFile                  As Long
  Dim pfnFCIFlushCabinet             As Long
  Dim pfnFCIFlushFolder              As Long
  Dim pfnFCIDestroy                  As Long
 
  LibHandle = LoadLibrary("CABINET.DLL")
  If LibHandle = 0 Then
    MsgBox "Error load CABINET.DLL"
    Exit Function
  End If
 
  pfnFCICreate = GetProcAddress(LibHandle, "FCICreate")
  pfnFCIAddFile = GetProcAddress(LibHandle, "FCIAddFile")
  pfnFCIFlushCabinet = GetProcAddress(LibHandle, "FCIFlushCabinet")
  pfnFCIFlushFolder = GetProcAddress(LibHandle, "FCIFlushFolder")
  pfnFCIDestroy = GetProcAddress(LibHandle, "FCIDestroy")
  
  If pfnFCICreate = 0 Or _
     pfnFCIAddFile = 0 Or _
     pfnFCIFlushCabinet = 0 Or _
     pfnFCIFlushFolder = 0 Or _
     pfnFCIDestroy = 0 Then
    MsgBox "Error load CABINET.DLL"
    Exit Function
  End If
 
  'hMem = GlobalAlloc(GMEM_FIXED, Len(cab))
  With cab
    .cbReserveCFHeader = 0
    .cbReserveCFFolder = 0
    .cbReserveCFData = 0
    .cb = &H1000000
    .cbFolderThresh = 900000
    .cbReserveCFHeader = 0
    .cbReserveCFFolder = 0
    .cbReserveCFData = 0
    .iCab = 1
    .iDisk = 0
    .setID = 12345
    lstrcpy .szDisk, "MyDisk"
    lstrcpy .szCabPath, "c:\"
    lstrcpy .szCab, "my.cab"
  End With
  
  'CopyMemory hMem, cab, Len(cab)
  
  fci = FCICreate(erf, AddressOf FCIFilePlaced, AddressOf FCIMalloc, AddressOf FCIMemFree, AddressOf FCIOpen, AddressOf FCIRead, AddressOf FCIWrite, AddressOf FCIClose, AddressOf FCISeek, AddressOf FCIDelete, AddressOf FCIGetTmpFile, cab, 0&)
  
  If fci = -1 Then
    MsgBox "error to FCICREATE"
    Exit Function
  End If
  
  End Function

Мда. Уже допер как надо делать, уже половину деклараций накатал и несколько CallBack функций реализовал (FCIFilePlaced, FCIALLOC, FСIFreeMem), а тут вон что . БОльше помощь по этому пункту не нужна?

По первому пункту цепляю рабочий код. Есть у него недостатки, к примеру в ФАРе я создал папку - пример это не словил, а вот удаление из фара поймал... С эксплорером никаких проблем, ловит создание удаление. Принтеры ловит.
Прикреплённый файлNotifycation.zip (18.69 Кбайт, скачиваний: 139)

Цитата Vasya2000 @ 29.11.04, 02:19

Мда. Уже допер как надо делать, уже половину деклараций накатал и несколько CallBack функций реализовал (FCIFilePlaced, FCIALLOC, FСIFreeMem), а тут вон что . БОльше помощь по этому пункту не нужна?

Нужна.
Этот не рабочий код.
Если вызвать допустим AddCabinetFile то рушится вся среда разом.
И вроде ничего не помогает

AddCabinetFile ? в Твоем примере этой функции нет. Если ты имеешь в виду FCIAddFile, то для нее нужны каллбэк-функции: PFNFCIGETNEXTCABINET, PFNFCISTATUS, PFNFCIGETOPENINFO и структура TCOMP, которая хрен победишь как должна выглядеть.

Добавлено 29.11.04, 09:32
Или эта структура может выглядеть просто как

tcompTYPE_MSZIP         = $0001;

??

Кстати, SCINER, я это делаю не из-за дгм!

Гм... а как "решён" вопрос с мониторингом?