如何读取.CAB文件中的内容,提前问题者有分！ (200分)

通过程序读取.CAB文件*(或其它压缩文件)中的内容,最好有示例解释.
如果答案满意的话再开贴给分！
EMAILiwin_yy@hotmail.com

用控件，不如压缩的ZIP格式就有

1、
如何使用Cabinet.dll创建你自己的cab文件
http://www.delphibyte.com/article/viewart.php?id=150
只是可惜， 里面的一个文件下载不了。
2、
利用extract解压缩CAB文件
http://www.qin5.com/pc/jq/lyext.htm
从98的Commond目录在拷一个Extract.exe出来，跟你的程序一起发布，然后用
ShellExecute就可以解开CAB文件了。
3、
使用控件ZipTV，支持CAB等在内的46种压缩文件格式

unit HSetup;
interface
uses
WinTypes, WinProcs, Dialogs;

const
IDF_NOBROWSE = $00000001;
IDF_NOSKIP = $00000002;
IDF_NODETAILS = $00000004;
IDF_NOCOMPRESSED = $00000008;
IDF_CHECKFIRST = $00000100;
IDF_NOBEEP = $00000200;
IDF_NOFOREGROUND = $00000400;
IDF_WARNIFSKIP = $00000800;
IDF_OEMDISK = $80000000;
DPROMPT_SUCCESS = 0;
DPROMPT_CANCEL = 1;
DPROMPT_SKIPFILE = 2;
DPROMPT_BUFFERTOOSMALL = 3;
DPROMPT_OUTOFMEMORY = 4;
SPFILENOTIFY_STARTQUEUE = $00000001;
SPFILENOTIFY_ENDQUEUE = $00000002;
SPFILENOTIFY_STARTSUBQUEUE = $00000003;
SPFILENOTIFY_ENDSUBQUEUE = $00000004;
SPFILENOTIFY_STARTDELETE = $00000005;
SPFILENOTIFY_ENDDELETE = $00000006;
SPFILENOTIFY_DELETEERROR = $00000007;
SPFILENOTIFY_STARTRENAME = $00000008;
SPFILENOTIFY_ENDRENAME = $00000009;
SPFILENOTIFY_RENAMEERROR = $0000000a;
SPFILENOTIFY_STARTCopy = $0000000b;
SPFILENOTIFY_ENDCopy = $0000000c;
SPFILENOTIFY_CopyERROR = $0000000d;
SPFILENOTIFY_NEEDMEDIA = $0000000e;
SPFILENOTIFY_QUEUESCAN = $0000000f;
SPFILENOTIFY_CABINETINFO = $00000010;
SPFILENOTIFY_FILEINCABINET = $00000011;
SPFILENOTIFY_NEEDNEWCABINET = $00000012;
SPFILENOTIFY_FILEEXTRACTED = $00000013;
SPFILENOTIFY_FILEOPDELAYED = $00000014;
SPFILENOTIFY_LANGMISMATCH = $00010000;
SPFILENOTIFY_TARGETEXISTS = $00020000;
SPFILENOTIFY_TARGETNEWER = $00040000;
FILEOP_Copy = 0;
FILEOP_RENAME = 1;
FILEOP_DELETE = 2;
FILEOP_ABORT = 0;
FILEOP_DOIT = 1;
FILEOP_SKIP = 2;
FILEOP_RETRY = FILEOP_DOIT;
FILEOP_NEWPATH = 4;

type
PSP_FILE_CALLBACK = function (Contextointer;Notification,Param1:Integer;var Param2:integer):Integer;stdcall;
PPSP_FILE_CALLBACK = PSP_FILE_CALLBACK;
PFILE_IN_CABINET_INFO = ^FILE_IN_CABINET_INFO;
FILE_IN_CABINET_INFO = record
NameInCabinet : PChar;
FileSize : DWORD;
Win32Error : DWORD;
do
sDate : WORD;
do
sTime : WORD;
do
sAttribs : WORD;
FullTargetName : array[0..255] of Char;
end;

PCabinet_Info = ^Cabinet_Info;
Cabinet_Info = record
CabinetPath : pchar;
CabinetFile : pchar;
DiskName : pchar;
Id : Shortint;
CabinetNumber : Shortint;
end;

PFilePath = ^TFilePath;
TFilePath = record
TargetChar;
SourceChar;
ErrorCode:Integer;
FlagsWord;
end;

TSetupPromptForDisk = function (
Handle:HWND;
// parent window of the dialog box
DialogTitlechar;
// optional, title of the dialog box
DiskNamechar;
// optional, name of disk to insert
PathToSourcechar;
// optional, expected source path
FileSoughtchar;
// name of file needed
TagFilechar;
// optional, source media tag file
DiskPromptstyleWord;
// specifies dialog box behavior
PathBufferchar;
// receives the source location
PathBufferSizeWord;
// size of the supplied buffer
PathRequiredSizeDWord // optional, buffer size needed
):Integer;stdcall;
TSetupCopyError = function (
Handle:HWND;
// parent window for this dialog box
DialogTitlechar;
// optional, title for this dialog box
DiskNamechar;
// optional, name of disk to insert
PathToSourcechar;
// failed source path
SourcefileChar;
// source file of Copy error
TargetPathFilechar;
// optional, target file of Copy error
Win32ErrorCode:Integer;
// error information
styleWord;
// dialog box formatting and display
PathBufferChar;
// optional, receives new path info
PathBufferSizeWord;
// size of supplied buffer
PathRequiredSizeDWord // optional, buffer size needed
):Integer;stdcall;
TSetupDeleteError = function (
Handle:HWND;
// parent window for this dialog box
DialogTitlechar;
// optional, title for this dialog box
FileNameChar;
// file that caused the delete error
Win32ErrorCode:Integer;
// specifies the error that occurred
styleWord // specifies formatting for the dialog box
):Integer;stdcall;
TSetupRenameError = function (
Handle:HWND;
// parent window for this dialog box
DialogTitlechar; // optional, title for this dialog box
SourceFileChar; // source file of the rename error
TargetFilechar; // target file of the rename error
Win32ErrorCode:Integer;
// the error encountered
styleWord // specifies formatting for this dialog box
):Integer;stdcall;
TSetupIterateCabinet = function (
CabinetFilechar;
// name of the cabinet file
ReservedWord;
// this parameter is not used
MsgHandlePSP_FILE_CALLBACK;// callback routine to use
Contextointer // callback routine context
):boolean;stdcall;
implementation
end.

unit CabFile;

{$ObjExportAll On}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, HSetup;
type
TCabInfo = record
CabinetPath:string;
CabinetFile:string;
DiskName:string;
Id:Shortint;
CabinetNumber:Shortint;
end;
{$EXTERNALSYM TCabInfo}
TOnCabInfo = procedure (Sender: TObject;CabInfo:TCabInfo) of object;
{$EXTERNALSYM TOnCabInfo}
TOnExtracted = procedure (Sender: TObject;Successed:boolean;var Continue:boolean;Source,Dest:string) of object;
{$EXTERNALSYM TOnExtracted}
TOnExtractFile = procedure (Sender: TObject;FileName:string;DestPath:string) of object;
{$EXTERNALSYM TOnExtractFile}
TOnNeedNewCabinet = procedure (Sender: TObject;var Continue:boolean;CabInfo:TCabInfo;var NewPath:string) of object;
{$EXTERNALSYM TOnNeedNewCabinet}
TCabFile = class(TComponent)
private
FFileName: TFileName;
FFiles: TstringList;
FOnCabInfo: TOnCabInfo;
FOnFiles: TNotifyEvent;
FOnExtracted: TOnExtracted;
FDestPath:string;
FOnExtractFile: TOnExtractFile;
FOnNeed: TOnNeedNewCabinet;
FTmpstring : string;
Fdll:THandle;
FSetupIterateCabinet:TSetupIterateCabinet;
procedure SetFileName(const Value: TFileName);
procedure SetFiles(const Value: TstringList);
procedure RefreshFiles;
protected
public
constructor Create(AOwner: TComponent);override;
destructor Destroy;override;
published
property FileName:TFileName read FFileName write SetFileName;
property Files:TstringList read FFiles write SetFiles;
property OnCabInfo:TOnCabInfo read FOnCabInfo write FOnCabInfo;
property OnFilesListed:TNotifyEvent read FOnFiles write FonFiles;
property OnFileExtracted:TOnExtracted read FOnExtracted write FOnExtracted;
property OnStartFileExtraction:TOnExtractFile read FOnExtractFile write FonExtractFile;
property OnNeedNewCabinet:TOnNeedNewCabinet read FonNeed write FOnNeed;
function ExtractAll(destpath:string):boolean;
function ExtractFile(FileName:string;DestPath:string):boolean;
end;

implementation

resourcestring
RC_SetupApiDll = 'Unable to find setupapi.dll';
const
FileTimeBase = -109205.0;
FileTimeStep: Extended = 24.0 * 60.0 * 60.0 * 1000.0 * 1000.0 * 10.0;
// 100 nSek per Day
function FileTimeToDateTime(const FileTime: TFileTime): TDateTime;
begin
Result := Int64(FileTime) / FileTimeStep;
Result := Result + FileTimeBase;
end;

{**************************************************}
constructor TCabFile.Create(AOwner: TComponent);
begin
inherited;
FFiles:=TstringList.Create;
FFileName:='';
FDll:=LoadLibrary('setupapi.dll');
if Fdll<>0 then
FSetupIterateCabinet:=GetProcAddress(Fdll,'SetupIterateCabinetA')
else
raise Exception.Create(RC_SetupApiDll);
end;
{**************************************************}
destructor TCabFile.Destroy;
begin
Ffiles.free;
if Fdll<>0 then
FreeLibrary(Fdll);
inherited;
end;
{**************************************************}
procedure TCabFile.SetFileName(const Value: TFileName);
begin
FFileName := Value;
RefreshFiles;
end;
{**************************************************}
procedure TCabFile.SetFiles(const Value: TstringList);
begin
//do nothing !!!!
end;
{**************************************************}
function CBack(Contextointer;Notification,Param1:Integer;var Param2:integer):Integer;stdcall;
var
cabFILE_IN_CABINET_INFO;
Sender:TCabFile;
cabinfo:TCabInfo;
fileinfo: string;
filetime: TFileTime;
begin
result:=ERROR_BAD_COMMAND;
if Context<>nil then
Sender:=TCabFile(Context^)
else
exit;
//this callback is only for listing files in a cabinet ... pouet pouet !
if Notification = SPFILENOTIFY_FILEINCABINET then
//found a file in the cabinet
begin
result:=FILEOP_SKIP;
cab:=PFILE_IN_CABINET_INFO(Param1);
fileinfo := format('%-50s',[strpas(cab^.NameInCabinet)]);
fileinfo := fileinfo + format('%10s',[inttostr(cab^.FileSize)]);
Windows.DosDateTimeToFileTime(Cab^.DosDate,Cab^.DosTime,fileTime);
fileinfo := fileinfo + format('%20s',[formatdatetime('yyyy-mm-dd hh:nn', FileTimeToDateTime(filetime))]);
Sender.FFiles.Add(fileinfo);
// Sender.FFiles.Add(strpas(cab^.NameInCabinet));
end
else
if Notification = SPFILENOTIFY_CABINETINFO then
//give cabinet info
begin
if Assigned(Sender.FOnCabInfo)and(Param1<>0) then
begin
cabinfo.CabinetPath:=strpas(PCabinet_Info(Param1)^.CabinetPath);
cabinfo.CabinetFile:=strpas(PCabinet_Info(Param1)^.CabinetFile);
cabinfo.DiskName:=strpas(PCabinet_Info(Param1)^.DiskName);
cabinfo.Id:=PCabinet_Info(Param1)^.Id;
cabinfo.CabinetNumber:=PCabinet_Info(Param1)^.CabinetNumber;
Sender.FOnCabInfo(Sender,cabinfo);
end;
result:=0;
end;
end;
{**************************************************}
function CExtract(Contextointer;Notification,Param1:Integer;var Param2:integer):Integer;stdcall;
var
cabFILE_IN_CABINET_INFO;
Sender:TCabFile;
cabinfo:TCabInfo;
continue:boolean;
FPath:TFilePath;
Path:string;
i:Integer;
begin
result:=ERROR_BAD_COMMAND;
if Context<>nil then
Sender:=TCabFile(Context^)
else
exit;

//this callback is only for listing files in a cabinet ...
if notification = SPFILENOTIFY_CABINETINFO then
result:=0
else
if Notification = SPFILENOTIFY_FILEINCABINET then
//found a file in the cabinet
begin
try
result:=FILEOP_DOIT;
cab:=PFILE_IN_CABINET_INFO(Param1);
if Sender.FDestPath[length(Sender.FDestPath)]='/' then
begin
//extract all
path:=Sender.FDestPath+strpas(cab^.NameInCabinet);
for i:=1 to length(path)do
cab^.FullTargetName[i-1]:=path;
cab^.FullTargetName[length(path)]:=#0;
if Assigned(Sender.FOnExtractFile) then
Sender.FOnExtractFile(Sender,cab^.FullTargetName,Sender.FDestPath);
end
else
begin
//Extract specific file
if UpperCase(extractFileName(Sender.FDestPath))=UpperCase(strpas(cab^.NameInCabinet)) then
begin
path:=Sender.FDestPath;
for i:=1 to length(path)do
cab^.FullTargetName[i-1]:=path;
cab^.FullTargetName[length(path)]:=#0;
if Assigned(Sender.FOnExtractFile) then
Sender.FOnExtractFile(Sender,cab^.FullTargetName,Sender.FDestPath);
end
else
result:=FILEOP_SKIP;
end;
except
result:=FILEOP_SKIP;
end;
end
else
if Notification = SPFILENOTIFY_FILEEXTRACTED then
begin
Continue:=true;
if param1<>0 then
FPath:=PFilePath(param1)^;
if Assigned(Sender.FOnExtracted) then
Sender.FOnExtracted(Sender,(FPath.ErrorCode=NO_ERROR),continue,
StrPas(FPath.Source),strpas(FPath.Target));
if continue then
result:=NO_ERROR
else
result:=ERROR_BAD_COMMAND;
end
else
if Notification = SPFILENOTIFY_NEEDNEWCABINET then
begin
if param1<>0 then
begin
cabinfo.CabinetPath:=strpas(PCabinet_Info(Param1)^.CabinetPath);
cabinfo.CabinetFile:=strpas(PCabinet_Info(Param1)^.CabinetFile);
cabinfo.DiskName:=strpas(PCabinet_Info(Param1)^.DiskName);
cabinfo.Id:=PCabinet_Info(Param1)^.Id;
cabinfo.CabinetNumber:=PCabinet_Info(Param1)^.CabinetNumber;
Continue:=true;
path:='';
if Assigned(Sender.FonNeed) then
begin
Sender.FOnNeed(Sender,Continue,cabinfo,path);
Sender.FTmpstring:=path;
param2:=Longint(PChar(Sender.FTmpstring));
end
else
result:=ERROR_BAD_COMMAND;
end
else
result:=ERROR_BAD_COMMAND;
end;
end;
{**************************************************}
procedure TCabFile.RefreshFiles;
begin
FFiles.Clear;
if @FSetupIterateCabinet<>nil then
if FSetupIterateCabinet(PChar(FFileName),0,CBack,@self) then
if Assigned(FonFiles) then
FOnfiles(self);
end;
{**************************************************}
function TCabFile.ExtractAll(destpath: string):boolean;
begin
if destpath[length(destpath)]<>'/' then
DestPath:=DestPath+'/';
FDestPath:=DestPath;
if @FSetupIterateCabinet<>nil then
result:=FSetupIterateCabinet(PChar(FFileName),0,CExtract,@self)
else
result:=false;
end;
{**************************************************}
function TCabFile.ExtractFile(FileName, DestPath: string):boolean;
begin
if destpath[length(destpath)]<>'/' then
DestPath:=DestPath+'/';
FDestPath:=DestPath+FileName;
if @FSetupIterateCabinet<>nil then
result:=FSetupIterateCabinet(PChar(FFileName),0,CExtract,@self)
else
result:=false;
end;
{**************************************************}
end.

使用TCabFile控件可以直接使用CAB文件, 程序在上面[]

pcsunflower的方法不错，但好像要把CAB文件中的内容先释放出来再使用，能不能直接读CAB文件的方法，分不够可以加！

如果大家还有什么更好的方法，写在这我会开贴给分的。