'------------------------------------------------------------------------------ ' Rar.inc - RAR library for PowerBasic. ' currently supported: RAR-ing a folder with text-progressbar ' Usage: ErrCode = RAR(hDlg, TxPgBarId, "targetfile", "folder/") ' Needs presence of LocalAppData + "Rar.exe" '------------------------------------------------------------------------------ '------------------------------------------------------------------------------ GLOBAL rarFile, rarRdir AS STRING : GLOBAL rarStatus AS LONG '------------------------------------------------------------------------------ FUNCTION RAR (BYVAL hDlg AS DWORD, BYVAL PgBarId AS LONG, _ BYVAL file AS STRING, BYVAL rdir AS STRING) AS LONG rarFile = file rarRdir = rdir rarStatus = %STILL_ACTIVE DIALOG POST hDlg, %WM_APP, PgBarId, 0 WHILE rarStatus = %STILL_ACTIVE DIALOG DOEVENTS SLEEP 0 WEND FUNCTION = rarStatus END FUNCTION '------------------------------------------------------------------------------ '------------------------------------------------------------------------------ MACRO RAR_CALLBACK STATIC hConsole, rarPid AS DWORD STATIC rarTimer, rarPg AS LONG LOCAL rarBuffer, rarTxt AS STRING LOCAL timeleft, rarErr AS STRING LOCAL rarPct, rarBps AS LONG LOCAL nChr, rarCod AS LONG LOCAL hInfo AS DWORD LOCAL conInf AS CONSOLE_SCREEN_BUFFER_INFO SELECT CASE AS LONG CB.MSG CASE %WM_APP rarErr = DIR$(LocalAppData + "rar.exe") : DIR$ CLOSE IF ISFALSE LEN(rarErr) THEN CONTROL SET TEXT CB.HNDL, 1001, "Fatal error: RAR lib not found" CONTROL DISABLE CB.HNDL, 1004 rarStatus = 1 EXIT FUNCTION END IF ' Get text-progressbar id from message rarPg = CB.WPARAM SET_TEXT_PROGRESSBAR CB.HNDL, rarPg, 0, "", %RGB_DARKGREEN, %GREEN ' Spawn a rar process via Shell IF EXIST(rarFile) AND NOT replaceAll THEN SET_TEXT_PROGRESSBAR CB.HNDL, rarPg, 100, "Skipping existing CBR..." rarStatus = 0 DIALOG DOEVENTS 1000 EXIT FUNCTION END IF KILL rarFile ' Else overwrite any existing target rar rarPid = SHELL ( DQP(LocalAppData + "rar.exe") _ + " a " + DQP(rarFile) _ + " " + DQP(rarRdir) _ , 0) SLEEP 50 ' 1000 ' Attach the corresponding console and get its handle AttachConsole(rarPid) hConsole = GetStdHandle(%STD_OUTPUT_HANDLE) ' Start the timer to read console content rarTimer = SetTimer(CB.HNDL, %WM_USER, 50, BYVAL 0) DIALOG POST CB.HNDL, %WM_TIMER, %WM_USER, 0 CASE %WM_TIMER ' Check status of rar process hInfo = OpenProcess(%PROCESS_QUERY_INFORMATION, %FALSE, rarPid) GetExitCodeProcess(hInfo, rarCod) CloseHandle(hInfo) ' Get rar progress (%) GetConsoleScreenBufferInfo(hConsole, conInf) ' Get console row and column nChr = conInf.dwSize.X * (conInf.dwSize.Y - 1) rarBuffer = NUL$(nChr) ReadConsoleOutputCharacter(hConsole, BYVAL STRPTR(rarBuffer), nChr, "", rarBps) rarBuffer = TRIM$(rarBuffer) rarTxt = RIGHT$(TRIM$(rarBuffer), conInf.dwSize.X) ' CONTROL SET TEXT CB.HNDL, 1001, ">>>" + rarTxt + "<<<" + FORMAT$(nChr) nChr = INSTR(rarTxt, "Adding") IF nChr > 1 THEN rarTxt = MID$(rarTxt, nChr) IF RIGHT$(rarTxt, 1) = "%" THEN rarPct = VAL(MID$(rarTxt, LEN(rarTxt)-3, 3)) rarTxt = LEFT$(rarTxt, -3) rarTxt = TRIM$(MID$(rarTxt, 8)) IF LEN(rarTxt) > 36 THEN rarTxt = LEFT$(rarTxt, 17) + ".." + RIGHT$(rarTxt, 17) SET_TEXT_PROGRESSBAR CB.HNDL, rarPg, rarPct, rarTxt END IF ' rar is finished: end timer + show result IF rarCod <> %STILL_ACTIVE THEN KillTimer CB.HNDL, rarTimer : rarTimer = 0 IF rarCod <> 0 THEN KILL EXE.NAME$ + ".log" DUMP2FILE rarBuffer, EXE.NAME$ + ".log" rarErr = "ERROR! See log file." CONTROL SET TEXT CB.HNDL, 1001, rarErr SET_TEXT_PROGRESSBAR CB.HNDL, rarPg, rarPct, rarTxt, %RGB_DARKRED, %RED ELSE SET_TEXT_PROGRESSBAR CB.HNDL, rarPg, 100, "" END IF FreeConsole () : hConsole = 0 rarStatus = rarCod EXIT FUNCTION END IF CASE %WM_DESTROY ' If parent dialog (this program) is killed then kill child process (rar) as well IF ISTRUE rarTimer THEN KillTimer CB.HNDL, rarTimer IF ISTRUE hConsole THEN FreeConsole () hConsole = OpenProcess(%PROCESS_TERMINATE, %FALSE, rarPid) TerminateProcess(hConsole, 0) CloseHandle(hConsole) END IF END SELECT END MACRO '------------------------------------------------------------------------------