VB调用WinRAR.doc

与WinRAR以最快方式压缩ZIP比较， 255M的文件 Level=0时用时24.98秒大小95.1M Level=255时用时30.24秒大小91.6M WinRAR最快压缩ZIP用时25.2秒大小58.6M 标准RAR压缩，我看了一下，实在太慢，也就没试了，估计要几分钟才会有结果。 从速度看，基本持平了，这个算法虽然最大压缩能力有限，但感觉设计得很巧妙，每次都基于动态表，使软件可以做得很小巧，资源占用也很少。非常值得收藏！ 测试窗体中的代码 OptionExplicit PrivateWithEventsObjZipAsClassZip PrivateBgTimeAsSingle PrivateSubCommand1_Click() BgTime=Timer Command1.Enabled=False Command2.Enabled=False WithObjZip .InputFileName=Text1.Text .OutputFileName=Text2.Text .IsCompress=True .CompressLevel=Val(Text4.Text) .BeginProcss EndWith Label1.Caption=Round(Timer-BgTime,2)&秒 Command1.Enabled=True Command2.Enabled=True EndSub PrivateSubCommand2_Click() BgTime=Timer Command1.Enabled=False Command2.Enabled=False WithObjZip .InputFileName=Text2.Text .OutputFileName=Text3.Text .IsCompress=False .BeginProcss EndWith Label1=Round(Timer-BgTime,2)&秒 Command1.Enabled=True Command2.Enabled=True EndSub PrivateSubCommand3_Click() ObjZip.CancelProcss=True EndSubPrivateSubForm_Load() SetObjZip=NewClassZip Command1.Caption=压缩 Command2.Caption=解压 Command3.Caption=中断 EndSub PrivateSubForm_Unload(CancelAsInteger) SetObjZip=Nothing EndSub PrivateSubObjZip_FileProgress(sngPercentageAsSingle) Label1=Int(sngPercentage*100)&% EndSub PrivateSubObjZip_ProcssError(ErrorDescriptionAsString) MsgBoxErrorDescription EndSubClassZip类中的声明与属性、方法、事件 OptionExplicit PublicEventFileProgress(sngPercentageAsSingle) PublicEventProcssError(ErrorDescriptionAsString) PrivateTypeFileHeader HeaderTagAsString*3 HeaderSizeAsInteger FlagAsByte FileLengthAsLong VersionAsInteger EndType PrivatemintCompressLevelAsLong Privatem_bEnableProcssAsBoolean Privatem_bCompressAsBoolean Privatem_strInputFileNameAsString Privatem_strOutputFileNameAsString PrivateConstmcintWindowSizeAsInteger=&H1000 PrivateConstmcintMaxMatchLenAsInteger=18 PrivateConstmcintMinMatchLenAsInteger=3 PrivateConstmcintNullAsLong=&H1000 PrivateConstmcstrSignatureAsString=FMZ PrivateDeclareSubCopyMemoryLibKernel32AliasRtlMoveMemory(pDestAsAny,pSourceAsAny,ByValdwLengthAsLong)PublicSubBeginProcss() Ifm_bCompressThen Compress Else Decompress EndIf EndSub PrivateFunctionLastError(ErrNoAsInteger)AsString SelectCaseErrNo Case1 LastError=待压缩文件未设置或不存在 Case2 LastError=待压缩文件长度太小 Case3 LastError=待压缩文件已经过压缩 Case4 LastError=待解压文件未设置或不存在 Case5 LastError=待解压文件格式不对或为本软件不能认别的高版本软件所压缩 Case254 LastError=用户取消了操作 Case255 LastError=未知错误 EndSelect EndFunction PublicPropertyGetCompressLevel()AsInteger CompressLevel=mintCompressLevel16 EndProperty PublicPropertyLetCompressLevel(ByValintValueAsInteger) mintCompressLevel=intValue*16 IfmintCompressLevel0ThenKillstrOutTmpFile IfFileLen(m_strInputFileName)lngFileLengthThenlngInBufLen=lngFileLength ReDimabytInputBuffer(lngInBufLen-1) ReDimabytOutputBuffer(lngOutBufLen+17) WithudtFileH .HeaderSize=Len(udtFileH) lngCurWritten=.HeaderSize+1 .HeaderTag=mcstrSignature .FileLength=lngFileLength .Version=App.Revision .Flag=0 EndWith intMaxLen=mcintMaxMatchLen lngBytesRead=mcintMaxMatchLen lngInPos=mcintMaxMatchLen intBitCount=1 PutintOutputFile,udtFileH GetintInputFile,abytInputBuffer CopyMemoryabytWindow(0),abytInputBuffer(0),mcintMaxMatchLen CopyMemoryabytWindow(mcintWindowSize),abytInputBuffer(0),mcintMaxMatchLenDoWhileintMaxLen intMatchPos=0 intMatchLen=0 intPrev=aintWindowNext(&H100&*abytWindow(intBufferLocation+1)+abytWindow(intBufferLocation)And&HFFF)+mcintWindowSize+1) intCount=0 DoUntilintCountmintCompressLevelOrintPrev=mcintNull intNext=0 DoWhile(abytWindow(intPrev+intNext)=abytWindow(intBufferLocation+intNext)AndintNextintMatchLenThen intMatchLen=intNext intMatchPos=intPrev IfintNext=mcintMaxMatchLenThen aintWindowNext(aintWindowPrev(intPrev)=aintWindowNext(intPrev) aintWindowPrev(aintWindowNext(intPrev)=aintWindowPrev(intPrev) aintWindowNext(intPrev)=mcintNull aintWindowPrev(intPrev)=mcintNull ExitDo EndIf EndIf intPrev=aintWindowNext(intPrev) intCount=intCount+1 Loop IfintBitCountAnd&H100Then lngOutPos=intByteCodeWritten IfintByteCodeWrittenlngOutBufLenThen PutintOutputFile,lngCurWritten,abytOutputBuffer DoEvents Ifm_bEnableProcss=FalseThenintErrNo=254:GoToPROC_ERR lngCurWritten=lngCurWritten+intByteCodeWritten lngOutPos=0 EndIf intByteCodeWritten=lngOutPos+1 intBitCount=1 abytOutputBuffer(lngOutPos)=0 EndIf IfintMatchLen1Then IfintMatchLenintMaxLenThenintMatchLen=intMaxLen abytOutputBuffer(intByteCodeWritten)=intMatchPosAnd&HFF intByteCodeWritten=intByteCodeWritten+1 abytOutputBuffer(intByteCodeWritten)=(intMatchPos16)And&HF0)OrintMatchLen-mcintMinMatchLen)And&HFF EndIf intByteCodeWritten=intByteCodeWritten+1 intBitCount=intBitCount*2DoWhileintMatchLen intPrev=intBufferLocation+mcintMaxMatchLen intNext=intPrevAnd&HFFF IfaintWindowPrev(intNext)mcintNullThen aintWindowNext(aintWindowPrev(intNext)=aintWindowNext(intNext) aintWindowPrev(aintWindowNext(intNext)=aintWindowPrev(intNext) aintWindowNext(intNext)=mcintNull aintWindowPrev(intNext)=mcintNull EndIf IflngInPos=mcintWindowSizeThenabytWindow(intPrev)=abytInputBuffer(lngInPos) lngBytesRead=lngBytesRead+1 lngInPos=lngInPos+1 IflngInPos=lngInBufLenThen IflngFileLengthlngBytesReadThen IflngInBufLenlngFileLength-lngBytesReadThen lngInBufLen=lngFileLength-lngBytesRead ReDimabytInputBuffer(lngInBufLen-1) EndIf GetintInputFile,abytInputBuffer lngInPos=0 RaiseEventFileProgress(lngBytesRead/lngFileLength) DoEvents Ifm_bEnableProcss=FalseThenintErrNo=254:GoToPROC_ERR EndIf EndIf EndIf intPrev=(&H100&*abytWindow(intBufferLocation+1)+abytWindow(intBufferLocation)And&HFFF)+mcintWindowSize+1 intNext=aintWindowNext(intPrev) aintWindowPrev(intBufferLocation)=intPrev aintWindowNext(intBufferLocation)=intNext aintWindowNext(intPrev)=intBufferLocation IfintNextmcintNullThenaintWindowPrev(intNext)=intBufferLocation intBufferLocation=(intBufferLocation+1)And&HFFF intMatchLen=intMatchLen-1 Loop IflngInPos=lngInBufLenThenintMaxLen=intMaxLen-1 Loop IfintByteCodeWritten0Then ReDimPreserveabytOutputBuffer(intByteCodeWritten-1) PutintOutputFile,lngCurWritten,abytOutputBuffer EndIf CloseintInputFile CloseintOutputFile IfLen(Dir(m_strOutputFileName)0ThenKillm_strOutputFileName NamestrOutTmpFileAsm_strOutputFileName RaiseEventFileProgress(1) ExitSub PROC_ERR: CloseintOutputFile CloseintInputFile IfLen(Dir(strOutTmpFile)0AndLen(strOutTmpFile)0ThenKillstrOutTmpFile IfintErrNo=0ThenintErrNo=255 RaiseEventProcssError(LastError(intErrNo) EndSubPrivateSubDecompress() DimintTempAsInteger DimintBufferLocationAsInteger DimintLengthAsInteger DimbytHiByteAsInteger DimbytLoByteAsInteger DimintWindowPositionAsInteger DimlngFlagsAsLong DimintInputFileAsInteger DimintOutputFileAsInteger DimabytWindow(mcintWindowSize+mcintMaxMatchLen)AsByte DimstrOutTmpFileAsString DimlngBytesReadAsLong DimlngBytesWrittenAsLong DimlngFileLengthAsLong DimlngOriginalFileLenAsLong DimlngInBufLenAsLong,abytInBuf()AsByte,abytOutBuf()AsByte DimlngOutBufLenAsLong,lngInPosAsLong,lngOutPosAsLong DimudtFileHAsFileHeader DimintErrNoAsInteger OnErrorGoToPROC_ERR m_bEnableProcss=True IfLen(Dir(m_strInputFileName)=0OrLen(m_strInputFileName)=0ThenintErrNo=4:GoToPROC_ERR IfLen(m_strOutputFileName)=0Thenm_strOutputFileName=m_strInputFileName strOutTmpFile=m_strOutputFileName&.tmp IfLen(Dir(strOutTmpFile)0ThenKillstrOutTmpFile intInputFile=FreeFile Openm_strInputFileNameForBinaryAccessReadAsintInputFile lngFileLength=LOF(intInputFile) GetintInputFile,udtFileH IfudtFileH.HeaderTag=mcstrSignatureAndudtFileH.VersionlngFileLengthThenlngInBufLen=lngFileLength ReDimabytInBuf(lngInBufLen-1) ReDimabytOutBuf(lngOutBufLen-1) GetintInputFile,abytInBuf DoWhilelngBytesWritten=lngInBufLenThen IflngFileLengthlngBytesReadThen IflngInBufLenlngFileLength-lngBytesReadThen lngInBufLen=lngFileLength-lngBytesRead ReDimabytInBuf(lngInBufLen-1) EndIf GetintInputFile,abytInBuf DoEvents Ifm_bEnableProcss=FalseThenintErrNo=254:GoToPROC_ERR lngInPos=0 EndIf EndIf EndIfIf(lngFlagsAnd1)Then abytWindow(intWindowPosition)=abytInBuf(lngInPos) abytOutBuf(lngOutPos)=abytInBuf(lngInPos) lngBytesRead=lngBytesRead+1 lngInPos=lngInPos+1 lngBytesWritten=lngBytesWritten+1 lngOutPos=lngOutPos+1 intWindowPosition=(intWindowPosition+1)And&HFFF IflngInPos=lngInBufLenThen IflngFileLengthlngBytesReadThen IflngInBufLenlngFileLength-lngBytesReadThen lngInBufLen=lngFileLength-lngBytesRead ReDimabytInBuf(lngInBufLen-1) EndIf GetintInputFile,abytInBuf DoEvents Ifm_bEnableProcss=FalseThenintErrNo=254:GoToPROC_ERR lngInPos=0 EndIf EndIf IflngOutPos=lngOutBufLenThen PutintOutputFile,abytOutBuf lngOutPos=0 RaiseEventFileProgress(lngBytesWritten/lngOriginalFileLen) DoEvents Ifm_bEnableProcss=FalseThenintErrNo=254:GoToPROC_ERR EndIf Else bytHiByte=abytInBuf(lngInPos) lngBytesRead=lngBytesRead+1 lngInPos=lngInPos+1 IflngInPos=lngInBufLenThen IflngFileLengthlngBytesReadThen IflngInBufLenlngFileLength-lngBytesReadThen lngInBufLen=lngFileLength-lngBytesRead ReDimabytInBuf(lngInBufLen-1) EndIf GetintInputFile,abytInBuf DoEvents Ifm_bEnableProcss=FalseThenintErrNo=254:GoToPROC_ERR lngInPos=0 EndIf EndIf bytLoByte=abytInBuf(lngInPos) intBufferLocation=(bytLoByteAnd&HF0)*16+bytHiByte)And&HFFF intLength=(bytLoByteAnd&HF)+mcintMinMatchLen lngBytesRead=lngBytesRead+1 lngInPos=lngInPos+1 IflngInPos=lngInBufLenThen IflngFileLengthlngBytesReadThen IflngInBufLenlngFileLength-lngBytesReadThen lngInBufLen=lngFileLength-lngBytesRead ReDimabytInBuf(lngInBufLen-1) EndIf GetintInputFile,abytInBuf DoEvents Ifm_bEnableProcss=FalseThenintErrNo=254:GoToPROC_ERR lngInPos=0 EndIf EndIfintTemp=intBufferLocation+intLength DoWhileintBufferLocation=lngOutBufLenThen PutintOutputFile,abytOutBuf lngOutPos=0 RaiseEventFileProgress(lngBytesWritten/lngOriginalFileLen) DoEvents Ifm_bEnableProcss=FalseThenintErrNo=254:GoToPROC_ERR EndIf Loop EndIf Loop IflngOutPos0Then ReDimPreserveabytOutBuf(lngOutPos-1) PutintOutputFile,abytOutBuf EndIf CloseintOutputFile Else intErrNo=5 GoToPROC_ERR EndIf CloseintInputFile IfLen(Dir(m_strOutputFileName)0ThenKillm_strOutputFileName NamestrOutTmpFileAsm_strOutputFileName RaiseEventFileProgress(1) ExitSub PROC_ERR: CloseintOutputFile CloseintInputFile IfLen(Dir(strOutTmpFile)0AndLen(strOutTmpFile)0ThenKillstrOutTmpFile IfintErrNo=0ThenintErrNo=255 RaiseEventProcssError(LastError(intErrNo) EndSubClassZip类中的声明与属性、方法、事件 OptionExplicit PublicEventFileProgress(sngPercentageAsSingle) PublicEventProcssError(ErrorDescriptionAsString) PrivateTypeFileHeader HeaderTagAsString*3 HeaderSizeAsInteger FlagAsByte FileLengthAsLong VersionAsInteger EndType PrivatemintCompressLevelAsLong Privatem_bEnableProcssAsBoolean Privatem_bCompressAsBoolean Privatem_strInputFileNameAsString Privatem_strOutputFileNameAsString PrivateConstmcintWindowSizeAsInteger=&H1000 PrivateConstmcintMaxMatchLenAsInteger=18 PrivateConstmcintMinMatchLenAsInteger=3 PrivateConstmcintNullAsLong=&H1000 PrivateConstmcstrSignatureAsString=FMZ PrivateDeclareSubCopyMemoryLibKernel32AliasRtlMoveMemory(pDestAsAny,pSourceAsAny,ByValdwLengthAsLong) PublicSubBeginProcss() Ifm_bCompressThen Compress Else Decompress EndIf EndSub PrivateFunctionLastError(ErrNoAsInteger)AsString SelectCaseErrNo Case1 LastError=待压缩文件未设置或不存在 Case2 LastError=待压缩文件长度太小 Case3 LastError=待压缩文件已经过压缩 Case4 LastError=待解压文件未设置或不存在 Case5 LastError=待解压文件格式不对或为本软件不能认别的高版本软件所压缩 Case254 LastError=用户取消了操作 Case255 LastError=未知错误 EndSelect EndFunction PublicPropertyGetCompressLevel()AsInteger CompressLevel=mintCompressLevel16 EndProperty PublicPropertyLetCompressLevel(ByValintValueAsInteger) mintCompressLevel=intValue*16 IfmintCompressLevel0ThenmintCompressLevel=0 EndProperty PublicPropertyGetIsCompress()AsBoolean IsCompress=m_bCompress EndProperty PublicPropertyLetIsCompress(ByValbValueAsBoolean) m_bCompress=bValue EndProperty PublicPropertyLetCancelProcss(ByValbValueAsBoolean) m_bEnableProcss=NotbValue EndProperty PublicPropertyGetInputFileName()AsSt