I finally wrote a module for reading CAB archives today. With this module, you can read the list of files inside the CAB archives and which file takes up how many bytes. I did not add the date and time of the files, since I did not need it, but it is very easy to do it myself by slightly redesigning the module and the custom UDT array to get the file list data.
This is a very simple implementation, I tried to make as few lines of code as possible so that there would be. In fact, unpacking a CAB archive is generally done with just one line of code. To do this, you need to access the undocumented, but very useful, ExtractFiles function from the library advpack.dll which is available in all Windows.
Now you know how to get a list of files from the CAB archive and how to unpack the CAB archive with the program-code on VB6. However, the packaging feature is not implemented here, since this is a very complex code using the FCICreate function from the library cabinet.dll I was looking for a ready-made version of such code on the Internet, but I didn't find it for vb6, so I haven't written the packaging yet.
Yes, and I almost forgot the code of the module itself here:
Code:
Option Explicit
'////////////////////////////////////////////
'// A module for reading CAB archives //
'// Copyright (c) 11.11.2024 by HackerVlad //
'// e-mail: vladislavpeshkov@yandex.ru //
'// Version 1.0 //
'////////////////////////////////////////////
Private Declare Function SetupIterateCabinet Lib "setupapi" Alias "SetupIterateCabinetA" (ByVal CabinetFile As String, ByVal Reserved As Long, ByVal MsgHandler As Long, ByVal Context As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, ByVal Source As Long, ByVal Length As Long)
Private Const MAXPATH = 260
Private Const NO_ERROR = 0
'
' Notification messages, handled in the callback
' procedure. This class doesn't handle them all.
'
Private Const SPFILENOTIFY_FILEINCABINET = &H11
Private Const SPFILENOTIFY_NEEDNEWCABINET = &H12
Private Const SPFILENOTIFY_FILEEXTRACTED = &H13
Private Const sicList = 568
Private Const sicCount = 569
Dim mstrFileToExtract As String
Dim mstrOutputPath As String
Dim mstrOutputFile As String
Dim mlngCount As Long
Dim mlngcnt As Long
Dim arrListFilesCab() As CabInfo
Public Type CabInfo
cabFileName As String
cabFileSize As Long
End Type
Private Type FileInCabinetInfo
NameInCabinet As Long
FileSize As Long
Win32Error As Long
DosDate As Integer
DosTime As Integer
DosAttribs As Integer
FullTargetName(0 To MAXPATH - 1) As Byte
End Type
Private Enum FILEOP
FILEOP_ABORT = 0
FILEOP_DOIT = 1
FILEOP_SKIP = 2
End Enum
Private Function CabinetCallback(ByVal Context As Long, ByVal Notification As Long, ByRef Param1 As FileInCabinetInfo, ByVal Param2 As Long) As Long
Select Case Notification
Case SPFILENOTIFY_NEEDNEWCABINET
CabinetCallback = NO_ERROR
Case SPFILENOTIFY_FILEINCABINET
Select Case Context
Case sicCount
mlngCount = mlngCount + 1
CabinetCallback = FILEOP_SKIP
Case sicList
' Add a position to the UDT array
ReDim Preserve arrListFilesCab(mlngcnt)
arrListFilesCab(mlngcnt).cabFileName = fStringFromPointer(Param1.NameInCabinet)
arrListFilesCab(mlngcnt).cabFileSize = Param1.FileSize
mlngcnt = mlngcnt + 1
CabinetCallback = FILEOP_SKIP ' Go through the list of files further
End Select
End Select
End Function
Private Function fStringFromPointer(ByVal ptr As Long) As String
Dim lngLen As Long
Dim strBuffer As String
'
' Given a string pointer, copy the value
' of the string into a new, safe location.
'
lngLen = lstrlen(ptr)
strBuffer = Space$(lngLen)
CopyMemory ByVal strBuffer, ptr, lngLen
fStringFromPointer = strBuffer
End Function
' Get a list of files inside the CAB archive
Public Function GetFilesListInCab(ByVal FileName As String, arrCabInfo() As CabInfo) As Long
mlngcnt = 0
If SetupIterateCabinet(FileName, 0, AddressOf CabinetCallback, sicList) Then
arrCabInfo = arrListFilesCab
GetFilesListInCab = mlngcnt
Erase arrListFilesCab
End If
End Function
' Find out the count of files inside the CAB archive
Public Function GetFilesCountInCab(ByVal FileName As String) As Long
mlngCount = 0
If SetupIterateCabinet(FileName, 0, AddressOf CabinetCallback, sicCount) Then
GetFilesCountInCab = mlngCount
End If
End Function
Today, testuser2 has slightly modified this module to support Unicode and 64-bit platforms. However, in order for this code to work in VB6, you will have to delete all the words "PtrSafe".
Code:
Option Explicit
'////////////////////////////////////////////
'// ?????? ??? ?????? CAB-??????? //
'// Copyright (c) 11.11.2024 by HackerVlad //
'// e-mail: vladislavpeshkov@yandex.ru //
'// Testuser2 ??????? ????????? x64 //
'// ?????? 1.1 //
'////////////////////////////////////////////
Private Declare PtrSafe Function SetupIterateCabinet Lib "setupapi" Alias "SetupIterateCabinetW" ( _
ByVal CabinetFile As LongPtr, _
ByVal Reserved As Long, _
ByVal MsgHandler As LongPtr, _
ByVal Context As LongPtr) As Long
'WINSETUPAPI BOOL SetupIterateCabinetW(
' [in] PCWSTR CabinetFile,
' [in] DWORD Reserved,
' [in] PSP_FILE_CALLBACK_W MsgHandler,
' [in] PVOID Context
');
Private Declare PtrSafe Function lstrlenW Lib "kernel32" (ByVal lpString As LongPtr) As Long
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
Private Const MAXPATH = 260
Private Const NO_ERROR = 0
'
' Notification messages, handled in the callback
' procedure. This class doesn't handle them all.
'
Private Const SPFILENOTIFY_FILEINCABINET = &H11
Private Const SPFILENOTIFY_NEEDNEWCABINET = &H12
Private Const SPFILENOTIFY_FILEEXTRACTED = &H13
Private Const sicList = 568
Private Const sicCount = 569
Private Type CabInfo
cabFileName As String
cabFileSize As Long
End Type
Private Type FileInCabinetInfo '_FILE_IN_CABINET_INFO_W
NameInCabinet As LongPtr ' PCWSTR
FileSize As Long ' DWORD
Win32Error As Long ' DWORD
DosDate As Integer ' WORD
DosTime As Integer ' WORD
DosAttribs As Integer ' WORD
FullTargetName(MAXPATH - 1) As Byte ' WCHAR
End Type
Private Enum FILEOP
FILEOP_ABORT = 0
FILEOP_DOIT = 1
FILEOP_SKIP = 2
End Enum
Private mstrFileToExtract As String
Private mstrOutputPath As String
Private mstrOutputFile As String
Private mlngCount As Long
Private arrListFilesCab() As CabInfo
'UINT PspFileCallbackW(PVOID Context, UINT Notification, UINT_PTR Param1, UINT_PTR Param2)
Private Function CabinetCallback(ByVal Context As LongPtr, ByVal Notification As Long, ByRef Param1 As FileInCabinetInfo, ByVal Param2 As LongPtr) As Long
Select Case Notification
Case SPFILENOTIFY_NEEDNEWCABINET
CabinetCallback = NO_ERROR
Case SPFILENOTIFY_FILEINCABINET
Select Case Context
Case sicCount
mlngCount = mlngCount + 1
CabinetCallback = FILEOP_SKIP
Case sicList
' ???????? ??????? ? ?????? UDT
ReDim Preserve arrListFilesCab(mlngCount)
arrListFilesCab(mlngCount).cabFileName = fStringFromPointer(Param1.NameInCabinet)
arrListFilesCab(mlngCount).cabFileSize = Param1.FileSize
mlngCount = mlngCount + 1
CabinetCallback = FILEOP_SKIP ' ?????????? ?????? ?????? ??????
End Select
End Select
End Function
Private Function fStringFromPointer(ByVal ptr As LongPtr) As String
Dim lngLen As Long
' Given a string pointer, copy the value of the string into a new, safe location.
lngLen = lstrlenW(ptr)
fStringFromPointer = Space$(lngLen)
CopyMemory ByVal StrPtr(fStringFromPointer), ByVal ptr, lngLen * 2
End Function
' ???????? ?????? ?????? ?????? ?????? CAB
Public Function GetFilesListInCab(ByRef FileName As String, arrCabInfo() As CabInfo) As Long
mlngCount = 0
If SetupIterateCabinet(StrPtr(FileName), 0, AddressOf CabinetCallback, sicList) Then
arrCabInfo = arrListFilesCab
GetFilesListInCab = mlngCount
Erase arrListFilesCab
End If
End Function
' ?????? ?????????? ?????? ?????? ?????? CAB
Public Function GetFilesCountInCab(ByRef FileName As String) As Long
mlngCount = 0
If SetupIterateCabinet(StrPtr(FileName), 0&, AddressOf CabinetCallback, sicCount) Then
GetFilesCountInCab = mlngCount
End If
End Function
What nonsense is this!? You can see the full source code in front of your eyes, which is 100% free of any virus! Is your antivirus blatantly lying to you and do you believe it? This is a false detect.
I don't see it, but antiviruses do.
People aren't going to use something like that.
You do realize it's impossible to produce an unsigned VB6 app that doesn't trigger false positives in at least 2-3 of the engines on VirusTotal, right?
I don't see it, but antiviruses do.
People aren't going to use something like that.
Of course they are going to use it. Anyone who has a basic understanding of how A/V tools flag up unknown binaries (or even unknown source code) as false positives and who has the source in front of them (and an understanding of the code is doing) is going to be completely confident.
IF you don't know this stuff then you MUST investigate deeper yourself.
Skillset: VMS,DOS,Windows Sysadmin from 1985, fault-tolerance, VaxCluster, Alpha,Sparc. DCL,QB,VBDOS- VB6,.NET, PHP,NODE.JS, Graphic Design, Project Manager, CMS, Quad Electronics. classic cars & m'bikes. Artist in water & oils. Historian.
By the power invested in me, all the threads I start are battle free zones - no arguing about the benefits of VB6 over .NET here please. Happiness must reign.
Wow cool code works perfect. you just need a way to make the cabs now. can make an achiver then be cool. I remmber using a program to create and read cabs years ago called Cab2000 i think but was a trial. thanks for this code.
Wow cool code works perfect. you just need a way to make the cabs now. can make an achiver then be cool. I remmber using a program to create and read cabs years ago called Cab2000 i think but was a trial. thanks for this code.
Yes, you can write your own CAB archiver, but there is very complex code for packing files, so I haven't written it yet. There is simply no such code anywhere on the Internet for Visual Basic 6 and not even for VB.Net . Therefore, you will have to rewrite from other languages (Delphi, C++).
Yes, you can write your own CAB archiver, but there is very complex code for packing files, so I haven't written it yet. There is simply no such code anywhere on the Internet for Visual Basic 6 and not even for VB.Net . Therefore, you will have to rewrite from other languages (Delphi, C++).
True but I did find makecab in windows after reading your code I was thinking of makeing a shell for it, and maybe using your code for reading the cabs if that is ok, I did see some cab stuff in delphi cos I thought I have a quick look around the net I used to use delphi I may have a look at that to. anyway keep up the good work.
True but I did find makecab in windows after reading your code I was thinking of makeing a shell for it, and maybe using your code for reading the cabs if that is ok, I did see some cab stuff in delphi cos I thought I have a quick look around the net I used to use delphi I may have a look at that to. anyway keep up the good work.
Yes, I'm already working on rewriting the code from Delphi. But I face difficulties in understanding the data types of variables. There is a lot to know (ULONG, UINT, Integer, USHORT, AnsiChar and so on)...
Last edited by HackerVlad; Nov 12th, 2024 at 05:30 PM.
Yes, I'm already working on rewriting the Delphi code. So you'd better just wait for me to do the CAB packaging in VB6 myself. However, it should be understood that the packaging functions are very complex and use the CDecl convention.
I had to manage some cabs a few years ago... I started by wasting my time with some c++ code that was too strong for me found on codeproject, https://www.codeproject.com/Articles...and-Extraction
then I found my happiness in c# on stackoverflow that I converted quite easily to vb.net (my final goal in vb.net) https://stackoverflow.com/questions/...file-in-memory
(see post by Mr. Simon Mourier) it must be quite easly to adapt to vb6 for the experts here
I should be able to find my code from that time, but it's vb.net, sorry for that
NB My goal was quite specific, to read into memory (without extracting the entire cab into a directory) the beginning of a file (whose name was known) in a funny *.xsn extension cab... and that quickly...
Wow cool code works perfect. you just need a way to make the cabs now. can make an achiver then be cool. I remmber using a program to create and read cabs years ago called Cab2000 i think but was a trial. thanks for this code.
Now we also have the code for packing files (creating cabinets). I've mastered this very complex code after all. In TwinBasic, this code will work without any dependencies, But in order for this code to work in VB6, you will have to download an add-in (a plugin for the VB6 environment) for CDecl functions to work.
The most important thing is that now we have a code for packing and unpacking cabinets. Now you can safely write a program similar to Cab2000 yourself. You can call it Cab2025 or even Cab3000
You don't really need that Add-in for VB6, "DispCallFunc" can call Cdecl functions if you want to be free of any external dependencies!
Thanks for telling me, I've thought about it too, but it's difficult for me. I do not know how to do this. Write me an example of such code.
Even if you can call the API, then what about the custom CDecl functions? You will notice the many callback functions in my module - they are all CDecl.
Although the dependence on this Add-in for vb6 does not bother me much, since now all people are switching to Twin Basic, and there are no dependencies there already.
Last edited by HackerVlad; Nov 22nd, 2024 at 09:35 AM.
Reply With Quote
Originally Posted by yokesee
