/*
* MINIGUI - Harbour Win32 GUI library Demo
*
* Access to 7z archives by 7-zip32.dll
* (c) 2008 Vladimir Chumachenko <ChVolodymyr@yandex.ru>
*
* Last Revised by Grigory Filatov 03/10/2017
*/
#define _HMG_OUTLOG
#include "CStruct.ch" // from Harbour\Contrib\xHB
#include "HBCTypes.ch" // from Harbour\Contrib\xHB
#include "WinTypes.ch" // from Harbour\Contrib\xHB
#include "hmg.ch"
#define ALONE_7Z '7za.exe' // console variant of 7-Zip archiver
STATIC cPath7z := '' // Full path to installed 7-Zip archiver
STATIC lPath7z := .F.
MEMVAR oMain
// C-structure, used in SevenZipFindFirst(), SevenZipFindNext()
pragma pack( 4 )
#define FNAME_MAX32 512
typedef struct { ;
DWORD dwOriginalSize;
DWORD dwCompressedSize;
DWORD dwCRC;
UINT uFlag;
UINT uOSType;
WORD wRatio;
WORD wDate;
WORD wTime;
char szFileName[ FNAME_MAX32 + 1 ];
char dummy1[ 3 ];
char szAttribute[ 8 ];
char szMode[ 8 ];
} INDIVIDUALINFO, * PINDIVIDUALINFO;
FUNCTION Main( cMode, cPar1, cPar2 )
LOCAL cBuf, aBuf, cTm1, cTm2, nTime, aTmp, cTmp, nTmp, oTmp, cDir
LOCAL cP1, cP2, cP3, cP4, cP5, cP6, cP7, cP8, cP9, nI, nK
Default cMode := "", cPar1 := "", cPar2 := ""
App.Cargo := oKeyData() ; o := App.Cargo ; SetsEnv()
cMode := lower(cMode)
wMain_7Zip( cMode, cPar1, cPar2 )
RETURN
*----------------------------------------------------------------------------*
FUNCTION wMain_7Zip( cMode, cPar1, cPar2 )
*----------------------------------------------------------------------------*
LOCAL cExe := hb_progName()
LOCAL cPth := left(cExe, RAt("\", cExe))
LOCAL oa, nG, nM, nY, nX, nW, nH, nL, nL1, nL2, g, y, x, w, h
LOCAL cFont := 'Tahoma'
LOCAL nSize := 9
LOCAL cTitl := 'Archiver 7-Zip interaction'
LOCAL cIcon := 'main.ico'
LOCAL lExtract := "e" $ cMode
LOCAL nPost := 0
cPath7z := cPth + '7za.exe'
lPath7z := hb_FileExists(cPath7z)
SET FONT TO cFont, nSize
DEFINE FONT DefFont FONTNAME cFont SIZE nSize
oa := App.Object
nX := 0 ; nW := oa:W4 * 2 // Sys.DesktopWidth * 0.5
nY := 0 ; nH := oa:H1 * 22
nG := oa:GapsWidth
nM := oa:Left
IF lExtract .and. !Empty(cPar1) .and. !Empty(cPar2)
nPost := 5
ENDIF
DEFINE WINDOW wMain At nY, nX CLIENTAREA nW, nH Title cTitl Icon cIcon ;
Main NoMaximize NoSize ;
ON INIT _wPost(nPost)
PUBLIC oMain := This.Object ; This.Cargo := oKeyData()
This.Cargo:cFile7z := cPar1
This.Cargo:cDirOut := cPar2
This.Cargo:lExtract := lExtract
This.Cargo:nCount := 0
DEFINE STATUSBAR
StatusItem ''
StatusItem '' Width nW * 0.22 //120
StatusItem '' Width 40
StatusItem '' Width nW * 0.23 //130
END STATUSBAR
y := nG ; x := nG ; w := This.ClientWidth - x*2
g := nM * 2 - nG * 3 - oa:H4
h := oa:H1 * 18 - nG
DEFINE TAB tbMain at y, x Width w Height h
DEFINE PAGE 'Archive'
nL := w - nG * 2 - 30
nL1 := nL * 0.7
nL2 := nL - nL1
@ 30, 5 Grid grdContent Width w - nG * 2 Height h-oa:H2-nG ;
Headers { 'Name', 'Size' } ;
Widths { nL1 , nL2 } ;
Multiselect
y := This.ClientHeight - This.StatusBar.Height - nM * 2 - nG - oa:H1
@ y, 15 ButtonEx btnCreate Caption 'Create' ;
Width oa:W2 ;
Height oa:H2 ;
Action _wPost(1) ; // RunTest( 1 ) ;
Tooltip 'Create archive'
@ y, 220 ButtonEx btnView Caption 'View' ;
Width oa:W2 ;
Height oa:H2 ;
Action _wPost(2) ; // RunTest( 2 ) ;
Tooltip 'View 7z/zip archive'
@ y, 415 ButtonEx btnExtract Caption 'Extract' ;
Width oa:W2 ;
Height oa:H2 ;
Action _wPost(3) ; // RunTest( 3 ) ;
Tooltip 'Extract file(s) from archive'
END PAGE
DEFINE PAGE 'Options'
@ 30, 5 Frame frmSelectTest ;
Caption 'Select test' ;
Width w - nG * 2 ;
Height 65 ;
Bold ;
FontColor BLUE
@ 55, 15 RadioGroup rdgSelectTest ;
Options { '7-zip32.dll', '7-Zip', '7za.exe' } ;
Width 100 ;
Spacing 20 ;
Value 1 ;
ON Change wMain.btnExtract.Enabled := .F. ;
Horizontal
@ 110, 5 Frame frmCommon ;
Caption 'Common' ;
Width w - nG * 2 ;
Height 65 ;
Bold ;
FontColor BLUE
@ 135, 15 CheckBox cbxHide ;
Caption 'Hide progressbar' ;
Width 124 ;
Value .F.
@ 185, 5 Frame frmExtract ;
Caption 'Extract' ;
Width w - nG * 2 ;
Height 65 ;
Bold ;
FontColor BLUE
@ 210, 15 CheckBox cbxExtract ;
Caption 'Extract files with full paths' ;
Width 176 ;
Value .F.
@ 210, 200 CheckBox cbxYesAll ;
Caption 'Assume (Yes) on all queries' ;
Width 190 ;
Value .T.
@ 260, 5 Frame frmLinks ;
Caption 'Links' ;
Width w - nG * 2 ;
Height 100 ;
Bold ;
FontColor BLUE
@ 285, 15 LABEL lbl7z ;
Value '7-Zip' ;
Width 120 ;
Height 15
@ 285, 140 Hyperlink hl7z ;
Value 'http://www.7-zip.org' ;
Address 'http://www.7-zip.org' ;
HandCursor
@ 305, 15 LABEL lblDLL_JA ;
Value '7-Zip32.dll (Japanese)' ;
Width 120 ;
Height 15
@ 305, 140 Hyperlink hlDLL_JA ;
Value 'http://www.csdinc.co.jp/archiver/lib/' ;
Address 'http://www.csdinc.co.jp/archiver/lib/' ;
Width 270 HandCursor
@ 325, 15 LABEL lblDLL_EN ;
Value '7-Zip32.dll (English)' ;
Width 120 ;
Height 15
@ 325, 140 Hyperlink hlDLL_EN ;
Value 'http://www.csdinc.co.jp/archiver/lib/main-e.html' ;
Address 'http://www.csdinc.co.jp/archiver/lib/main-e.html' ;
Width 270 HandCursor
END PAGE
END TAB
IF ! lPath7z
wMain.rdgSelectTest.Enabled( 3 ) := .F.
ENDIF
wMain.btnExtract.Enabled := .F.
IF nPost > 3
wMain.btnCreate.Hide
ENDIF
WITH OBJECT This.Object
:Event( 1, {|ow,ky| RunTest(ky, ow) } )
:Event( 2, {|ow,ky| RunTest(ky, ow) } )
:Event( 3, {|ow,ky| RunTest(ky, ow) } )
:Event( 5, {|ow,ky,nCnt|
ky := -1
//ow:Hide() ; DO EVENTS
nCnt := RunTest(2, ow)
IF nCnt > 0 ; ky := RunTest(3, ow)
ENDIF
//ow:Show() ; DO EVENTS
ow:Release()
Return Nil
} )
:Event(99, {|ow| ow:Release() })
END WITH
END WINDOW
CENTER WINDOW wMain
ACTIVATE WINDOW wMain
RETURN Nil
*----------------------------------------------------------------------------*
STATIC PROCEDURE ShowStatus( cFile, cCount, cType, cVersion )
*----------------------------------------------------------------------------*
wMain.StatusBar.Item (1) := cFile // Processed file
wMain.StatusBar.Item (2) := cCount // Files in the archive
wMain.StatusBar.Item (3) := cType // Archive type
wMain.StatusBar.Item (4) := cVersion // Procedure Information
RETURN Nil
*----------------------------------------------------------------------------*
STATIC FUNCTION Version7zip
*----------------------------------------------------------------------------*
LOCAL nVersion := SevenZipGetVersion(), ; // 7-zip
nSubversion := SevenZipGetSubVersion(), ; // 7-zip32.dll
cVersion := 'Version '
cVersion += ( Str( ( nVersion / 100 ), 5, 2 ) + '.' + StrZero( ( nSubversion / 100 ), 5, 2 ) )
RETURN cVersion
*----------------------------------------------------------------------------*
STATIC PROCEDURE RunTest( nChoice, oWnd )
*----------------------------------------------------------------------------*
LOCAL nSelected := wMain.rdgSelectTest.Value
LOCAL o := oWnd:Cargo
LOCAL nRet := 0
DO CASE
CASE ( nChoice == 1 ) // Create Archive
IF ( nSelected == 1 ) ; CreateArc() // Process 7-zip32.dll
ELSE ; CreateArcExternal() // Run 7z.exe or 7za.exe
ENDIF
CASE ( nChoice == 2 ) // View Content
IF ( nSelected == 1 ) ; nRet := ViewArc( o:cFile7z, .F. )
ELSE ; ViewArcExternal()
ENDIF
CASE ( nChoice == 3 ) // Extract Files
IF ( nSelected == 1 ) ; nRet := ExtractArc( o:cDirOut, .F. )
ELSE ; ExtractArcExternal()
ENDIF
ENDCASE
RETURN nRet
*----------------------------------------------------------------------------*
STATIC PROCEDURE CreateArc
*----------------------------------------------------------------------------*
LOCAL aSource := GetFile( { { 'All files', '*.*' } }, ;
'Select file(s)', ;
GetCurrentFolder(), .T., .T. ;
), ;
cArcFile, ;
cType := '', ;
cCommand := 'A ', ;
nDLLHandle
IF !Empty( aSource )
cArcFile := PutFile ( { { '7-zip', '*.7z' }, { 'Zip', '*.zip' } }, ;
'Create archive', ;
GetCurrentFolder(), ;
.T. ;
)
IF !Empty( cArcFile )
// Define the type of archive. The default is 7z, so
// remember only in case of change in the dialog box.
IF ( Upper( Right( cArcFile, 3 ) ) == 'ZIP' )
cType := 'zip'
ENDIF
// Build a command line to pass to the DLL
IF wMain.cbxHide.Value
cCommand += '-hide ' // Do not display the process
ENDIF
IF !Empty( cType )
cCommand += '-tzip ' // In ZIP format
ENDIF
cCommand += ( cArcFile + ' ' )
// Specify files to process
AEval( aSource, {| elem | cCommand += ( '"' + elem + '" ' ) } )
cCommand := RTrim( cCommand )
IF !( ( nDLLHandle := LoadLibrary( '7-zip32.dll' ) ) > 0 )
MsgStop( "Can't load 7-zip32.dll.", 'Error' )
ELSE
DllCall( nDLLHandle, DC_CALL_STD, 'SevenZip', _HMG_MainHandle, cCommand )
FreeLibrary( nDLLHandle )
// Fill In The Status Bar
ShowStatus( cArcFile, '', iif( Empty( cType ), '7z', 'zip' ), Version7zip() )
ENDIF
ENDIF
ENDIF
RETURN
*----------------------------------------------------------------------------*
STATIC FUNCTION ViewArc( xFile, lMsg )
*----------------------------------------------------------------------------*
LOCAL cFile
LOCAL nDLLHandle, nArcHandle, nResult, cValue, nCount := 0
LOCAL cType := '', oInfo, pInfo, aFiles := {}, nSize
LOCAL nRet := -1
Default lMsg := .T.
IF Empty( xFile )
cFile := GetFile( {{'7-zip', '*.7z'}, {'Zip', '*.zip'}}, ;
'Select archive', GetCurrentFolder(), .F., .T. )
ELSE
cFile := xFile
ENDIF
IF !( ( nDLLHandle := LoadLibrary( '7-zip32.dll' ) ) > 0 )
IF lMsg ; MsgStop( "Can't load 7-zip32.dll.", 'Error' )
ENDIF
RETURN nRet
ENDIF
nArcHandle := DllCall( nDLLHandle, DC_CALL_STD, 'SevenZipOpenArchive', _HMG_MainHandle, cFile, 0 ) // Открыть архив
IF Empty( nArcHandle )
IF lMsg ; MsgStop( cFile + ' not opened.', 'Error' )
ENDIF
nRet := 0
RETURN nRet
ENDIF
nCount := DllCall( nDLLHandle, DC_CALL_STD, 'SevenZipGetFileCount' , cFile ) // Количество элементов в архиве
nResult := DllCall( nDLLHandle, DC_CALL_STD, 'SevenZipGetArchiveType', cFile ) // Тип архива
DO CASE
CASE ( nResult == 1 ) ; cType := 'ZIP'
CASE ( nResult == 2 ) ; cType := '7Z'
CASE ( nResult == -1 ) ; cType := 'Error'
CASE ( nResult == 0 ) ; cType := '???'
ENDCASE
oInfo := ( STRUCT INDIVIDUALINFO )
pInfo := oInfo:GetPointer()
// Looking for the 1st file. If the search result does not matter, pass pInfo
// can be omitted.
DllCall( nDLLHandle, DC_CALL_STD, 'SevenZipFindFirst', nArcHandle, '*', pInfo )
// Reset The Pointer
oInfo := oInfo:Pointer( pInfo )
cValue := Space( FNAME_MAX32 )
DllCall( nDLLHandle, DC_CALL_STD, 'SevenZipGetFileName', nArcHandle, @cValue, FNAME_MAX32 )
nSize := DllCall( nDLLHandle, DC_CALL_STD, 'SevenZipGetOriginalSize', nArcHandle )
cValue := Trim(StrTran(cValue, chr(0), ""))
IF !Empty( cValue )
// Fill out the form table. First, we enter the values into an array,
// sort and pass the Grid
AAdd( aFiles, { cValue, nSize } )
DO WHILE ( ( nResult := DllCall( nDLLHandle, DC_CALL_STD, 'SevenZipFindNext', nArcHandle, pInfo ) ) == 0 )
cValue := Space( FNAME_MAX32 )
DllCall( nDLLHandle, DC_CALL_STD, 'SevenZipGetFileName', nArcHandle, @cValue, FNAME_MAX32 )
nSize := DllCall( nDLLHandle, DC_CALL_STD, 'SevenZipGetOriginalSize', nArcHandle )
cValue := Trim(StrTran(cValue, chr(0), ""))
AAdd( aFiles, { cValue, nSize } )
ENDDO
wMain.grdContent.DeleteAllItems
IF Len(aFiles) > 1
ASort( aFiles,,, {| x, y | x[ 1 ] < y[ 1 ] } )
ENDIF
wMain.grdContent.DisableUpdate
AEval( aFiles, {| elem | wMain.grdContent.AddItem( elem ) } )
wMain.grdContent.EnableUpdate
wMain.grdContent.Value := { 1 }
DO EVENTS
wApi_Sleep(1000)
ENDIF
// Close the archive file, unload the library
DllCall( nDLLHandle, DC_CALL_STD, 'SevenZipCloseArchive', nArcHandle )
FreeLibrary( nDLLHandle )
nRet := nCount
// Fill In The Status Bar
ShowStatus( cFile, ( 'Count files: ' + LTrim( Str( nCount ) ) ), cType, Version7zip() )
IF ( wMain.grdContent.ItemCount > 0 )
wMain.btnExtract.Enabled := .T.
ENDIF
RETURN nRet
*----------------------------------------------------------------------------*
STATIC PROCEDURE ExtractArc( xDir, lMsg )
*----------------------------------------------------------------------------*
LOCAL aPos := wMain.grdContent.Value
LOCAL cDir, cCommand, nPos, cFile, nDLLHandle
LOCAL nRet := -1, nSize, aFiles := {}, cOut, nFile
Default lMsg := .T.
IF Empty( aPos )
IF lMsg ; MsgStop( 'Select item(s), please!', 'Error' )
ENDIF
RETURN nRet
ENDIF
IF Empty( xDir ) ; cDir := GetFolder( 'Extract file(s) to' )
ELSE ; cDir := xDir ; cOut := cDir+"\"
aPos := {}
AEval(array(wMain.grdContent.ItemCount), {|xv,nn| xv:= nn, AAdd(aPos, nn)})
ENDIF
IF !Empty( cDir )
// Retrieve while maintaining directory structure or not
cCommand := ( iif( wMain.cbxExtract.Value, 'x', 'e' ) + ' ' )
IF wMain.cbxHide.Value
// Do not display the process. But if you need to rewrite
// existing files, the corresponding request anyway
// will be output.
cCommand += '-hide '
ENDIF
// Overwrite existing files without warning
IF wMain.cbxYesAll.Value
cCommand += '-y '
ENDIF
cCommand += ( '-o' + cDir + ' ' ) // Where to extract
// Do not forget to add the name of the archive containing the extracted files
// cCommand += ( '"' + AllTrim( wMain.Statusbar.Item( 1 ) ) + '" ' )
cCommand += ( AllTrim( wMain.Statusbar.Item( 1 ) ) + ' ' )
// Add the extracted files. To simplify processing:
// if the number of marked items is equal to the total
// quantity, it makes no sense to do an exhaustive search.
IF ( Len( aPos ) == wMain.grdContent.ItemCount )
cCommand += '*.*'
FOR EACH nPos In aPos ; Aadd( aFiles, wMain.grdContent.Item(nPos) )
NEXT
ELSE
FOR EACH nPos In aPos
// Items containing only the directory name, skip
cFile := AllTrim( wMain.grdContent.Item( nPos )[ 1 ] )
nSize := wMain.grdContent.Item( nPos )[ 2 ]
AAdd( aFiles, {cFile, nSize} )
IF !( Right( cFile, 1 ) == '\' )
// cCommand += ( '"' + cFile + '" ' )
cCommand += ( cFile + ' ' )
ENDIF
NEXT
cCommand := RTrim( cCommand )
ENDIF
IF !( ( nDLLHandle := LoadLibrary( '7-zip32.dll' ) ) > 0 )
IF lMsg ; MsgStop( "Can't load 7-zip32.dll.", 'Error' )
ENDIF
nRet := -2
ELSE
DllCall( nDLLHandle, DC_CALL_STD, 'SevenZip', _HMG_MainHandle, cCommand )
FreeLibrary( nDLLHandle )
IF lMsg ; MsgInfo( "Extraction is successfully.", 'Result' )
ENDIF
nRet := 0
IF !Empty(cOut)
FOR nPos := 1 TO Len(aFiles)
cFile := aFiles[ nPos ][1]
nSize := aFiles[ nPos ][2]
IF ISCHAR(nSize) ; nSize := Val(nSize)
ENDIF
IF hb_FileExists(cOut+cFile)
IF nSize != hb_fSize(cOut+cFile) ; nRet++
ENDIF
ELSE ; nRet++
ENDIF
NEXT
IF nRet > 0
FOR nPos := 1 TO Len(aFiles)
cFile := aFiles[ nPos ][1]
fErase(cOut+cFile)
NEXT
ENDIF
ENDIF
ENDIF
DO EVENTS
wApi_Sleep(1000)
ENDIF
RETURN nRet
DECLARE DLL_TYPE_WORD SevenZipGetVersion() in 7-zip32.dll
DECLARE DLL_TYPE_WORD SevenZipGetSubVersion() in 7-zip32.dll
*----------------------------------------------------------------------------*
STATIC PROCEDURE CreateArcExternal
*----------------------------------------------------------------------------*
LOCAL aSource := GetFile( { { 'All files', '*.*' } }, ;
'Select file(s)', ;
GetCurrentFolder(), .T., .T. ;
), ;
cArcFile, ;
nPos, ;
cExt, ;
cType := '', ;
cCommand := ' A '
IF !Empty( aSource )
// Addressing directly to 7-Zip itself allows you to create
// more types of archives
cArcFile := PutFile ( { { '7-zip', '*.7z' }, ;
{ 'Zip', '*.zip' }, ;
{ 'GZip', '*.gzip' }, ;
{ 'BZip2', '*.bzip2' }, ;
{ 'Tar', '*.tar' } ;
}, ;
'Create archive', ;
GetCurrentFolder(), ;
.T. ;
)
IF !Empty( cArcFile )
// Define the type of archive. The default is 7z, so
// remember only in case of change in the dialog box.
nPos := RAt( '.', cArcFile )
cExt := Upper( Right( cArcFile, ( Len( cArcFile ) - nPos ) ) )
IF !( cExt == '7Z' )
cType := cExt
ENDIF
// Build the command line
IF !Empty( cType )
cCommand += ( '-t' + cType + ' ' )
ENDIF
cCommand += ( cArcFile + ' ' )
// Specify files to process
AEval( aSource, {| elem | cCommand += ( '"' + elem + '" ' ) } )
// Run either the installed archiver or console
// version located in the folder with the demo program
IF ( wMain.rdgSelectTest.Value == 2 )
cCommand := ( cPath7z + cCommand )
ELSE
cCommand := ( ALONE_7Z + cCommand )
ENDIF
cCommand := RTrim( cCommand )
// Run in standby mode for the end of processing. If
// while the archiver window itself is hidden (for aesthetics, because the window
// console), to display that the work is being performed (if
// the archive is large), you can display some kind of information window,
// for example with a timer.
// There is another option: for 7-Zip, run not% ProgramFiles% \ 7-Zip \ 7z.exe,
// and% ProgramFiles% \ 7-Zip \ 7zG.exe is the graphical interface of the archiver.
// Get the weird little progress bar on the screen.
IF wMain.cbxHide.Value
Execute File ( cCommand ) WAIT Hide
ELSE
Execute File ( cCommand ) Wait
ENDIF
// Fill In The Status Bar
ShowStatus( cArcFile, '', iif( Empty( cType ), '7Z', cType ), ;
iif( ( wMain.rdgSelectTest.Value == 2 ), '7-Zip', '7za' ) )
ENDIF
ENDIF
RETURN
*----------------------------------------------------------------------------*
STATIC PROCEDURE ViewArcExternal
*----------------------------------------------------------------------------*
// aFiles - a set of supported archive types. The base accept set for
// console version (7za.exe), because its capabilities are more modest.
LOCAL aFilters := { { '7-zip', '*.7z' }, ;
{ 'Zip', '*.zip' }, ;
{ 'Cab', '*.cab' }, ;
{ 'GZip', '*.gzip' }, ;
{ 'Tar', '*.tar' } ;
}, ;
cFile, ;
aFiles := {}, ;
cCommand, ;
cTmpFile := '_Arc_.lst',; // Or GetTempFolder () + '\ _Arc_.lst'
oFile, ;
cString
// Add archive types that the full version can work with (not all,
// specified in the documentation, of course)
IF ( wMain.rdgSelectTest.Value == 2 )
AAdd( aFilters, { 'Rar', '*.rar' } )
AAdd( aFilters, { 'Arj', '*.arj' } )
AAdd( aFilters, { 'Chm', '*.chm' } )
AAdd( aFilters, { 'Lzh', '*.lzh' } )
ENDIF
IF Empty( cFile := GetFile( aFilters, 'Select archive', GetCurrentFolder(), .F., .T. ) )
RETURN Nil
ENDIF
// The contents of the archive are displayed in a temporary file and then read for display in
// program.
// You can, of course, use cmd.exe instead of GetEnv ('COMSPEC'), but
// the name of the shell may be different in older versions of Windows
cCommand := GetEnv( 'COMSPEC' ) + ' /C '
IF ( wMain.rdgSelectTest.Value == 2 )
// Quotation marks do not hurt, because Program Files has a space in the name.
// Here you need to use exactly% ProgramFiles% \ 7-Zip \ 7z.exe, because
// graphical version of 7zG.exe does not support redirecting output to a file
cCommand := ( cCommand + '"' + cPath7z + '"' )
ELSE
cCommand := ( cCommand + ALONE_7Z )
ENDIF
// And the information will not be displayed in the table, but in the technical mode (switch
// -slt). Then each file file will be described in several lines like this
// (varies depending on the type of archive):
// Path = Our archive file
// Size =
// Packed Size =
// Modified =
// Attributes =
// CRC =
// Method =
// Block =
// and the name of the archive element will be displayed in the line marked Path =
// Temporary content file is better, of course, to create in
// system folder of temporary files (GetTempFolder () + '\' + cTmpFile)
cCommand += ( ' L -slt ' + cFile + ' > ' + cTmpFile )
Execute File ( cCommand ) WAIT Hide
// A more refined solution would be to redirect the output of the console program
// WinAPI function (use CreatePipe and work with it as usual
// file), and not create a temporary file, but I'm not that subtle expert.
IF File( cTmpFile )
// Temporary file may not be created, for example, due to the errors
// in the command line. Additionally, it would not hurt to check its size.
// If zero, then there is nothing in it.
// Fill The Array
oFile := TFileRead():New( cTmpFile )
oFile:Open()
IF !oFile:Error()
DO WHILE oFile:MoreToRead()
IF !Empty( cString := oFile:ReadLine() )
// Several simplified processing. Just checking does not start
// whether the line with "Path =" and, if so, then this is the file name. At
// necessary, can be made more complicated. For example, ignore
// directory names (line "Attributes = D ...." for .7z files)
IF ( Left( cString, 7 ) == 'Path = ' )
cString := AllTrim( SubStr( cString, 8 ) )
IF !( cString == cFile )
AAdd( aFiles, { cString } )
ENDIF
ENDIF
ENDIF
ENDDO
oFile:Close()
IF !Empty( aFiles )
wMain.grdContent.DeleteAllItems
ASort( aFiles,,, {| x, y | x[ 1 ] < y[ 1 ] } )
wMain.grdContent.DisableUpdate
AEval( aFiles, {| elem | wMain.grdContent.AddItem( elem ) } )
wMain.grdContent.EnableUpdate
wMain.grdContent.Value := { 1 }
// Fill in the status bar (it will store the name of the read
// archive needed to extract files)
ShowStatus( cFile, ( 'Count files: ' + LTrim( Str( Len( aFiles ) ) ) ), ;
Upper( Right( cFile, ( Len( cFile ) - RAt( '.', cFile ) ) ) ), ;
iif( ( wMain.rdgSelectTest.Value == 2 ), '7-Zip', '7za' ) )
ENDIF
ENDIF
IF ( wMain.grdContent.ItemCount > 0 )
wMain.btnExtract.Enabled := .T.
ENDIF
ENDIF
// The temporary file also played a role. deleted. Team not
// causes an error even if the deleted file does not exist.
FErase ( cTmpFile )
RETURN Nil
*----------------------------------------------------------------------------*
STATIC PROCEDURE ExtractArcExternal
*----------------------------------------------------------------------------*
LOCAL aPos := wMain.grdContent.Value, ;
cDir, ;
cCommand, ;
nPos, ;
cFile
IF Empty( aPos )
MsgStop( 'Select item(s), please!', 'Error' )
RETURN Nil
ENDIF
IF !Empty( cDir := GetFolder( 'Extract file(s) to' ) )
// Retrieve while maintaining directory structure or not
cCommand := ( iif( wMain.cbxExtract.Value, 'X', 'E' ) + ' ' )
// Overwrite existing files without warning
IF wMain.cbxYesAll.Value
cCommand += '-y '
ENDIF
cCommand += ( '-o' + cDir + ' ' ) // Where to extract
cCommand += ( AllTrim( wMain.Statusbar.Item( 1 ) ) + ' ' )
IF ( Len( aPos ) == wMain.grdContent.ItemCount )
cCommand += '*.*'
ELSE
FOR EACH nPos In aPos
// Items which containing only the directory name, skip
cFile := AllTrim( wMain.grdContent.Item( nPos )[ 1 ] )
IF !( Right( cFile, 1 ) == '\' )
cCommand += ( cFile + ' ' )
ENDIF
NEXT
cCommand := RTrim( cCommand )
ENDIF
IF ( wMain.rdgSelectTest.Value == 2 )
// If instead of 7z.exe use 7zG.exe, it will be displayed
// operation indicator
cCommand := ( cPath7z + ' ' + cCommand )
ELSE
cCommand := ( ALONE_7Z + ' ' + cCommand )
ENDIF
// Do it.
IF wMain.cbxHide.Value .AND. !wMain.cbxYesAll.Value
Execute File ( cCommand ) WAIT Hide
ELSE
Execute File ( cCommand ) Wait
ENDIF
MsgInfo( 'Extraction is successfully.', 'Result' )
ENDIF
RETURN Nil
*----------------------------------------------------------------------------*
FUNCTION SetsEnv()
*----------------------------------------------------------------------------*
LOCAL cLog := ".\_MsgLog.txt"
LOCAL cFont := "Arial"
LOCAL nSize := 11
SET CENTURY ON
SET DATE GERMAN
SET DELETED ON
SET EXCLUSIVE ON
SET EPOCH TO 2000
SET AUTOPEN ON
SET EXACT ON
SET SOFTSEEK ON
SET NAVIGATION EXTENDED
//SET DEFAULT ICON TO "BIL_MAIN"
*--------------------------------
SET OOP ON
*--------------------------------
DEFINE FONT DlgFont FONTNAME "Tahoma" SIZE 14
fErase( cLog ) ; LogFileName( cLog )
RETURN Nil
*----------------------------------------------------------------------------*
FUNCTION LogFileName( cLog )
*----------------------------------------------------------------------------*
RETURN _SetGetLogFile(cLog)
|
). 
- участник сейчас на форуме
- участник вне форума