User Module: XCopy Style Backup

Share your advanced PureBasic knowledge/code with the community.
Post Reply
collectordave
Addict
Addict
Posts: 1310
Joined: Fri Aug 28, 2015 6:10 pm
Location: Portugal

User Module: XCopy Style Backup

Post by collectordave »

Just a quick module to provide some Xcopy type backup functionality.

Should be cross platform, all things not are ommitted.

Can anyone test on a MAC?

First the module:-

Code: Select all

DeclareModule Backup
  
  #CreateAndCopy = 1
  #CreateOnly = 2
  #CopyModified = 4
  #ExcludeFiles = 8
  
  Global Flags.i
  Dim ExcludeFiles.s(0)
  Declare Start(TopFromFolder.s,TopToFolder.s)

EndDeclareModule

Module Backup
  
  Global TopFromFolder.s,TopToFolder.s
  
  Global FilesCopied.i = 0,FoldersCreated.i = 0
  Global FromFolder.s,ToFolder.s,Flags.i
  
Procedure CopyObjects(FromFolder.s,ToFolder.s)
  
  Define ExamFolder.i ;Recursive so needs new each time procedure is run
  Define OldFile.s,NewFile.s
  Define TopFld.s = FromFolder ;Recursive so needs new each time procedure is run
  Define DestFolder.s = ReplaceString(TopFld, FromFolder, ToFolder)
  Define CopyThisFile.i
  
  ExamFolder = ExamineDirectory(#PB_Any, FromFolder, "*.*")  

  If ExamFolder > 0
    While NextDirectoryEntry(ExamFolder)
      
      If DirectoryEntryType(ExamFolder) = #PB_DirectoryEntry_File
        
        CopyThisFile = #True
        OldFile = TopFld + DirectoryEntryName(ExamFolder)
        NewFile = ReplaceString(OldFile, topFromFolder, TopToFolder)
        
        If Not Flags &  #CreateAndCopy  ;Copying Files?
          CopyThisFile = #False
        EndIf
        
        If Flags &  #ExcludeFiles ;Is this one excluded?
            For loopc = 0 To ArraySize(Backup::ExcludeFiles())
              If DirectoryEntryName(ExamFolder) = Backup::ExcludeFiles(loopc)
                Debug Backup::ExcludeFiles(loopc)
                CopyThisFile = #False
              EndIf
            Next
        EndIf 
          
        If Flags &  #CopyModified ;Copy only modified files
          If GetFileDate(OldFile, #PB_Date_Modified) <= GetFileDate(Newfile, #PB_Date_Modified)
            CopyThisFile = #False
          EndIf 
        EndIf
          
        If CopyThisFile = #True
          FilesCopied = FilesCopied + 1
          CopyFile(OldFile, newfile)
        EndIf

      Else
        If  DirectoryEntryName(ExamFolder) = "." Or DirectoryEntryName(ExamFolder) = ".."
         ;Ignore these
        Else
          FromFolder = TopFld + DirectoryEntryName(ExamFolder) + "/"
          DestFolder = ReplaceString(FromFolder, TopFromFolder, TopToFolder)
          If FileSize(DestFolder) = -1
            CreateDirectory(DestFolder)
            FoldersCreated = FoldersCreated + 1
          EndIf  
          CopyObjects(FromFolder,ToFolder)
        EndIf
      EndIf
    Wend

    FinishDirectory(ExamFolder)
  EndIf
  
EndProcedure

Procedure Start(FromFolder.s,ToFolder.s)

  TopFromFolder = FromFolder
  TopToFolder = ToFolder
  FilesCopied = 0
  FoldersCreated = 0
  CopyObjects(TopFromFolder,TopToFolder)

  MessageRequester("Finished" ,Str(FoldersCreated) + " Folders Created" + #LF$ + Str(FilesCopied) + " Files Copied")

EndProcedure

EndModule
Then next a small programme to demonstrate:-

Code: Select all

EnableExplicit

IncludeFile "ModBackup.pb"

Global Window_0,Quit.i = 0

Global strFromFolder, btnBrowseFromFolder, strToFolder, btnBrowseToFolder, optAll, optDir, chkMod, chkExc, lstFiles, btnAdd, btnRemove, btnXcopy, btnDone

Global LoopCount.i

Define Event.i

Procedure GetFromFolder()
  
  Define FromFolder.s
  
  FromFolder = PathRequester("Select Folder To Copy", "C:/")
  
  SetGadgetText(strFromFolder,FromFolder)  
  
EndProcedure

Procedure GetToFolder()
  
  Define ToFolder.s
  
  ToFolder = PathRequester("Select Folder To Copy To", "C:/")
  
  SetGadgetText(strToFolder,ToFolder)  
  
EndProcedure

Procedure AddExcludeFile()
  
  Define FileName.s
  FileName = OpenFileRequester("Please choose file to exclude","C:/","All files (*.*)|*.*",0)
  AddGadgetItem(lstFiles,-1,GetFilePart(FileName))

EndProcedure

Procedure RemoveExcludeFile()
  
  RemoveGadgetItem(lstFiles, GetGadgetState(lstFiles))
  
EndProcedure

Procedure SetFlags()
  
  Backup::Flags = 0
  If GetGadgetState(optAll) = 1 ;#PB_Checkbox_Checked
    Backup::Flags = Backup::Flags|Backup::#CreateAndCopy   
  EndIf
  If GetGadgetState(optDir) = 1 ;#PB_Checkbox_Checked
    Backup::Flags = Backup::Flags|Backup::#CreateOnly   
  EndIf
  If GetGadgetState(chkMod) = #PB_Checkbox_Checked
    Backup::Flags = Backup::Flags|Backup::#CopyModified   
  EndIf
  If GetGadgetState(chkExc) = #PB_Checkbox_Checked
    Backup::Flags = Backup::Flags|Backup::#ExcludeFiles   
  EndIf

EndProcedure

Procedure.i CheckFolders()
  
  If Len(Trim(GetGadgetText(strFromFolder))) = 0
    MessageRequester("No from folder specified!", "Please enter or select a from folder.", #PB_MessageRequester_Ok  )
    ProcedureReturn #False
  EndIf
  
  If Len(Trim(GetGadgetText(strtoFolder))) = 0
    MessageRequester("No to folder specified!", "Please enter or select a to folder.", #PB_MessageRequester_Ok  )
    ProcedureReturn #False
  EndIf
  
  If Not ExamineDirectory(#PB_Any, GetGadgetText(strFromFolder), "*.*") 
    MessageRequester("From folder does not exist", "Aborting XCopy operation", #PB_MessageRequester_Ok  )
    ProcedureReturn #False
  EndIf
  
  While  Not ExamineDirectory(#PB_Any, GetGadgetText(strToFolder), "*.*") 
    If MessageRequester("To folder does not exist", "Create Folder?", #PB_MessageRequester_YesNo) = #PB_MessageRequester_Yes
      CreateDirectory(GetGadgetText(strToFolder))
    Else
      ProcedureReturn #False
    EndIf
  Wend

  ProcedureReturn #True
  
EndProcedure

Procedure Event_Handler(Event)
  
  Select Event

    Case #PB_Event_Gadget
      Select EventGadget()
          
        Case chkExc
          If GetGadgetState(chkExc) = #PB_Checkbox_Checked
            DisableGadget(btnAdd, #False)
            DisableGadget(btnRemove, #False)           
          Else
            DisableGadget(btnAdd, #True)
            DisableGadget(btnRemove, #True)            
          EndIf

        Case  btnAdd
          AddExcludeFile()
          
        Case btnRemove
          RemoveExcludeFile()
          
        Case btnDone
          End
          
        Case btnBrowseFromFolder
          GetFromFolder()
          
        Case btnBrowseToFolder
          GetToFolder()
          
        Case btnXcopy
          SetFlags()
          ReDim Backup::ExcludeFiles(CountGadgetItems(lstFiles))
          For LoopCount = 0 To CountGadgetItems(lstFiles)
            Backup::ExcludeFiles(LoopCount) = GetGadgetItemText(lstFiles, LoopCount)
          Next LoopCount
          If CheckFolders()
            Backup::Start(GetGadgetText(strFromFolder),GetGadgetText(strToFolder))  
          EndIf
          
      EndSelect ;EventGadget()
      
  EndSelect ;Event
  
EndProcedure

Window_0 = OpenWindow(#PB_Any, 10, 10, 450, 290, "Small XCopy", #PB_Window_SystemMenu)
  TextGadget(#PB_Any, 10, 10, 80, 20, "From Folder")
  strFromFolder = StringGadget(#PB_Any, 90, 10, 320, 20, "")
  btnBrowseFromFolder = ButtonGadget(#PB_Any, 410, 10, 30, 20, "...")
  GadgetToolTip(btnBrowseFromFolder, "Browse for From Folder")
  TextGadget(#PB_Any, 10, 40, 80, 20, "To Folder")
  strToFolder = StringGadget(#PB_Any, 90, 40, 320, 20, "")
  btnBrowseToFolder = ButtonGadget(#PB_Any, 410, 40, 30, 20, "...")
  GadgetToolTip(btnBrowseToFolder, "Browse For To Folder")
  optAll = OptionGadget(#PB_Any, 10, 70, 310, 20, "Create subdirectories and copy files")
  SetGadgetState(optAll, 1)
  optDir = OptionGadget(#PB_Any, 10, 100, 310, 20, "Create subdirectories but don't copy files")
  chkMod = CheckBoxGadget(#PB_Any, 10, 130, 310, 20, "Copy newer files only")
  chkExc = CheckBoxGadget(#PB_Any, 10, 160, 140, 20, "Exclude named files")
  lstFiles = ListViewGadget(#PB_Any, 150, 160, 160, 110)
  GadgetToolTip(lstFiles, "Files which will not be copied")
  btnAdd = ButtonGadget(#PB_Any, 70, 190, 60, 20, "Add")
  DisableGadget(btnAdd, #True)
  btnRemove = ButtonGadget(#PB_Any, 70, 220, 60, 20, "Remove")
  DisableGadget(btnRemove, #True) 
  btnXcopy = ButtonGadget(#PB_Any, 320, 200, 120, 30, "XCopy")
  btnDone = ButtonGadget(#PB_Any, 320, 240, 120, 30, "Done")
  
Repeat
  
  Event = WaitWindowEvent()
  Event_Handler(Event)
  
Until event = #PB_Event_CloseWindow
Last edited by collectordave on Fri Jan 22, 2016 7:09 am, edited 2 times in total.
Any intelligent fool can make things bigger and more complex. It takes a touch of genius — and a lot of courage to move in the opposite direction.
Top
Baldrick
Addict
Addict
Posts: 860
Joined: Fri Jul 02, 2004 6:49 pm
Location: Australia

Re: Pure Basic XCopy

Post by Baldrick »

Just a quick module to provide some Xcopy type backup functionality.

Should be cross platform, all things not are ommitted.

Can anyone test on a MAC?
Seems to work OK, but is not crossplatform.

I added to your module code:

Code: Select all

  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    #PathDelimiter="\"
  CompilerElse
    #PathDelimiter="/"
  CompilerEndIf
& changed 1 line from:

Code: Select all

          FromFolder = TopFld + DirectoryEntryName(ExamFolder) + "\"
to:

Code: Select all

          FromFolder = TopFld + DirectoryEntryName(ExamFolder)+#PathDelimiter
Top
collectordave
Addict
Addict
Posts: 1310
Joined: Fri Aug 28, 2015 6:10 pm
Location: Portugal

Re: Pure Basic XCopy

Post by collectordave »

Thanks Baldrick.

Changed mine to match
Any intelligent fool can make things bigger and more complex. It takes a touch of genius — and a lot of courage to move in the opposite direction.
Top
User avatar
TI-994A
Addict
Addict
Posts: 2741
Joined: Sat Feb 19, 2011 3:47 am
Location: Singapore
Contact:
Contact TI-994A

Re: Pure Basic XCopy

Post by TI-994A »

Baldrick wrote:...work OK, but is not crossplatform.

I added to your module code:

Code: Select all

  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    #PathDelimiter="\"
  CompilerElse
    #PathDelimiter="/"
  CompilerEndIf
That's not really necessary. Just use the forward slash; it works with Windows as well. :wink:
Texas Instruments TI-99/4A Home Computer: the first home computer with a 16bit processor, crammed into an 8bit architecture. Great hardware - Poor design - Wonderful BASIC engine. And it could talk too! Please visit my YouTube Channel :D
Top
collectordave
Addict
Addict
Posts: 1310
Joined: Fri Aug 28, 2015 6:10 pm
Location: Portugal

Re: User Module: XCopy Style Backup

Post by collectordave »

Thanks TI-994A

Code in first post updated with "/"
Any intelligent fool can make things bigger and more complex. It takes a touch of genius — and a lot of courage to move in the opposite direction.
Top
Post Reply

Return to “Tricks 'n' Tips”