Форум » GUI » Новая версия Расширенного релиза библиотеки MiniGUI (часть VI ) (продолжение) » Ответить
Новая версия Расширенного релиза библиотеки MiniGUI (часть VI ) (продолжение)
gfilatov: Начало темы находится здесь, а теперь АНОНС * АНОНС * АНОНС * АНОНС * АНОНС Готовится к опубликованию новая сборка №48, которая выйдет в конце недели. Если у Вас есть интересные наработки для включения в новый релиз, то сейчас самое удобное время для их отправки мне Кратко, что нового: - исправление обнаруженных ошибок и неточностей кода; - новый класс HEADERIMAGE для Grid и Browse; - свойство Address в Hyperlink может теперь открывать папку или файл на диске; - добавлен NOTABSTOP класс для Browse; - поддержка пользовательских компонентов (заимствована из оффициального релиза); - расширения и исправления в библиотеках TsBrowse и PropGrid; - обновлены сборки Харбор и HMGS-IDE; - новые и обновленные старые примеры (как обычно ).
SergKis: gfilatov2002 Сделал у себя [pre2] CLASS TSColumn ... DATA bDrawCell // before :bTSDrawCell() ... METHOD DrawLine( xRow, lDrawCell ) CLASS TSBrowse ... oColumn:oCell:lInvertColor := .F. // 32 Invert color IF ISBLOCK( oColumn:bDrawCell ) ; Eval( oColumn:bDrawCell, Self, oColumn:oCell, oColumn ) ENDIF IF lDrawCell ; ::TSDrawCell( oColumn:oCell, oColumn ) ENDIF ... METHOD DrawSelect( xRow, lDrawCell ) CLASS TSBrowse ... oColumn:oCell:lInvertColor := !(::lCellBrw .and. nJ != ::nCell) // 32 Invert color IF HB_ISBLOCK( oColumn:bDrawCell ) ; Eval( oColumn:bDrawCell, Self, oColumn:oCell, oColumn ) ENDIF If lDrawCell .and. ::lDrawLine ; ::TSDrawCell( oColumn:oCell, oColumn ) EndIf ... Потребовалось раскрасить код объекта в выборке многострочной по объектам (аналог покраски четных\нечетных строк, т.е. через строчку), а тут через объект. С использованием :bDrawCell() получилось просто. ... LOCAL oColor := oKeyData() LOCAL nMaxObj ... выбираем уникально объекты и ставим 0\1 (чет\нечет) INDEX ON OBJECTNUM TAG OBJ UNIQUE OrdSetFocus("OBJ") GO TOP nMaxObj := OrdKeyCount() ; i := 0 DO WHILE !EOF() ; oColor:Set( OBJECTNUM, int(i % 2) ) ; i++ ; SKIP ENDDO GO TOP ... на колонку кодов объектов в тсб ставим oCol := :GetColumn("OBJECTNUM"); oCol:cHeading := ot:cObj oCol:nFAlign := DT_CENTER oCol:cFooting := hb_ntos(nMaxObj) oCol:Cargo := oKeyData() oCol:Cargo:nMaxObj := nMaxObj oCol:Cargo:oColor := oColor oCol:Cargo:lColor := nMaxObj > 1 oCol:Cargo:aColor := { GetSysColor( COLOR_BTNFACE ) } // { CLR_HGRAY } oCol:bDrawCell := {|obrw,ocel,ocol| Local o := ocol:Cargo, nClr, nTo, cKod, nElm IF o:lColor nClr := ocel:nClrBack nTo := ocel:nClrTo cKod := ocel:uValue nElm := o:oColor:Get(cKod, 0) ocel:nClrBack := iif( nElm > 0, o:aColor[ nElm ], nClr ) ocel:nClrTo := iif( nElm > 0, o:aColor[ nElm ], nTo ) ENDIF Return Nil } ... [/pre2]
gfilatov2002: SergKis пишет: Сделал у себя ОК. Благодарю за предложение
gfilatov2002: Подготовил 1-й апдейт сборки 21.07 Подробности см. на английском форуме Минигуи. Обновил также Unicode архив. Искренне благодарю Андрея за многолетнюю поддержку Желаю всем мира и добра
Andrey: gfilatov2002 пишет: Подробности см. на английском форуме Минигуи. А нам тоже интересно, на русском, а не на буржуйском. Когда ТАБ внизу, большие фонты отображаются коряво ! Я не использую такие ТАБы но может другие используют. И картинки коряво сдвинуты... Пример отправил на почту.
gfilatov2002: Andrey пишет: Когда ТАБ внизу, большие фонты отображаются коряво Уже поправил эту недоработку, и "по-тихому" обновил 1-й апдейт сборки 21.07 по адресу http://hmgextended.com/files/CONTRIB/hmg-21.07-setup.exe Благодарю за пример
rvu: Компилирую с помощью ..\batch\compile.bat Сегодня заметил, стала говорить про множественные ресурсы: Duplicate resource: Type 16 (VERSIONINFO), ID 1; File мой файл ресурсов - .RES resource kept; file C:\MINIGUI\RESOURCES\MINIGUI.RES resource discarded. Не знаю как давно это появилось. Вытащил версию 21.05 — нет там такого. Как бы их примирить?
gfilatov2002: rvu пишет: Вытащил версию 21.05 — нет там такого. Как бы их примирить? Благодарю за сообщение Уже поправил эту недоработку, которая была вызвана ошибками в работе компилятора ресурсов Borland C++. P.S. Поправил также в Unicode-архиве...
rvu: Скачал заново. В unicode-версии пропало. А в неуникодной ничего не изменилось. Да и установочный файл такого же размера, что и раньше у меня был.
gfilatov2002: rvu пишет: в неуникодной ничего не изменилось Все правильно. Это исправление будет включено во второй апдейт сборки 21.07
rvu: gfilatov2002 пишет: Это исправление будет включено во второй апдейт сборки 21.07 Понял. Когда ожидается?
gfilatov2002: rvu пишет: Когда ожидается? Запланировал - на следующей неделе, если получится...
rvu: Понятно.
gfilatov2002: Завершена подготовка второго апдейта сборки 21.07, который будет опубликован послезавтра. Что нового: * New: Added the useful function HMG_FileCopy() to copy a file to a new file. Syntax: HMG_FileCopy( <cSourceFile>, <cTargetFile>, [<nBuffer>], [<bEval>] ) --> lSuccess where <cSourceFile> is the name of the source file including the path and the extension; <cTargetFile> is the name of the target file including the path and the extension; <nBuffer> is the buffer size in bytes. The default is 8192 bytes; <bEval> is the code block which is executed with the percentage of the file copied. This function returns false if an errors occurs, otherwise, it returns true. Based upon a contribution of Jacek Kubica <kubica/at/wssk.wroc.pl> (see demo in folder \samples\Basic\Filecopy) * Updated: Pacified a C-warning in the MiniGUI core for compatibility with the new Pelles C 11.0 (64-bit). Contributed by Grigory Filatov <gfilatov@inbox.ru> * New: The SELECTOR library source code (see in folder \Source\SELECTOR). Based upon a code of Janusz Piwowarski for Clipper. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Basic\Charts_3) * Updated: Adaptation FiveWin Class TSBrowse 9.0 in HMG: - added the new variable :bDrawCell in the TSColumn class. This codeblock will executed in the methods DrawLine() and DrawSelect() before calling the method TSDrawCell(). Suggested and contributed by Sergej Kiselev. * New: 'Registry class for Xbase++ usage' sample. Based upon a contribution of HMG user Jimmy. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Basic\RegClass) * New: 'Tab Control with OOP' sample. Contributed by Sergej Kiselev and Verchenko Andrey (see demo3.prg in folder \samples\Basic\TAB) Ваши комментарии приветствуются...
SergKis: gfilatov2002 пишет Ваши комментарии приветствуются... Пробовал под unicode пример Advanced\7-Zip, ... фокус не удался Может включить lib из примера в основную сборку ?
gfilatov2002: SergKis пишет: Может включить lib из примера в основную сборку ? Благодарю за предложение, но эта библиотека является устаревшей (с 2010 года). Ее функционал перенесен в ядро Харбора и в contrib библиотеку XHB.
SergKis: gfilatov2002 пишет эта библиотека является устаревшей (с 2010 года). Ее функционал перенесен в ядро Харбора и в contrib библиотеку XHB. Как я понял, в hb zip функционал (может ошибаюсь), а с запусками планировщиком (у нас, как правило) синхронизацию по backup откатам (баз) каталогов разных PC, используют 7z (7za.exe). 7z = ~1Г -> ~65Мб, а zip дает ~ в 2а раза больше файл после сжатия. Пример оказался очень в тему и жизненный, чуть поправил галочки настройки, добавил Size в grid и получилась автомат. распаковка 7z архива при заданных параметрах File7z, CtlgOut на входе запуска. Пока 7-zip32.dll была хорошим решением
SergKis: gfilatov2002 пишет Ее функционал перенесен в ядро Харбора и в contrib библиотеку XHB. Собрал hbdll32.lib на unicode версии, выбросил из своего модуля ранее [pre2] // Generate the full name of the installed 7-Zip through a registry entry OPEN REGISTRY oReg KEY HKEY_CURRENT_USER Section 'Software\7-Zip' GET VALUE cPath7z NAME 'Path' OF oReg CLOSE REGISTRY oReg[/pre2] Заработало. Кому интересно, тут [pre2] /* * 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) [/pre2] Запуск для авто распаковки demo2.exe -e <FileName.7z> <FullDirNameUnPack> Текст помещаем как demo2.prg в Advanced\7-Zip
SergKis: PS Поправил текст, размеры кнопок, убрал chr(0) из имени файла из архива и при запуске demo2.exe -e <FileName.7z> <FullDirNameUnPack> берет все файлы из архива (архив ОБЯЗАТЕЛЬНО без подкаталогов)
gfilatov2002: Подготовил 2-й апдейт сборки 21.07 Обновил также Unicode архив.
rvu: Спасибо!
полная версия страницы