Printable View
Hi r33d3r,
I've been desperately searching for something to have 1 file which sort of acts like a folder but is encoded or just not easy to access..
I've heard of there terms ".CAB files" and ".PK3 files" PK3 is from PakScape which works just fine for me but then.. how can I access these files?
Not too difficult.
VB Code:
Euh? That looks to simple, could you explain what it does ;)Quote:
Originally Posted by dglienna
Easy, if you know where to look, like most other things.
Quote:
Microsoft (R) File Expansion Utility Version 5.1.2600.0
Copyright (C) Microsoft Corp 1990-1999. All rights reserved.
Expands one or more compressed files.
EXPAND [-r] Source Destination
EXPAND -r Source [Destination]
EXPAND -D Source.cab [-F:Files]
EXPAND Source.cab -F:Files Destination
-r Rename expanded files.
-D Display list of files in source.
Source Source file specification. Wildcards may be used.
-F:Files Name of files to expand from a .CAB.
Destination Destination file | path specification.
Destination may be a directory.
If Source is multiple files and -r is not specified,
Destination must be a directory.
Microsoft (R) Cabinet Maker - Version 5.1.2600.2180
Copyright (c) Microsoft Corporation. All rights reserved..
MAKECAB [/V[n]] [/D var=value ...] [/L dir] source [destination]
MAKECAB [/V[n]] [/D var=value ...] /F directive_file [...]
source File to compress.
destination File name to give compressed file. If omitted, the
last character of the source file name is replaced
with an underscore (_) and used as the destination.
/F directives A file with MakeCAB directives (may be repeated).
/D var=value Defines variable with specified value.
/L dir Location to place destination (default is current directory).
/V[n] Verbosity level (1..3).
This still doesn't explains how to open a CAB file in VB6 :( and how to read the files within them...
:rolleyes:
Retry,
I have this .CAB file right? I want to read it from a VB6 app. but I don't want the user to see it on his disk extracted (that's what I did before with a .ZIP file :P) I know it can be done but I really can find it anywhere how to..
You can display a list of the files, and pipe them into a text file, which you can open in vb, or you can extract individual files from a cab file from within vb, and then delete them. They will still be in the cab file for the next time. You can rename them to whatever you like, and still open them from within your app.
You can use my module.Quote:
Originally Posted by paddoswam
https://www.vbforums.com/showthread....g-CAB-archives
Code:Option Explicit
'////////////////////////////////////////////////////////////////////
'// Module for reading and unpacking CAB archives //
'// Copyright (c) 2025-02-20 by HackerVlad //
'// e-mail: [email protected] //
'// Version 2.5 (32 and 64-bit compatible) & Windows 98 compatible //
'////////////////////////////////////////////////////////////////////
' API declarations ...
#If VBA7 = 0 Then
Private Declare Function SetupIterateCabinetW Lib "setupapi" (ByVal CabinetFile As Long, ByVal Reserved As Long, ByVal MsgHandler As Long, ByVal Context As Long) As Long
Private Declare Function SetupIterateCabinetA Lib "setupapi" (ByVal CabinetFile As String, ByVal Reserved As Long, ByVal MsgHandler As Long, ByVal Context As Long) As Long
Private Declare Function PathRemoveFileSpecW Lib "shlwapi" (ByVal pszPath As Long) As Long
Private Declare Function SHCreateDirectory Lib "shell32" (ByVal hwnd As Long, ByVal pszPath As Long) As Long
Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp" (ByVal lpPath As String) As Long ' For old versions of Windows
Private Declare Function SysReAllocString Lib "oleaut32" (ByVal pBSTR As Long, ByVal psz As Long) As Long
Private Declare Sub SysFreeString Lib "oleaut32" (ByVal bstr As Long)
Private Declare Function GetFileAttributesEx Lib "kernel32" Alias "GetFileAttributesExW" (ByVal lpFileName As Long, ByVal fInfoLevelId As Long, ByRef lpFileInformation As Any) As Long
Private Declare Function lstrlenA Lib "kernel32" (ByVal lpString As Long) As Long
Private Declare Function SetFileAttributesW Lib "kernel32" (ByVal lpFileName As Long, ByVal dwFileAttributes As Long) As Long
Private Declare Function SetFileAttributesA Lib "kernel32" (ByVal lpFileName As Long, ByVal dwFileAttributes As Long) As Long
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Sub ZeroMemory Lib "kernel32" Alias "RtlZeroMemory" (Destination As Any, ByVal Length As Long)
Private Enum LongPtr
[_]
End Enum
#Else
Private Declare PtrSafe Function SetupIterateCabinetW Lib "setupapi" (ByVal CabinetFile As LongPtr, ByVal Reserved As Long, ByVal MsgHandler As LongPtr, ByVal Context As Long) As Long
Private Declare PtrSafe Function SetupIterateCabinetA Lib "setupapi" (ByVal CabinetFile As String, ByVal Reserved As Long, ByVal MsgHandler As LongPtr, ByVal Context As Long) As Long
Private Declare PtrSafe Function PathRemoveFileSpecW Lib "shlwapi" (ByVal pszPath As LongPtr) As Long
Private Declare PtrSafe Function SHCreateDirectory Lib "shell32" (ByVal hwnd As Long, ByVal pszPath As LongPtr) As Long
Private Declare PtrSafe Function MakeSureDirectoryPathExists Lib "imagehlp" (ByVal lpPath As String) As Long ' For old versions of Windows
Private Declare PtrSafe Function SysReAllocString Lib "oleaut32" (ByVal pBSTR As LongPtr, ByVal psz As LongPtr) As Long
Private Declare PtrSafe Sub SysFreeString Lib "oleaut32" (ByVal bstr As LongPtr)
Private Declare PtrSafe Function GetFileAttributesEx Lib "kernel32" Alias "GetFileAttributesExW" (ByVal lpFileName As LongPtr, ByVal fInfoLevelId As Long, ByRef lpFileInformation As Any) As Long
Private Declare PtrSafe Function lstrlenA Lib "kernel32" (ByVal lpString As LongPtr) As Long
Private Declare PtrSafe Function SetFileAttributesW Lib "kernel32" (ByVal lpFileName As LongPtr, ByVal dwFileAttributes As Long) As Long
Private Declare PtrSafe Function SetFileAttributesA Lib "kernel32" (ByVal lpFileName As String, ByVal dwFileAttributes As Long) As Long
Private Declare PtrSafe Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As Any) As Long
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare PtrSafe Sub ZeroMemory Lib "kernel32" Alias "RtlZeroMemory" (Destination As Any, ByVal Length As Long)
#End If
' Constants ...
Private Const MAXPATH = 260
Private Const FILEOP_DOIT = 1
Private Const FILEOP_SKIP = 2
Private Const SPFILENOTIFY_FILEINCABINET = &H11
Private Const SPFILENOTIFY_FILEEXTRACTED = &H13
Private Const GetFileExInfoStandard As Long = 0
' Own fictional constants ...
Private Const sicList = 568
Private Const sicCount = 569
Private Const sicExtract = 570
' Variables for temporary data storage ...
Dim CountFilesSuccessfullyExtracted As Long, SetAttribsFile As Long, lngCount As Long
Dim strFileToExtract As String, strOutputPath As String
Dim arrFilesToExtract() As String
Dim arrListFilesCab() As CabInfo
Dim IsFilesList As Boolean, WinANSI As Boolean
' Structures ...
Public Type CabInfo
cabFileName As String
cabFileSize As Long
cabDosDate As Integer
cabDosTime As Integer
cabDosAttribs As Integer
End Type
Private Type FileInCabinetInfoW
NameInCabinet As LongPtr
FileSize As Long
Win32Error As Long
DosDate As Integer
DosTime As Integer
DosAttribs As Integer
FullTargetName(MAXPATH - 1) As Integer ' WCHAR FullTargetName[MAX_PATH];
End Type
Private Type FILEPATHS
Target As LongPtr
Source As LongPtr
Win32Error As Integer
Flags As Long
End Type
Private Type WIN32_FILE_ATTRIBUTE_DATA
dwFileAttributes As Long
ftCreationTime As Currency
ftLastAccessTime As Currency
ftLastWriteTime As Currency
nFileSizeHigh As Long
nFileSizeLow As Long
End Type
' Does the directory exist (IsDir)
Public Function cabIsDir(ByVal path As String) As Boolean
Dim tAttr As WIN32_FILE_ATTRIBUTE_DATA
If GetFileAttributesEx(StrPtr(path), GetFileExInfoStandard, tAttr) <> 0 Then
If (tAttr.dwFileAttributes And vbDirectory) <> 0 Then
cabIsDir = True
End If
Else ' ANSI
On Error Resume Next
If Dir(path, vbDirectory + 7) <> vbNullString Then
If (GetAttr(path) And vbDirectory) <> 0 Then cabIsDir = True
End If
End If
End Function
' Convert the full file path to the folder path (always returns "\" at the end)
Public Function cabExtractFilePath(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 & "\"
cabExtractFilePath = pszPath
Else
cabExtractFilePath = FileName
End If
End Function
' Create multiple folders at once, for all versions of Windows (always requires a "\" at the end for systems less than WinXP)
Public Function MakeDir(ByVal path As String) As Boolean
Dim inf(36) As Long
Dim IsXPAndLater As Boolean
inf(0) = 148: GetVersionEx inf(0): IsXPAndLater = inf(4) = 2 And inf(1) >= 5 And inf(2) >= 1 ' Get the Windows version
If IsXPAndLater = True Then
If SHCreateDirectory(0, StrPtr(path)) = 0 Then MakeDir = True
Else
If MakeSureDirectoryPathExists(path) = 1 Then MakeDir = True
End If
End Function
Private Function CabinetCallback(ByVal Context As Long, ByVal Notification As Long, Param1 As FileInCabinetInfoW, ByVal Param2 As Long) As Long
If Notification = SPFILENOTIFY_FILEINCABINET Then
Dim FileNameInCab As String
Dim bytesLen As Long
Select Case Context
Case sicCount
lngCount = lngCount + 1
CabinetCallback = FILEOP_SKIP ' Skip the file and go through the list of files next
Case sicList
If WinANSI = False Then
SysReAllocString VarPtr(FileNameInCab), Param1.NameInCabinet
Else
bytesLen = lstrlenA(Param1.NameInCabinet)
FileNameInCab = Space$(bytesLen)
CopyMemory ByVal FileNameInCab, ByVal Param1.NameInCabinet, bytesLen + 1 ' Converts to Unicode using an implicit (hidden) conversion
End If
' Add a position to the UDT array
ReDim Preserve arrListFilesCab(lngCount)
arrListFilesCab(lngCount).cabFileName = FileNameInCab
arrListFilesCab(lngCount).cabFileSize = Param1.FileSize
arrListFilesCab(lngCount).cabDosDate = Param1.DosDate
arrListFilesCab(lngCount).cabDosTime = Param1.DosTime
arrListFilesCab(lngCount).cabDosAttribs = Param1.DosAttribs
lngCount = lngCount + 1
CabinetCallback = FILEOP_SKIP ' Skip the file and go through the list of files next
If WinANSI = False Then SysFreeString StrPtr(FileNameInCab)
Case sicExtract
Dim FileName As String, FilePath As String, FillFileName As String
Dim i As Long
If WinANSI = False Then
SysReAllocString VarPtr(FileNameInCab), Param1.NameInCabinet
Else
bytesLen = lstrlenA(Param1.NameInCabinet)
FileNameInCab = Space$(bytesLen)
CopyMemory ByVal FileNameInCab, ByVal Param1.NameInCabinet, bytesLen + 1 ' Converts to Unicode using an implicit (hidden) conversion
End If
FileName = strOutputPath & "\" & FileNameInCab
' We fill in the value of the structure with the filename of the extracted file (+1 character at the end of the line is vbNullChar)
If Not WinANSI Then FillFileName = FileName Else FillFileName = StrConv(FileName, vbFromUnicode) ' Convert to ANSI
If Not WinANSI Then ZeroMemory Param1.FullTargetName(0), 520 Else ZeroMemory Param1.FullTargetName(0), 260
CopyMemory Param1.FullTargetName(0), ByVal StrPtr(FillFileName), LenB(FillFileName) + 1
If IsFilesList = False Then
If strFileToExtract = FileNameInCab Or Len(strFileToExtract) = 0 Then
FilePath = cabExtractFilePath(FileName)
If cabIsDir(FilePath) = False Then MakeDir FilePath
SetAttribsFile = Param1.DosAttribs ' Remember the attributes
CabinetCallback = FILEOP_DOIT ' Extract the file
CountFilesSuccessfullyExtracted = CountFilesSuccessfullyExtracted + 1
Else
CabinetCallback = FILEOP_SKIP ' Skip the file and go through the list of files next
End If
Else
Dim ExtractCurrentFile As Boolean
For i = 0 To UBound(arrFilesToExtract)
If arrFilesToExtract(i) = FileNameInCab Then
ExtractCurrentFile = True
Exit For
End If
Next
If ExtractCurrentFile = True Then
FilePath = cabExtractFilePath(FileName)
If cabIsDir(FilePath) = False Then MakeDir FilePath
SetAttribsFile = Param1.DosAttribs ' Remember the attributes
CabinetCallback = FILEOP_DOIT ' Extract the file
CountFilesSuccessfullyExtracted = CountFilesSuccessfullyExtracted + 1
Else
CabinetCallback = FILEOP_SKIP ' Skip the file and go through the list of files next
End If
End If
If WinANSI = False Then SysFreeString StrPtr(FileNameInCab)
End Select
ElseIf Notification = SPFILENOTIFY_FILEEXTRACTED Then
Dim fp As FILEPATHS
LSet fp = Param1
If fp.Win32Error = 0 Then ' If the file has been successfully extracted from the archive
' Manually set the attributes of the extracted file yourself,
' as Microsoft kindly refused to do this in the SetupIterateCabinet function
If SetFileAttributesW(fp.Target, SetAttribsFile) = 0 Then
SetFileAttributesA fp.Target, SetAttribsFile
End If
End If
End If
End Function
' Get a list of files inside the CAB archive
Public Function GetFilesListInCab(ByVal cabFileName As String, arrCabInfo() As CabInfo) As Long
lngCount = 0
WinANSI = False
If SetupIterateCabinetW(StrPtr(cabFileName), 0, AddressOf CabinetCallback, sicList) Then
arrCabInfo = arrListFilesCab
GetFilesListInCab = lngCount
Erase arrListFilesCab
Else
WinANSI = True
If SetupIterateCabinetA(cabFileName, 0, AddressOf CabinetCallback, sicList) Then
arrCabInfo = arrListFilesCab
GetFilesListInCab = lngCount
Erase arrListFilesCab
End If
End If
End Function
' Get count of files inside the CAB archive
Public Function GetFilesCountInCab(ByVal cabFileName As String) As Long
lngCount = 0
If SetupIterateCabinetW(StrPtr(cabFileName), 0, AddressOf CabinetCallback, sicCount) Then
GetFilesCountInCab = lngCount
Else
If SetupIterateCabinetA(cabFileName, 0, AddressOf CabinetCallback, sicCount) Then GetFilesCountInCab = lngCount
End If
End Function
' Extract files from the CAB archive
' Extracting archives compressed using MSZIP works in Windows 95+
' Extracting archives compressed using LZX21 works in Windows Me+
' FileList - an extracted file from an archive (string) if there is one file, or an array of strings if there are several files to extract
' If the FileList parameter is omitted, all files from the archive will be extracted
Public Function ExtractFilesInCab(ByVal cabFileName As String, ByVal ExpandDir As String, Optional FileList As Variant) As Boolean
If Len(cabFileName) > 0 And Len(ExpandDir) > 0 Then
If Right$(ExpandDir, 1) = "\" Then
strOutputPath = Mid$(ExpandDir, 1, Len(ExpandDir) - 1)
Else
strOutputPath = ExpandDir
End If
If cabIsDir(strOutputPath) = False Then
If MakeDir(strOutputPath) = False Then Exit Function
End If
If VarType(FileList) = vbString Then
strFileToExtract = FileList
ElseIf VarType(FileList) = vbArray + vbString Then ' If it is an array of strings
strFileToExtract = ""
arrFilesToExtract = FileList
IsFilesList = True
Else
strFileToExtract = ""
End If
CountFilesSuccessfullyExtracted = 0
WinANSI = False
If SetupIterateCabinetW(StrPtr(cabFileName), 0, AddressOf CabinetCallback, sicExtract) Then
If IsFilesList = False Then
If CountFilesSuccessfullyExtracted = 1 Or Len(strFileToExtract) = 0 Then ExtractFilesInCab = True
Else
If CountFilesSuccessfullyExtracted = UBound(arrFilesToExtract) + 1 Then ExtractFilesInCab = True
End If
Else
WinANSI = True
If SetupIterateCabinetA(cabFileName, 0, AddressOf CabinetCallback, sicExtract) Then
If IsFilesList = False Then
If CountFilesSuccessfullyExtracted = 1 Or Len(strFileToExtract) = 0 Then ExtractFilesInCab = True
Else
If CountFilesSuccessfullyExtracted = UBound(arrFilesToExtract) + 1 Then ExtractFilesInCab = True
End If
End If
End If
If IsFilesList = True Then
IsFilesList = False
Erase arrFilesToExtract
End If
End If
End Function