Folder archiver (pretty quick)

[Seymour Clufley]

Two days ago my hard drive died. It contained, amongst other things, a project I've been working on for 18 months.

There's a happy ending to the story. I sent the drive to a data recovery company, paid them £590, and got all my data back!

However, the code posted in the OP will ensure I never have to pay £590 again!

Recovering the data means that, among many other things, I have the new version of PureSVG that I was working on. After some bug checking, I'll post it.

[rsts]

Thanks for sharing this.

(and reminding me it's time for a backup)

cheers

[Seymour Clufley]

Thanks for sharing this.

You're very welcome.

(and reminding me it's time for a backup)

These last two days have been f***ing awful. Believe me, it's always time for a backup!

[Seymour Clufley]

Here's a version that supports multiple source folders. The "reporting functions" are more spread about in this version so if you only need to back up one folder, use the code in first post as it's easier to customise.

Code: Select all

Macro R(t)
	MessageRequester("Archive program reporting...",t,0)
EndMacro

Macro EnsureThisEnd(t,endd)
	
	If endd<>""
		If Right(t,Len(endd)) <> endd
			t+endd
		EndIf
	EndIf
	
EndMacro

Macro EnsureThisNotEnd(t,endd)
	
	If Right(t,Len(endd)) = endd
		;snipped.s = Len(t)-Len(endd)
		;t = Left(t,snipped)
		t = Left(t,Len(t)-Len(endd))
	EndIf
	
EndMacro

Macro EnsureThisStart(t,start)
	
	If start<>""
		If Left(t,Len(start)) <> start
			t = start+t
		EndIf
	EndIf
	
EndMacro

Macro EnsureThisNotStart(t,start)
	
	If Left(t,Len(start)) = start
		t = Mid(t,Len(start)+1,Len(t))
	EndIf
	
EndMacro

Macro IsDrivePath(path)
	(Len(path)=3 And Right(path,2)=":\")
EndMacro

Procedure.b EnsureFolder(folder.s)
	
	If FileSize(folder)=-2
		ProcedureReturn #True
	Else
		ProcedureReturn CreateDirectory(folder)
	EndIf
	
EndProcedure

Procedure.f Defeat(a.f,b.f)
  
  If a<b
      ProcedureReturn a
  Else
      ProcedureReturn b
  EndIf
  
EndProcedure

Procedure.s GetFieldsFromStart(str.s,level.l,d.s)
	
	fields = CountString(str,d)
	accum.s
	
	For a = 1 To Defeat(level,fields)
		accum+StringField(str,a,d)+d
	Next a
	
	ProcedureReturn accum
	
EndProcedure

Procedure.b EnsureFolderPath(path.s)
	
	If FileSize(path)=-2
		ProcedureReturn #True
	EndIf
	
	EnsureThisEnd(path,"\")
	shortpath.s
	levels = CountString(path,"\")
	If levels>1
		For f = 1 To levels
			shortpath = GetFieldsFromStart(path,f,"\")
			If IsDrivePath(shortpath)
				success+1
				Continue
			EndIf
			success+EnsureFolder(shortpath)
		Next f
	EndIf
	
	If success=levels
		ProcedureReturn #True
	Else
		ProcedureReturn #False
	EndIf
	
EndProcedure

Procedure.b AppendToFile(filename.s,t.s)
	;R("APPEND TO FILE."+c13+c13+filename+c13+c13+t)
	c10.s = Chr(10)
	c13.s = Chr(13)
	If Not EnsureFolderPath(GetPathPart(filename)) : R("CAN'T CREATE FOLDER PATH: "+filename) : ProcedureReturn #False : EndIf
	
	t = RemoveString(t,c10)
	t = ReplaceString(t,c13,c13+c10)
	
	If FileSize(filename)>-1
		;R("FILE EXISTS")
		file = OpenFile(#PB_Any,filename)
		If file
			loaf = Lof(file)
			If loaf
				FileSeek(file,loaf-1)
				If ReadAsciiCharacter(file)<>10
					EnsureThisStart(t,c13+c10)
				EndIf
				FileSeek(file,loaf)
			EndIf
			WriteString(file,t)
			CloseFile(file)
			ProcedureReturn #True
		EndIf
	Else
		f = CreateFile(#PB_Any,filename)
		If f
			WriteStringN(f,t)
			CloseFile(f)
			ProcedureReturn #True
		EndIf
	EndIf
	
EndProcedure

Procedure.s CorrectPluralate(num.i,singular.s,plural.s,space.b,includenumeral.b)
	
	If num=1 And num>0
		t.s = singular
	Else
		t = plural
	EndIf
	
	If space
		t = " "+t
	EndIf
	If includenumeral
		t = Str(num)+t
	EndIf
	
	ProcedureReturn t
	
EndProcedure

Procedure.s MonthName(num.b)
  
  Select num
      Case 1
          ProcedureReturn "January"
      Case 2
          ProcedureReturn "February"
      Case 3
          ProcedureReturn "March"
      Case 4
          ProcedureReturn "April"
      Case 5
          ProcedureReturn "May"
      Case 6
          ProcedureReturn "June"
      Case 7
          ProcedureReturn "July"
      Case 8
          ProcedureReturn "August"
      Case 9
          ProcedureReturn "September"
      Case 10
          ProcedureReturn "October"
      Case 11
          ProcedureReturn "November"
      Case 12
          ProcedureReturn "December"
  EndSelect
  
EndProcedure
Procedure.s Hour24To12(hour.i)
  
  suffix.s
  Select hour
      Case 0 To 11, 24
          suffix="am"
          If hour=24
              hour-12
          EndIf
      Case 12 To 23
          suffix="pm"
          If hour>12
              hour-12
          EndIf
  EndSelect
  
  ProcedureReturn Str(hour)+"|"+suffix+"|"
  
EndProcedure
Procedure.s ToCoolDate(dl,date.b,time.b)
  
  datestring.s
  timestring.s
  
  ;DT_LongToDT(datelong,@dt.dtsplit)
  month$ = Left(MonthName(Month(dl)),3)
  
  a$ = Hour24To12(Hour(dl))
  domini$ = StringField(a$,2,"|")
  hour.i = Val(StringField(a$,1,"|"))
  If time
      timestring = RSet(Str(hour),2,"0")+":"+RSet(Str(Minute(dl)),2,"0")+domini$
  EndIf
  If date
      datestring = RSet(Str(Day(dl)),2,"0")+"/"+month$+"/"+Str(Year(dl))
  EndIf
  
  info.s
  If date
      info + datestring
      If time
          info+" @ "
      EndIf
  EndIf
  If time
      info + timestring
  EndIf
  
  ; date @ time
  ProcedureReturn info
  
EndProcedure



Structure FolderEntry
	name.s
	is_folder.b
EndStructure

Procedure.i List_GetFilesInFolder(folder.s,recursive.b,List farr.FolderEntry())
	
	EnsureThisEnd(folder,"\")
	thisfilename.s
	;R("FOLDER: "+folder)
	d = ExamineDirectory(#PB_Any,folder,"")
	If d
		While NextDirectoryEntry(d)
			thisfilename = DirectoryEntryName(d)
			If RemoveString(thisfilename,".")
				;Debug "thisfilename: "+thisfilename
				Select DirectoryEntryType(d) 
					Case #PB_DirectoryEntry_File
						AddElement(farr())
						farr()\name = folder+thisfilename
						itemsinthisfolder+1
					Case #PB_DirectoryEntry_Directory
						AddElement(farr())
						farr()\name = folder+thisfilename
						farr()\is_folder = #True
						
						If recursive
							itemsinthisfolder + List_GetFilesInFolder(folder+thisfilename,#True,farr())
						EndIf
				EndSelect
			EndIf
		Wend
		FinishDirectory(d)
	EndIf
	
	;R("itemsinthisfolder: "+Str(itemsinthisfolder))
	
	ProcedureReturn itemsinthisfolder
	
EndProcedure

Procedure.s ReplacePath(fn.s,path1.s,path2.s)
	EnsureThisNotStart(fn,path1)
	fn = path2+fn
	ProcedureReturn fn
EndProcedure

Macro EnsureNoExtraneousFiles(fn,copyfol,origfol)
	
	ForEach fn()
		;R("FN: "+fn())
		copyfn.s = fn()\name
		twinfn.s = ReplacePath(copyfn,copyfol,origfol)
		If fn()\is_folder
			If FileSize(twinfn)<>-2
				;R("OBSOLETE DIRECTORY IN ARCHIVE FOLDER:"+c13+copyfn)
				DeleteDirectory(copyfn,"*.*",#PB_FileSystem_Recursive|#PB_FileSystem_Force)
				bk()\obsolete_folders+1
			EndIf
		Else
			If FileSize(twinfn)<0
				;R("OBSOLETE FILE IN ARCHIVE FOLDER:"+c13+copyfn)
				DeleteFile(copyfn)
				bk()\obsolete_files+1
			EndIf
		EndIf
	Next
	
EndMacro

Macro UpdatePresentFiles(fn,copyfol,origfol)
	
	ForEach fn()
		;R("FN: "+fn())
		If fn()\is_folder : Continue : EndIf
		copyfn.s = fn()\name
		origfn.s = ReplacePath(copyfn,copyfol,origfol)
		doit.b = #False
		If FileSize(origfn)<0 And FileSize(copyfn)>-1
			; file doesn't exist in master folder
			DeleteFile(copyfn)
			bk()\obsolete_files+1
			Continue
		EndIf
		If FileSize(copyfn) <> FileSize(origfn)
			doit=#True
		Else
			If GetFileDate(origfn,#PB_Date_Modified) > GetFileDate(copyfn,#PB_Date_Modified)
				doit=#True
			EndIf
		EndIf
		If doit
			DeleteFile(copyfn)
			CopyFile(origfn,copyfn)
			bk()\updated_files+1
		EndIf
	Next
	
EndMacro

Macro AddMissingFiles(origfilename,origfol,copyfol)
	
	ForEach origfilename()
		;R("FN: "+fn())
		origfn.s = origfilename()\name
		copyfn.s = ReplacePath(origfn,origfol,copyfol)
		If origfilename()\is_folder
			If FileSize(copyfn)<>-2
				; folder doesn't exist in archive folder
				;EnsureFolderPath(GetPathPart(copyfn))
				;CopyFile(origfn,copyfn)
				CreateDirectory(copyfn)
				bk()\new_folders+1
			EndIf
		Else
			If FileSize(copyfn)=-1
				; file doesn't exist in archive folder
				EnsureFolderPath(GetPathPart(copyfn))
				CopyFile(origfn,copyfn)
				bk()\new_files+1
			EndIf
		EndIf
	Next
	
EndMacro

Structure CopyDestination
	locale.s
	obsolete_folders.i
	obsolete_files.i
	updated_folders.i
	updated_files.i
	new_folders.i
	new_files.i
EndStructure




Global NewList fa.s()
;-------- SET FOLDERS TO BE BACKED UP
AddElement(fa()) : fa() = "C:\family photos\"
AddElement(fa()) : fa() = "C:\diary entries\"


Global NewList bk.CopyDestination()
;-------- SET BACKUP FOLDERS...
; for maximum safety, these should be on different hard drives
AddElement(bk()) : bk()\locale = "E:\BACKUPS\"
AddElement(bk()) : bk()\locale = "P:\BACKUPS\"
AddElement(bk()) : bk()\locale = "X:\BACKUPS\"


;-------- SET REPORT FILE...
archivereportfile.s = "C:\archive-info.txt"




c13.s = Chr(13)
NewList origfilename.FolderEntry()
NewList copyfn.FolderEntry()

ForEach bk()
	EnsureThisEnd(bk()\locale,"\")
Next


AppendToFile(archivereportfile,c13+c13+"--------------------------------------------------"+c13+ToCoolDate(Date(),#True,#True)+c13)


ForEach fa()
	masterlocale.s = fa()
	
	If masterlocale="" Or FileSize(masterlocale)<>-2
		R("ERROR. Master locale "+Chr(34)+masterlocale+Chr(34)+" not found.")
		Continue
	EndIf
	EnsureThisEnd(masterlocale,"\")
	
	
	ClearList(origfilename())
	List_GetFilesInFolder(masterlocale,#True,origfilename())
	If Not ListSize(origfilename())
		R("No files in master locale.")
		Continue
	EndIf
	
	
	dashed_masterlocale.s = masterlocale
	dashed_masterlocale = RemoveString(dashed_masterlocale,":")
	dashed_masterlocale = ReplaceString(dashed_masterlocale,"\","-")
	EnsureThisNotEnd(dashed_masterlocale,"-")
	dashed_masterlocale+"\"
	
	
	ClearList(copyfn())
	;- DO IT...
	ForEach bk()
		copylocale.s = bk()\locale+dashed_masterlocale
		;R("COPYING FROM:"+c13+origlocale+c13+"TO:"+c13+copylocale)
		EnsureFolderPath(copylocale)
		
		ClearList(copyfn())
		items = List_GetFilesInFolder(copylocale,#True,copyfn())
		
		EnsureNoExtraneousFiles(copyfn,copylocale,masterlocale)
		UpdatePresentFiles(copyfn,copylocale,masterlocale)
		AddMissingFiles(origfilename,masterlocale,copylocale)	
	Next ; next copying locale
	
	
	;- FORM REPORT...
	;arcinfo.s = "-------------------------"+c13
	arcinfo.s = c13
	arcinfo + " MASTER: "+masterlocale+c13
	ForEach bk()
		;arcinfo + "    COPY: "+bk_locale() + c13
		arcinfo + "ARCHIVE: "+bk()\locale + c13
		changesum = bk()\obsolete_files+bk()\obsolete_folders+bk()\new_files+bk()\new_folders+bk()\updated_files+bk()\updated_folders
		If changesum
			If bk()\obsolete_folders
				arcinfo + "               "+CorrectPluralate(bk()\obsolete_folders,"obsolete folder","obsolete folders",#True,#True)+" deleted"+c13
			EndIf
			If bk()\updated_folders
				arcinfo + "               "+CorrectPluralate(bk()\updated_folders,"folder","folders",#True,#True)+" updated"+c13
			EndIf
			If bk()\new_folders
				arcinfo + "               "+CorrectPluralate(bk()\new_folders,"new folder","new folders",#True,#True)+" added"+c13
			EndIf
			If bk()\obsolete_files
				arcinfo + "               "+CorrectPluralate(bk()\obsolete_files,"obsolete file","obsolete files",#True,#True)+" deleted"+c13
			EndIf
			If bk()\updated_files
				arcinfo + "               "+CorrectPluralate(bk()\updated_files,"file","files",#True,#True)+" updated"+c13
			EndIf
			If bk()\new_files
				arcinfo + "               "+CorrectPluralate(bk()\new_files,"new file","new files",#True,#True)+" added"+c13
			EndIf
		Else
			arcinfo + "               [no changes]"+c13
		EndIf
	Next
	AppendToFile(archivereportfile,arcinfo)
Next

RunProgram(archivereportfile)

[rsts]

great.

These last two days have been f***ing awful. Believe me, it's always time for a backup!

I'm all set now. Thanks to you, it will happen automatically at midnight.

fyi - a couple of the messagerequesters won't work as written due to c13 not being a string. They're commented out, but if activated give an error.

Thanks again for sharing.

cheers

[Fluid Byte]

Two days ago my hard drive died. It contained, amongst other things, a project I've been working on for 18 months. The last backup was made 7 weeks ago. I should have backed it up more regularly, but being obsessive I was always working on the project and couldn't step back to copy 20gb of data every day.

20GB of data every day? What are you doing?

You only need to backup new or modified files. Get Beyond Compare, create a "Folder Sync", set source/destination folder and set the combox to "Mirror to Right".

This way I backup all my personal files, samples and Outlook mail archive to three different discs.
If you are worried about compression, screw it. Just wastes time and hard drives are big these days.

[Seymour Clufley]

fyi - a couple of the messagerequesters won't work as written due to c13 not being a string. They're commented out, but if activated give an error.

c13 is just a shorthand for Chr(13). Set that as a global variable.

20GB of data every day? What are you doing?

It's not new data. I meant it would take ages to copy the whole 20gb folder each day - hence this code, which only copies the files which have been changed.

You only need to backup new or modified files.

That's what this code does.

[Fluid Byte]

I still recommend Beyond Compare though but I will give your code a try

[Kwai chang caine]

I use all time comparing folder software like Vice versa
http://www.tgrmn.com/index.htm?camp=goo ... 4wodAUNV4Q

The difficulty, is really to see if the file have changed, even a bit....
With Vice versa, it's really long to see several giga of files, if you select CRC mode

So thank you very much for sharing.
It's useful code

[blueznl]

My backup mechanism is actually awfully simple. Well, perhaps it's not, but it works

1. I use the CodeSync feature of CodeCaddy *a lot* but then again, I work at home on my Dell XPS as well as elsewhere on either a netbook or the company laptop. Instead of a USB stick I tend to use my BlackBerry as the transport medium. CodeSync only copies those files that have a newer date, and it also verifies CodeCaddy's .CDY files to avoid conflicts and accidental overwrites of source. That, together with numbered backups, has saved me from any source losses over the last couple of years.

2. I have multiple HDD's in my machine. A batch file 'backup_quick' copies essential stuff to another harddrive. It uses XCOPY with a few parameters as well as 7ZIP for a bunch of compressend and passworded folders.

3. I have three external HDD's. One's in my computer bag with my laptop all the time, one's in a locked drawer at the company I work for, and one's at home, stored securely. Almost at random I store an image as well as a copy of all data on them. Not of all data, mind you, as there's simply not enough capacity on those external drives

What I actually did was create a few 'semaphore' files on the external harddrives, and have my backup script 'backup_full' detect them and copy stuff accordingly.

Here's a few bits from the batch file:

...
...
...

:stage_1
call v:\batch\backup_quick.bat

:check_k
if not exist k:\dev2_xps710\stage_2.txt goto check_q
k:
goto stage_2
:check_q
if not exist q:\dev2_xps710\stage_2.txt goto check_r
q:
goto stage_2
:check_r
if not exist r:\dev2_xps710\stage_2.txt goto check_s
r:
goto stage_2
:check_s
if not exist s:\dev2_xps710\stage_2.txt goto check_t
s:
goto stage_2
:check_t
if not exist t:\dev2_xps710\stage_2.txt goto check_u
t:
goto stage_2
:check_u
if not exist u:\dev2_xps710\stage_2.txt goto stage_1_error
u:
goto stage_2

:stage_1_error

rem *** ERROR - destination not found ***

goto end



:stage_2

rem *** STAGE 2 - minimal backup to external device ***

mkdir \dev2_xps710
mkdir \dev2_xps710\backup
mkdir \dev2_xps710\backup\new
mkdir \dev2_xps710\backup\old
xcopy f:\backup\new \dev2_xps710\backup\new /D /E /F /Y
xcopy f:\backup\old \dev2_xps710\backup\old /D /E /F /Y

if not exist \dev2_xps710\stage_3.txt goto done



:stage_3

rem *** STAGE 3 - data and documents to external device ***

7z u -r -tzip -pxxxxxxxx \dev2_xps710\backup\outlookexpres.zip v:\backup\outlookexpress\*

...
...
...

[IdeasVacuum]

Hello chaps

I have used SyncBackSE for a few years now, very simple set-up, does the job extremely well.

http://www.2brightsparks.com/syncback/s ... tures.html

There is also a capable freeware version:

http://www.2brightsparks.com/freeware/freeware-hub.html

[cas]

For anyone here with Windows 7, if you don't use Backup and Restore then i strongly suggest you to do so. It is nicely integrated with Explorer (Previous Versions tab in file/folder Properties).
http://lifehacker.com/5144757/first-loo ... ore-center

[rsts]

Outside of being backup solutions, are any of those written in PureBasic, or have we strayed off-topic?

cheers

[yrreti]

Seymour Clufley, thanks for the code!
I can relate to what happened to you, as I just lost my 'D' drive and a lot of my
programming source code as well as other programs. I had backed up some
parts, but not as recent as I should have. I purchased a program from the CHENGDU YIWO
Development company called EASEUS Data Recovery Wizard, and I was able to recover most
of the stuff. http://www.easeus.com But like you, sometimes you get too busy and forget
to do it. I will definitely be putting your code to use. Thank you very much for sharing it.

[PB]

> I purchased a program from the CHENGDU YIWO Development company
> called EASEUS Data Recovery Wizard

I've used this AND a freeware app called Recuva, and Recuva was able
to find and restore all the files that Data Recovery Wizard did. So, just
mentioning this to save others some money in case they ever need it.