FiveTech Support Forums

// C:\FWH\SAMPLES\CREAPATH.PRG

// TROQUE/CAMBIE PARA SISTEMAS, POIS NA MINHA MAQUINA JA EXISTE ESTA PASTA.
// USEI: \SYSTEMAS, ok? MUDE PARA: \SISTEMAS NA SUA MAQUINA. Kapiaba.

#include "FiveWin.ch"
#include "Directry.ch"
                                                             // 202505
FUNCTION Main()

   LOCAL cDir, cSubDir1, cSubDir2, cSubDir3

   cDir := "D:"

   LCHDIR( "D:"  ) // En C: CD\  -> D: <enter> simulando o DOS(SOD).

   IF .NOT. lIsDir( "\SYSTEMAS" )

      lMkDir( "\SYSTEMAS" )

   ENDIF

   LCHDIR( "SYSTEMAS" )  // CD SYSTEMAS <enter>

   cSubDir1 := "SCANDOC"

   IF .NOT. lIsDir( cSubDir1 )

      lMkDir( cSubDir1 )

   ENDIF

   LCHDIR( "SCANDOC" )   // CD SCANDOC  <enter>

   cSubDir2 := "EMPRESA01"

   IF .NOT. lIsDir( cSubDir2 )

      lMkDir( cSubDir2 )

   ENDIF

   LCHDIR( "EMPRESA01" ) // CD EMPRESA01 <enter>

   cSubDir3 := "202505"

   IF .NOT. lIsDir( cSubDir3 )

      lMkDir( cSubDir3 )    // Listo!

   ENDIF

   // RESULTADO(Result):
   // D:\SYISTEMAS\SCANDOC\EMPRESA01\202505" )

   ? cDir + "\" + cSubDir1 + "\" + cSubDir2 + "\" + cSubDir3

RETURN NIL

// FIN / END              <-> kapiabafwh@ gmail.com <->

//----------------------------------------------------------------------------//
// Author: Cristobal Navarro
// Date:   05/11/2019
// Description: Make dir folder recursively even if the previous folders do not exist.
//----------------------------------------------------------------------------//

Function Xd_FullDirMake( cPath )
   local nError    := 0
   local aPaths
   local x
   local nIni      := 1
   local cP        := ""
   
   // REMOVE THIS SAMPLE
   // cPath := "D:\Fivedit\Help\Harbour\mio\tuyo"
   
   if !Empty( cPath )
      cPath := TrueName( cPath )           // For Paths type -> ".\Harbour"
      cPath  := hb_DirSepToOS( hb_DirSepDel( cPath ) )
      aPaths := hb_ATokens( cPath, hb_OsPathSeparator() )
      if Len( aPaths ) > 0
         nIni  := if( ":" $ aPaths[ 1 ], 2, 1 )
         if nIni = 1
            cP    := aPaths[ nIni ] + hb_OsPathSeparator()
         else
            cP    := aPaths[ 1 ] + hb_OsPathSeparator() + aPaths[ nIni ]
         endif
      endif
      xbrowse( aPaths )
      For x := nIni to Len( aPaths )
         if x > nIni
            cP  += hb_OsPathSeparator() + aPaths[ x ]
         endif
         if !hb_vfDirExists( cP )
            nError := hb_vfDirMake( cP )
            if !Empty( nError )
               Exit
            endif
         endif
      Next x
   else
      nError := -1    // Look FError function
   endif
Return nError

#include "FiveWin.ch"
#include "Directry.ch"
#Include "hbcompat.ch"

STATIC lOk := .F., lExist := .F.

FUNCTION Main()

   LOCAL cDir := 'C:/temp/Test'

   ? HB_DirSepToOS( cDir  )

   ? HB_DirSepDel( cDir )

   lExist := hb_VfDirExists( cDir )

   ? lExist

   // nError := hb_vfDirMake( cP )

RETURN NIL

#include "fivewin.ch"

/*
This is a complete, xHarbour-compatible recursive MkDirRecursive() function,
without any hb_ dependencies. It includes the helper functions DirSepDel() and DirSepToOS().

Recommended: maintain a shared hbcompat.prg utility library for frequently used functions like:

- StrTokenize()
- DirSepDel()
- FileOrDirExists()
- MkDirRecursive()
*/

func main

MkDirRecursive( "c:\SISTEMAS\SCANDOC\EMPRESA01\202505" )

return

FUNCTION MkDirRecursive( cPath )
   LOCAL aParts := {}
   LOCAL cPart := ""
   LOCAL i, cSep, cCurrent := ""

   // Normalize the path
   cPath := DirSepToOS( DirSepDel( cPath ) )
   cSep := IF( "WINDOWS" $ Upper( OS() ), "\", "/" )

   // Split path into parts
   aParts := StrTokenize( cPath, cSep )
    
   // Handle absolute paths like "C:"
   IF ":" $ aParts[1]
      cCurrent := aParts[1] + cSep
      i := 2
   ELSE
      cCurrent := aParts[1]
      i := 2
   ENDIF

   FOR i := i TO Len( aParts )
      cPart := aParts[i]
      IF !Empty( cPart )
         cCurrent += cPart
         IF !FileOrDirExists( cCurrent )
            MakeDir( cCurrent )
         ENDIF
      ENDIF
      cCurrent += cSep
   NEXT

RETURN .T.

FUNCTION IsWindows()
   RETURN Upper( OS() ) $ "WINDOWS"

FUNCTION DirSepDel( cPath )
   IF !Empty( cPath ) .AND. Right( cPath, 1 ) $ [ "\", "/" ]
      RETURN Left( cPath, Len( cPath ) - 1 )
   ENDIF
   RETURN cPath

FUNCTION DirSepToOS( cPath )
   LOCAL cSep := IF( OS() == "WINDOWS", "\", "/" )
   RETURN StrTran( cPath, "/", cSep )

FUNCTION StrTokenize( cString, cDelim )
   LOCAL aResult := {}, nPos := 1, nAt := 0

   DO WHILE .T.
      nAt := At( cDelim, SubStr( cString, nPos ) )
      IF nAt == 0
         AAdd( aResult, SubStr( cString, nPos ) )
         EXIT
      ENDIF
      AAdd( aResult, SubStr( cString, nPos, nAt - 1 ) )
      nPos += nAt
   ENDDO

RETURN aResult

FUNCTION FileOrDirExists( cPath )
   LOCAL h

   IF lIsDir( cPath )
      RETURN .T.
   ENDIF

   h := FOpen( cPath )
   IF h != -1
      FClose( h )
      RETURN .T.
   ENDIF

RETURN .F.

* Create nested directory at one go
#pragma BEGINDUMP

#include <shlobj.h>
#include <hbapi.h>

HB_FUNC (SHCREATEDIRECTORY)
{
hb_retni( SHCreateDirectoryEx( NULL, hb_parc( 1 ), NULL ) );
}

// [url]https://forums.fivetechsupport.com/viewtopic.php?p=279895#p279895[/url]

// C:\FWH\SAMPLES\DIROTTO.PRG -> HARBOUR/XHARBOUR:-> Excelent mister Otto.
// MODIFIED by Kapiaba - kapiabafwh @ gmail.com - Joao Santos/Sao Paulo/Brazil.

#Include "fivewin.ch"

/*
This is a complete, xHarbour-compatible recursive MkDirRecursive() function,
without any hb_ dependencies. It includes the helper functions DirSepDel() and
DirSepToOS().

Recommended: maintain a shared hbcompat.prg utility library for frequently used
functions like:

- StrTokenize()
- DirSepDel()
- FileOrDirExists()
- MkDirRecursive()
*/

STATIC lExistDir := .F.

FUNCTION Main()

   LOCAL oDlg , oGet := Array( 5 ), oBtnC, oBtnExit, cPath, cFolder, cTitle, ;
         oFnt, oFont, oSay, oSkinB, aGrad

   SET _3DLOOK ON

   SetBalloon( .T. ) // Balloon shape required for tooltips

   oSkinB := TSkinButton():New()
   oSkinB:nClrBorder0_N := RGB( 249, 194, 179 )
   oSkinB:nClrBorder1_N := RGB( 181, 61, 29 )
   oSkinB:aClrNormal    := { { .50, nRGB( 210, 235, 216 ), nRGB( 210, 235, 216 ) } }

   SkinButtons( oSkinB )

   aGrad   := { { .50, nRGB( 210, 235, 216 ), nRGB( 255, 255, 255 ) } }
   cFolder := "Enter the Name of the Folder/Directory to Create: "
   cPath   := "C:\SYSTEMAS\SCANDOC\EMPRESA01\202505" + SPACE(20)
   cTitle  := cFolder

   DEFINE FONT oFnt    NAME "Ms Sans Serif" SIZE 0, -12 BOLD
   DEFINE FONT oFont   NAME "Ms Sans Serif" SIZE 0, -14 BOLD

   DEFINE DIALOG oDlg SIZE 600, 200 TITLE cTitle PIXEL FONT oFont GRADIENT aGrad

   oDlg:lHelpIcon := .F.

   //    Set( 29, ! Set( 29 ) )
   IF Set( _SET_INSERT, ! Set( _SET_INSERT ) )
      Set( _SET_INSERT, ! Set( _SET_INSERT ) )
   ENDIF

   @ 20, 05 SAY oSay VAR cFolder OF oDlg PIXEL SIZE 300, 20 TRANSPARENT      ;
      COLOR METRO_ORANGE, CLR_WHITE UPDATE

   @ 30, 05 GET oGet[1] VAR cPath SIZE 288, 12 PIXEL OF oDlg UPDATE          ;
      COLOR METRO_CRIMSON, CLR_WHITE VALID( .NOT. EMPTY( cPath ) )

   oGet[1]:cToolTip := cFolder

   // MkDirRecursive( "C:\SYSTEMAS\SCANDOC\EMPRESA01\202505" )
   @ 70, 085  BUTTONBMP oBtnC PROMPT "&Create Folder" SIZE 70, 14 PIXEL OF oDlg ;
      BITMAP "..\bitmaps\16x16\floppy.bmp" TEXTRIGHT                            ;
      ACTION( MkDirRecursive( cPath ), XFOCUS( oBtnExit ) )

   oBtnC:cToolTip := "Create a Folder"

   @ 70, 160 BUTTONBMP oBtnExit PROMPT "&Exit" SIZE 50, 14 PIXEL OF oDlg     ;
      BITMAP "..\bitmaps\16x16\Exit.bmp" TEXTRIGHT                           ;
      ACTION( oDlg:End() ) CANCEL

   oBtnExit:cToolTip := "Exit"

   ACTIVATE DIALOG oDlg CENTERED

   //    Set( 29, ! Set( 29 ) )
   IF Set( _SET_INSERT, ! Set( _SET_INSERT ) )
      Set( _SET_INSERT, ! Set( _SET_INSERT ) )
   ENDIF

   oFnt:End()
   oFont:End()

RETURN NIL

FUNCTION MkDirRecursive( cPath )

   LOCAL aParts := {}
   LOCAL cPart := ""
   LOCAL i, cSep, cCurrent := ""

   // Normalize the path
   cPath := DirSepToOS( DirSepDel( cPath ) )
   cSep  := IF( "WINDOWS" $ Upper( OS() ), "\", "/" )

   // Split path into parts
   aParts := StrTokenize( cPath, cSep )

   // Handle absolute paths like "C:"
   IF ":" $ aParts[ 1 ]

      cCurrent := aParts[ 1 ] + cSep

      i := 2

   ELSE

      cCurrent := aParts[ 1 ]

      i := 2

   ENDIF

   FOR i := i TO Len( aParts )

      cPart := aParts[ i ]

      IF .NOT. Empty( cPart )

         cCurrent += cPart

         IF .NOT. FileOrDirExists( cCurrent )

            MakeDir( cCurrent )

            xBrowse( cCurrent ) // Excelent mister Otto.

         ELSE

            lExistDir := .T.

         ENDIF

      ENDIF

      cCurrent += cSep

   NEXT

   IF lExistDir // := .T.

      MsgStop( "Attention: This folder or directory already exists on the HD.", ;
               "Attention: Could not create folder or directory.             " )

      lExistDir := .F.

   ENDIF

RETURN( .T. )

FUNCTION IsWindows()

RETURN Upper( OS() ) $ "WINDOWS"

FUNCTION DirSepDel( cPath )

   IF .NOT. Empty( cPath ) .AND. Right( cPath, 1 ) $ [ "\", "/" ]

      RETURN Left( cPath, Len( cPath ) - 1 )

   ENDIF

RETURN( cPath )

FUNCTION DirSepToOS( cPath )

   LOCAL cSep := IF( OS() == "WINDOWS", "\", "/" )

RETURN StrTran( cPath, "/", cSep )

FUNCTION StrTokenize( cString, cDelim )

   LOCAL aResult := {}, nPos := 1, nAt := 0

   WHILE( .T. )

      SYSREFRESH()

      nAt := At( cDelim, SubStr( cString, nPos ) )

      IF nAt == 0

         AAdd( aResult, SubStr( cString, nPos ) )

         EXIT

      ENDIF

      AAdd( aResult, SubStr( cString, nPos, nAt - 1 ) )

      nPos += nAt

   ENDDO

RETURN( aResult )

FUNCTION FileOrDirExists( cPath )

   LOCAL h

   IF lIsDir( cPath )

      RETURN( .T. )

   ENDIF

   h := FOpen( cPath )

   IF h != -1

      FClose( h )

      RETURN( .T. )

   ENDIF

RETURN( .F. )
//-------------------------------------------------------------------------//
// As vezes simples SetFocus( oObj ) nao faz um objeto ganhar foco
// neste caso pode apelar para estas duas funcoes a seguir
// Forcar foco para um objeto especifico - Ednaldo Rolim...
//-------------------------------------------------------------------------//
FUNCTION xFocus( oObj )

   xSetFocus( oObj )
   xSetFocus( oObj )

RETURN( .T. )

FUNCTION xSetFocus( oObj )    

   LOCAL _oWnd := oObj:oWnd, _oTempo := ""

   DEFINE TIMER _oTempo INTERVAL 10 OF _oWnd ;
      ACTION ( oObj:SetFocus(), _oTempo:End() )

   ACTIVATE TIMER _oTempo

RETURN( .T. )

// FIN / END