RSBasic Backup Desktop download tool

Applications, Games, Tools, User libs and useful stuff coded in PureBasic
User avatar
Zebuddi123
Enthusiast
Enthusiast
Posts: 794
Joined: Wed Feb 01, 2012 3:30 pm
Location: Nottinghamshire UK
Contact:

RSBasic Backup Desktop download tool

Post by Zebuddi123 »

Hi to All With permission from RSBasic today here is a Desktop tool to download from his repository. RSBasic requests that the following code is not altered and used in anyway to download multiple files or the whole of the repository. The code may be used under the above conditions with the following repository "http://www.rsbasic.de/backups/".

Compile Options: Create ThreadSafe Executable !!!!
Require`s Droopy Lib else Code in 2nd Post to Fangbeast include Droopy`s Procedure.

Clicking on the ListIconGadget column headers sorts the name or date fields, LMD click on an element downloads the selected file to the current users selected download folder.

Zebuddi. :)

Code: Select all

EnableExplicit

CompilerIf Not #PB_Compiler_Thread
  MessageRequester("Hint", "Enable threadsafe!")
  End
CompilerEndIf

InitNetwork()

Global Window_0
Global StatusBar_Window_0
Global Window_0_ListIcon

Structure dat
	name.s
	size.s
	date.s
	rdate.i
	dwll.s
EndStructure

Global NewList dat.dat()
 
Global gThread.i, gThread2.i, gDownloadFinished.b, gBackup_Url$ = "http://www.rsbasic.de/backups/"

Define Event.i, url$, UserDownLoadFolder$

Procedure OnListIconCLick(WindowID, message, wParam, lParam)
	Protected Result, *nmITEM.NMITEMACTIVATE
	Result = #PB_ProcessPureBasicEvents 
	Select message
		Case #WM_NOTIFY
			*nmITEM.NMITEMACTIVATE = lParam
			Select *nmITEM\hdr\code
				Case #LVN_COLUMNCLICK ;/ HeaderClick
					If *nmITEM\hdr\hwndFrom = GadgetID(Window_0_ListIcon) ;/ ListIconGadget
						With dat()
							If gDownloadFinished = 1
								If *nmITEM\iSubItem = 0
									SortStructuredList(dat(),#PB_Sort_Ascending, OffsetOf(dat\name), TypeOf(dat\name))
									ClearGadgetItems(Window_0_ListIcon)
									ForEach dat()
										AddGadgetItem(Window_0_ListIcon, -1, \name+Chr(10)+\date+Chr(10)+\dwll)
									Next
								ElseIf *nmITEM\iSubItem = 1
									SortStructuredList(dat(), #PB_Sort_Descending, OffsetOf(dat\rdate) ,TypeOf(dat\rdate))
									ClearGadgetItems(Window_0_ListIcon)
									ForEach dat()
										AddGadgetItem(Window_0_ListIcon, -1, \name+Chr(10)+\date+Chr(10)+\dwll)
									Next
								EndIf
							EndIf
						EndWith	
					EndIf	
					Result = #True
			EndSelect
	EndSelect
	ProcedureReturn Result 
EndProcedure

Procedure DownloadFileUpdater(dummy.i)
	Protected i, dot$, t$ = "|,/,-,\,|,/,-,\,", c 
	Repeat
		c+1
		dot$ = StringField(t$, c, ",")
		SetWindowTitle(Window_0, "Downloading File "+dot$)
		Delay(60)
		If c=8 : c=0 : 	EndIf
	Until gDownloadFinished = 1 
EndProcedure

Procedure ProcessFile(dummy.i)
	Protected rsb$=GetTemporaryDirectory()+"rsb.txt" ; tempory copy of the download url$ source
	Protected ThisLine$, nbr.i, i.i, p.i  
	If ReceiveHTTPFile(gBackup_Url$, rsb$)
		Protected regex_all.i = CreateRegularExpression(#PB_Any, "<td>.*?a></td>")
		Protected regex_list.i = CreateRegularExpression(#PB_Any, "<td>.*?</td>")
		Protected regex_dlink.i = CreateRegularExpression(#PB_Any, Chr(34) + ".*" + Chr(34))
		Protected Dim t$(0)  
		Protected Dim l$(0)			
		Protected Dim dlink$(0)
		SetWindowTitle(Window_0, "Downloading File")	
		If ReadFile(0,rsb$)
			While Not Eof(0)
				ThisLine$ + ReadString(0, ReadStringFormat(0))
			Wend
			CloseFile(0)
			nbr = ExtractRegularExpression(regex_all, ThisLine$, t$())
		EndIf
		gDownloadFinished = 1 
		SetWindowTitle(Window_0, "Processing Downloaded File")	
		With dat()
			For i=0 To nbr-1
				ExtractRegularExpression(regex_list, t$(i), l$())
				AddElement(dat())
				For p = 0 To 3
					l$(p) = RemoveString(l$(p), "<td>") 
					l$(p) = RemoveString(l$(p), "</td>")
				Next	
				\name = l$(0)
				\size = l$(1)
				\date = l$(2)
				\rdate = Date( Val(StringField(\date, 3, ".")), Val(StringField(\date, 2 ,".")),Val(StringField(\date, 1 , ".")), 0, 0, 0)
				ExtractRegularExpression(regex_dlink, l$(3),dlink$())
				\dwll = dlink$(0)	
			Next	
			SortStructuredList(dat(), #PB_Sort_Descending, OffsetOf(dat\rdate) ,TypeOf(dat\rdate))
			
			ForEach dat()
				AddGadgetItem(Window_0_ListIcon, -1, \name+Chr(10)+\date+Chr(10)+\dwll)
			Next
			
			StatusBarText(StatusBar_Window_0,1,Str(ListSize(dat())))
			
		EndWith
	Else
		MessageRequester("Download Error", GetLastErrorAsText(GetLastError()))
		End
	EndIf
	SetWindowTitle(Window_0, "RS BackUp Downloader            Processing Complete")
	FreeArray(l$())
	FreeArray(t$())
	FreeArray(dlink$())
	FreeRegularExpression(regex_all)
	FreeRegularExpression(regex_dlink)
	FreeRegularExpression(regex_list)
	gDownloadFinished = 1
EndProcedure

Procedure OpenWindow_Window_0()
	Window_0 = OpenWindow(#PB_Any, 521, 101, 667, 400, "RS BackUp Downloader", #PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_TitleBar|#PB_Window_ScreenCentered)
	If Window_0
		Window_0_ListIcon = ListIconGadget(#PB_Any, 0, 0, 667, 377, "File", 200, #PB_ListIcon_AlwaysShowSelection|#PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect)
		AddGadgetColumn(Window_0_ListIcon, 1,"Date",100)
		AddGadgetColumn(Window_0_ListIcon, 2,"Download Link",367)
		StatusBar_Window_0 = CreateStatusBar(#PB_Any, WindowID(Window_0))
		If StatusBar_Window_0
			AddStatusBarField(100) : AddStatusBarField(100): AddStatusBarField(467)
			StatusBarText(StatusBar_Window_0,0,"Entries: ")
		EndIf
	EndIf
EndProcedure

OpenWindow_Window_0()

gThread = CreateThread(@ProcessFile(),0)
gThread2 = CreateThread(@DownloadFileUpdater(),0)
SetWindowCallback(@OnListIconCLick(), Window_0)
Repeat
	Event = WaitWindowEvent()
	Select Event
		Case #PB_Event_Gadget
			Select EventGadget()
				Case Window_0_ListIcon
					Select EventType()
						Case #PB_EventType_LeftDoubleClick 
							url$ = RemoveString(GetGadgetItemText(Window_0_ListIcon, GetGadgetState(Window_0_ListIcon),2),Chr(34))
							UserDownLoadFolder$ = "C:\Users\"+UserName()+"\Downloads\"+GetFilePart(url$)
							If  ReceiveHTTPFile(url$,UserDownLoadFolder$)
								StatusBarText(StatusBar_Window_0, 2, "Downloading File "+GetFilePart(url$))
							Else
								StatusBarText(StatusBar_Window_0, 2, "Error Downloading File "+Str(GetLastError_()))
							EndIf	
					EndSelect
			EndSelect
		Case #PB_Event_CloseWindow
			Select EventWindow()  
				Case Window_0
					CloseWindow(Window_0)
					Window_0 = 0
					Break
			EndSelect
	EndSelect
ForEver

FreeList(dat())

Last edited by Zebuddi123 on Mon Aug 24, 2015 2:44 pm, edited 2 times in total.
malleo, caput, bang. Ego, comprehendunt in tempore
User avatar
Fangbeast
PureBasic Protozoa
PureBasic Protozoa
Posts: 4749
Joined: Fri Apr 25, 2003 3:08 pm
Location: Not Sydney!!! (Bad water, no goats)

Re: RSBasic Backup Desktop download tool

Post by Fangbeast »

WHen running, I get the following error.

Line 113: GetLastErrorAsText() is not a function, array, list, map or macro.
Amateur Radio, D-STAR/VK3HAF
User avatar
Zebuddi123
Enthusiast
Enthusiast
Posts: 794
Joined: Wed Feb 01, 2012 3:30 pm
Location: Nottinghamshire UK
Contact:

Re: RSBasic Backup Desktop download tool

Post by Zebuddi123 »

Hi Fangbeast sorry about that :oops: requires droopy lib`s GetLastErrorAsText(), GetLastError(). I`ve included the procedures in the following code with __ double under score prepended for those who dont have Droopys Lib.

Compile in ThreadSafe Mode !!!!

Zebuddi. :)

Code: Select all

EnableExplicit

CompilerIf Not #PB_Compiler_Thread
  MessageRequester("Hint", "Enable threadsafe!")
  End
CompilerEndIf

InitNetwork()

Global Window_0
Global StatusBar_Window_0
Global Window_0_ListIcon

Structure dat
	name.s
	size.s
	date.s
	rdate.i
	dwll.s
EndStructure

Global NewList dat.dat()
 
Global gThread.i, gThread2.i, gDownloadFinished.b, gBackup_Url$ = "http://www.rsbasic.de/backups/"

Define Event.i, url$, UserDownLoadFolder$

Procedure OnListIconCLick(WindowID, message, wParam, lParam)
	Protected Result, *nmITEM.NMITEMACTIVATE
	Result = #PB_ProcessPureBasicEvents 
	Select message
		Case #WM_NOTIFY
			*nmITEM.NMITEMACTIVATE = lParam
			Select *nmITEM\hdr\code
				Case #LVN_COLUMNCLICK ;/ HeaderClick
					If *nmITEM\hdr\hwndFrom = GadgetID(Window_0_ListIcon) ;/ ListIconGadget
						With dat()
							If gDownloadFinished = 1
								If *nmITEM\iSubItem = 0
									SortStructuredList(dat(),#PB_Sort_Ascending, OffsetOf(dat\name), TypeOf(dat\name))
									ClearGadgetItems(Window_0_ListIcon)
									ForEach dat()
										AddGadgetItem(Window_0_ListIcon, -1, \name+Chr(10)+\date+Chr(10)+\dwll)
									Next
								ElseIf *nmITEM\iSubItem = 1
									SortStructuredList(dat(), #PB_Sort_Descending, OffsetOf(dat\rdate) ,TypeOf(dat\rdate))
									ClearGadgetItems(Window_0_ListIcon)
									ForEach dat()
										AddGadgetItem(Window_0_ListIcon, -1, \name+Chr(10)+\date+Chr(10)+\dwll)
									Next
								EndIf
							EndIf
						EndWith	
					EndIf	
					Result = #True
			EndSelect
	EndSelect
	ProcedureReturn Result 
EndProcedure

Procedure DownloadFileUpdater(dummy.i)
	Protected i, dot$, t$ = "|,/,-,\,|,/,-,\,", c 
	Repeat
		c+1
		dot$ = StringField(t$, c, ",")
		SetWindowTitle(Window_0, "Downloading File "+dot$)
		Delay(20)
		If c=8 : c=0 : 	EndIf
	Until gDownloadFinished = 1 
EndProcedure

Procedure __GetLastError() ; Return the last Win32 API error as a string
	Protected LastError
  ;// Return <> 0 if an error occur
  ; Error 1309 or 0 = No error 
  LastError=GetLastError_()
  If LastError=1309 : LastError=0 : EndIf
  ProcedureReturn LastError
EndProcedure

Procedure.s __GetLastErrorAsText(LastError.l) ; Used to get Last Win32 API Error
	Protected *ErrorBuffer, message.s
	If LastError 
    *ErrorBuffer = AllocateMemory(1024) 
    FormatMessage_(#FORMAT_MESSAGE_FROM_SYSTEM, 0, LastError, 0, *ErrorBuffer, 1024, 0) 
    message.s=PeekS(*ErrorBuffer) 
    FreeMemory(*ErrorBuffer) 
  EndIf 
  ProcedureReturn message
EndProcedure

Procedure ProcessFile(dummy.i)
	Protected rsb$=GetTemporaryDirectory()+"rsb.txt" ; tempory copy of the download url$ source
	Protected ThisLine$, nbr.i, i.i, p.i  
	If ReceiveHTTPFile(gBackup_Url$, rsb$)
		Protected regex_all.i = CreateRegularExpression(#PB_Any, "<td>.*?a></td>")
		Protected regex_list.i = CreateRegularExpression(#PB_Any, "<td>.*?</td>")
		Protected regex_dlink.i = CreateRegularExpression(#PB_Any, Chr(34) + ".*" + Chr(34))
		Protected Dim t$(0)  
		Protected Dim l$(0)			
		Protected Dim dlink$(0)
		SetWindowTitle(Window_0, "Downloading File")	
		If ReadFile(0,rsb$)
			While Not Eof(0)
				ThisLine$ + ReadString(0, ReadStringFormat(0))
			Wend
			CloseFile(0)
			nbr = ExtractRegularExpression(regex_all, ThisLine$, t$())
		EndIf
		gDownloadFinished = 1 
		SetWindowTitle(Window_0, "Processing Downloaded File")	
		With dat()
			For i=0 To nbr-1
				ExtractRegularExpression(regex_list, t$(i), l$())
				AddElement(dat())
				For p = 0 To 3
					l$(p) = RemoveString(l$(p), "<td>") 
					l$(p) = RemoveString(l$(p), "</td>")
				Next	
				\name = l$(0)
				\size = l$(1)
				\date = l$(2)
				\rdate = Date( Val(StringField(\date, 3, ".")), Val(StringField(\date, 2 ,".")),Val(StringField(\date, 1 , ".")), 0, 0, 0)
				ExtractRegularExpression(regex_dlink, l$(3),dlink$())
				\dwll = dlink$(0)	
			Next	
			SortStructuredList(dat(), #PB_Sort_Descending, OffsetOf(dat\rdate) ,TypeOf(dat\rdate))
			
			ForEach dat()
				AddGadgetItem(Window_0_ListIcon, -1, \name+Chr(10)+\date+Chr(10)+\dwll)
			Next
			
			StatusBarText(StatusBar_Window_0,1,Str(ListSize(dat())))
			
		EndWith
	Else
		MessageRequester("Download Error", __GetLastErrorAsText(__GetLastError()))
		End
	EndIf
	SetWindowTitle(Window_0, "RS BackUp Downloader            Processing Complete")
	FreeArray(l$())
	FreeArray(t$())
	FreeArray(dlink$())
	FreeRegularExpression(regex_all)
	FreeRegularExpression(regex_dlink)
	FreeRegularExpression(regex_list)
	gDownloadFinished = 1
EndProcedure

Procedure OpenWindow_Window_0()
	Window_0 = OpenWindow(#PB_Any, 521, 101, 667, 400, "RS BackUp Downloader", #PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_TitleBar|#PB_Window_ScreenCentered)
	If Window_0
		Window_0_ListIcon = ListIconGadget(#PB_Any, 0, 0, 667, 377, "File", 200, #PB_ListIcon_AlwaysShowSelection|#PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect)
		AddGadgetColumn(Window_0_ListIcon, 1,"Date",100)
		AddGadgetColumn(Window_0_ListIcon, 2,"Download Link",367)
		StatusBar_Window_0 = CreateStatusBar(#PB_Any, WindowID(Window_0))
		If StatusBar_Window_0
			AddStatusBarField(100) : AddStatusBarField(100): AddStatusBarField(467)
			StatusBarText(StatusBar_Window_0,0,"Entries: ")
		EndIf
	EndIf
EndProcedure

OpenWindow_Window_0()

gThread = CreateThread(@ProcessFile(),0)
gThread2 = CreateThread(@DownloadFileUpdater(),0)
SetWindowCallback(@OnListIconCLick(), Window_0)
Repeat
	Event = WaitWindowEvent()
	Select Event
		Case #PB_Event_Gadget
			Select EventGadget()
				Case Window_0_ListIcon
					Select EventType()
						Case #PB_EventType_LeftDoubleClick 
							url$ = RemoveString(GetGadgetItemText(Window_0_ListIcon, GetGadgetState(Window_0_ListIcon),2),Chr(34))
							UserDownLoadFolder$ = "C:\Users\"+UserName()+"\Downloads\"+GetFilePart(url$)
							If  ReceiveHTTPFile(url$,UserDownLoadFolder$)
								StatusBarText(StatusBar_Window_0, 2, "Downloading File "+GetFilePart(url$))
							Else
								StatusBarText(StatusBar_Window_0, 2, "Error Downloading File "+__GetLastErrorAsText(__GetLastError()))
							EndIf	
					EndSelect
			EndSelect
		Case #PB_Event_CloseWindow
			Select EventWindow()  
				Case Window_0
					CloseWindow(Window_0)
					Window_0 = 0
					Break
			EndSelect
	EndSelect
ForEver

FreeList(dat())

Last edited by Zebuddi123 on Mon Aug 24, 2015 6:00 pm, edited 2 times in total.
malleo, caput, bang. Ego, comprehendunt in tempore
User avatar
Fangbeast
PureBasic Protozoa
PureBasic Protozoa
Posts: 4749
Joined: Fri Apr 25, 2003 3:08 pm
Location: Not Sydney!!! (Bad water, no goats)

Re: RSBasic Backup Desktop download tool

Post by Fangbeast »

This is good stuff. And I bet you I can forget more than you can:)::)
Amateur Radio, D-STAR/VK3HAF
User avatar
Bisonte
Addict
Addict
Posts: 1232
Joined: Tue Oct 09, 2007 2:15 am

Re: RSBasic Backup Desktop download tool

Post by Bisonte »

Nice idea.

Bug Report :

Some of the filenames have always artefacts of the html source in it.... (the gnozal programs...)
You have to change the downloadpath manually, if you're download folder is not on "C:\User\(Username)\Download\" !
(mostly systems with a SSD as system drive)

Otherwise : Download Error ;)
PureBasic 6.10 LTS (Windows x86/x64) | Windows10 Pro x64 | Asus TUF X570 Gaming Plus | R9 5900X | 64GB RAM | GeForce RTX 3080 TI iChill X4 | HAF XF Evo | build by vannicom​​
English is not my native language... (I often use DeepL to translate my texts.)
User avatar
Zebuddi123
Enthusiast
Enthusiast
Posts: 794
Joined: Wed Feb 01, 2012 3:30 pm
Location: Nottinghamshire UK
Contact:

Re: RSBasic Backup Desktop download tool

Post by Zebuddi123 »

Hi Bisonte I only have ssd`s now so mine is a standard setup, Was looking at code for Knownfolders yesterday when i wrote this but did not have a lot of time.
For artifacts in filename turn off unicode in compiler options and for artifacts in the urlname they are in the page code download path which the code uses for the download link, still works.

Zebuddi. :)

<td>RPG_Maker PB &#8211; Erste Bilder.rar</td>
<td>128 KB</td>
<td>23.11.2009</td>
<td><a href="http://www.rsbasic.de/backupprogramme/R ... ad</a></td>
</tr>
<tr>
<td>RRSnowAttack.zip</td>
<td>6113 KB</td>
<td>12.08.2009</td>
<td><a href="http://www.rsbasic.de/backupprogramme/R ... ad</a></td>
malleo, caput, bang. Ego, comprehendunt in tempore
User avatar
Bisonte
Addict
Addict
Posts: 1232
Joined: Tue Oct 09, 2007 2:15 am

Re: RSBasic Backup Desktop download tool

Post by Bisonte »

Now also with Ascii :
Image

My SSD have only 250 GB so i use another drive for downloads, pictures, documents... and so on.

Edit :

Very simple solution for the "artefacts"... Procedure ProcessFile() changed.

Code: Select all

Procedure ProcessFile(dummy.i)
   Protected rsb$=GetTemporaryDirectory()+"rsb.txt" ; tempory copy of the download url$ source
   ;: Added xx.i to protected Vars
   Protected ThisLine$, nbr.i, i.i, p.i, xx.i
   If ReceiveHTTPFile(gBackup_Url$, rsb$)
      Protected regex_all.i = CreateRegularExpression(#PB_Any, "<td>.*?a></td>", #PB_RegularExpression_DotAll)
      Protected regex_list.i = CreateRegularExpression(#PB_Any, "<td>.*?</td>", #PB_RegularExpression_DotAll)
      Protected regex_dlink.i = CreateRegularExpression(#PB_Any, Chr(34) + ".*" + Chr(34), #PB_RegularExpression_DotAll)
      Protected Dim t$(0) 
      Protected Dim l$(0)         
      Protected Dim dlink$(0)
      SetWindowTitle(Window_0, "Downloading File")   
      If ReadFile(0,rsb$)
         While Not Eof(0)
            ThisLine$ + ReadString(0, ReadStringFormat(0))
         Wend
         CloseFile(0)
         nbr = ExtractRegularExpression(regex_all, ThisLine$, t$())
      EndIf
      gDownloadFinished = 1
      SetWindowTitle(Window_0, "Processing Downloaded File")   
      With dat()
         For i=0 To nbr-1
            ExtractRegularExpression(regex_list, t$(i), l$())
            AddElement(dat())
            For p = 0 To 3
               l$(p) = RemoveString(l$(p), "<td>")
               l$(p) = RemoveString(l$(p), "</td>")
            Next   
            \name = l$(0)
            \size = l$(1)
            \date = l$(2)
            \rdate = Date( Val(StringField(\date, 3, ".")), Val(StringField(\date, 2 ,".")),Val(StringField(\date, 1 , ".")), 0, 0, 0)
            ExtractRegularExpression(regex_dlink, l$(3),dlink$())
            \dwll = dlink$(0)   
            
            ;: After RegEx Cut all with beginning "<"
            xx = FindString(\name, "<", 1)
            If xx
              \name = Left(\name, xx -1)
            EndIf
            
         Next   
         SortStructuredList(dat(), #PB_Sort_Descending, OffsetOf(dat\rdate) ,TypeOf(dat\rdate))
         
         ForEach dat()
            AddGadgetItem(Window_0_ListIcon, -1, \name+Chr(10)+\date+Chr(10)+\dwll)
         Next
         
         StatusBarText(StatusBar_Window_0,1,Str(ListSize(dat())))
         
      EndWith
   Else
      MessageRequester("Download Error", __GetLastErrorAsText(__GetLastError()))
      End
   EndIf
   SetWindowTitle(Window_0, "RS BackUp Downloader            Processing Complete")
   FreeArray(l$())
   FreeArray(t$())
   FreeArray(dlink$())
   FreeRegularExpression(regex_all)
   FreeRegularExpression(regex_dlink)
   FreeRegularExpression(regex_list)
   gDownloadFinished = 1
EndProcedure
PureBasic 6.10 LTS (Windows x86/x64) | Windows10 Pro x64 | Asus TUF X570 Gaming Plus | R9 5900X | 64GB RAM | GeForce RTX 3080 TI iChill X4 | HAF XF Evo | build by vannicom​​
English is not my native language... (I often use DeepL to translate my texts.)
User avatar
Zebuddi123
Enthusiast
Enthusiast
Posts: 794
Joined: Wed Feb 01, 2012 3:30 pm
Location: Nottinghamshire UK
Contact:

Re: RSBasic Backup Desktop download tool

Post by Zebuddi123 »

Hi Bistonte Thanks didn't see that! blind as well as daft :shock: lol

Zebuddi. :)
malleo, caput, bang. Ego, comprehendunt in tempore
infratec
Always Here
Always Here
Posts: 6866
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Re: RSBasic Backup Desktop download tool

Post by infratec »

Use this at start :wink:

Code: Select all

CompilerIf Not #PB_Compiler_Thread
  MessageRequester("Hint", "Enable threadsafe!")
  End
CompilerEndIf
Bernd
User avatar
Zebuddi123
Enthusiast
Enthusiast
Posts: 794
Joined: Wed Feb 01, 2012 3:30 pm
Location: Nottinghamshire UK
Contact:

Re: RSBasic Backup Desktop download tool

Post by Zebuddi123 »

Thanks Bernd added

Zebuddi. :)
malleo, caput, bang. Ego, comprehendunt in tempore
User avatar
Vera
Addict
Addict
Posts: 858
Joined: Tue Aug 11, 2009 1:56 pm
Location: Essen (Germany)

Re: RSBasic Backup Desktop download tool

Post by Vera »

Hello Zebuddi,
thank you very much for sharing your tool and the idea behind it and of course to RSBasic for his great service :D

Now unforunately your tool only runs for Win-users .... so I snapped it and made a crossplatform version for all to benefit.
My version is a bit different with a larger focus on easier checking the list to find what one may look for.

RS BackUp Download-Index

Features:
- crossplatform [hopefully]
- resizable
- displays file-size
- sort-options (file, date, search-results)
- Index-search (opt. case-sensitive)
- additional temp plain index-list and backup-list*
- startup-note about previous Index-check
- dbl-click on list item sets dl-link to clipboard

*Todo: compare temp-lists and highlight new entries
Note: the date doesn't tell when a file was uploaded, but when it was saved for later uploading. So you can't find out which of the over 100 files that had been added yesterday are 'new' to the list. That is why I've prepared those additional two temp-list-files, to allow a later comparison. For now the startup-note informs about the previous files-amount from you last check

Please enjoy and lucky findings ~ Vera Image

Code: Select all

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Project: RS BackUp Download-Index
; Author: Vera
; Credits: to Zebuddi for his RSBasic Backup Desktop download tool
; ........ and to the BackupMaster RSBasic :-)
; Forum: http://www.purebasic.fr/english/viewtopic.php?f=27&t=62899
; 
; Date: 27-08-2015
; Last Update: 29-08-2015
; Platform : WIN, Linux, MacOSX
; PureBasic: v4.51 ++, ASCII + UNicode-mode
; Compile in ThreadSafe Mode !
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

;- top

EnableExplicit

CompilerIf #PB_Compiler_Thread = 0
  MessageRequester("Note", "Please Compile in ThreadSafe Mode !")
  End
CompilerEndIf

InitNetwork()

Global Window_0, wWidth, wHeight 
Global StatusBar_Window_0
Global Window_0_ListIcon
Global but1, but2, but3, search1, checkCS, but4
Global sTerm.s = "", entyS.s = "", j , caseS.i = #False

; =========
Global tempD$ = GetTemporaryDirectory()
Global tempF$ = tempD$ +"rsb_list.txt"
Global tempBK$ = tempD$ +"rsb_list_bk.txt"

Declare CompareList()

Procedure SaveList()
  Protected testL$, i, c
  
  If  CreateFile(1, tempF$)
    WriteStringN(1, "+++ rsb_list - " + FormatDate("%mm/%dd/%yyyy %hh:%ii:%ss", Date())+ " - " + Str(CountGadgetItems(Window_0_ListIcon)) + " Entries +++")
    For i = 0 To CountGadgetItems(Window_0_ListIcon)-1
      testL$ = ""
      For c = 0 To 3
        testL$ = testL$ + GetGadgetItemText(Window_0_ListIcon, i, c) + ";"
      Next
      WriteStringN(1, RTrim(testL$, ";"))
    Next
    CloseFile(1)
  EndIf
  ProcedureReturn
EndProcedure

Procedure CheckBackup()
  If tempD$
    If FileSize(tempF$) > 0
      CopyFile(tempF$, tempBK$)
      DeleteFile(tempF$);, #PB_FileSystem_Force)
      If SaveList() : CompareList() : EndIf
    Else
      SaveList()
    EndIf 
  EndIf
EndProcedure

Procedure CompareList()
  Protected stringBK$
  
  If ReadFile(0, tempBK$)
  stringBK$ = ReadString(0)
  CloseFile(0)
 ; Debug stringBK$
  StatusBarText(StatusBar_Window_0, 2, " Previous check: " + stringBK$)
  EndIf

;   If ReadFile(1, tempF$)
;  ; Debug ReadString(1)
;   CloseFile(1)
;   EndIf
EndProcedure

Procedure.s UTF8ToAscii(UTF8.s)   ;   thanks to Omi :-)
  Protected *mem     = AllocateMemory(StringByteLength(UTF8, #PB_UTF8) + 1)
  Protected *len     = PokeS(*mem, UTF8, -1,  #PB_Ascii)
  Protected.s SAscii = PeekS(*mem, -1, #PB_UTF8)
  FreeMemory(*mem)
  ProcedureReturn SAscii
EndProcedure
; =========

Structure dat
  name.s
  size.s
  date.s
  rdate.i
  dwll.s
  mark.i 
EndStructure

Global NewList dat.dat()
Global gThread.i, gThread2.i, gDownloadFinished.b, gBackup_Url$ = "http://www.rsbasic.de/backups/"

Define Event.i, url$

Procedure DownloadFileUpdater(dummy.i)
  Protected i, dot$, t$ = "|,/,-,\,|,/,-,\,", c
  Repeat
    c+1
    dot$ = StringField(t$, c, ",")
    SetWindowTitle(Window_0, "Downloading Index-File "+dot$)
    Delay(20)
    If c= 8 : c= 0 :    EndIf
  Until gDownloadFinished = 1
EndProcedure

Procedure ProcessFile(dummy.i)
  Protected rsb$ = GetTemporaryDirectory()+"rsb.txt" ; tempory copy of the download url$ source
  Protected ThisLine$, nbr.i, i.i, p.i 
  If ReceiveHTTPFile(gBackup_Url$, rsb$)
    Protected regex_all.i = CreateRegularExpression(#PB_Any, "<td>.*?a></td>", #PB_RegularExpression_DotAll)
    Protected regex_list.i = CreateRegularExpression(#PB_Any, "<td>.*?</td>", #PB_RegularExpression_DotAll)
    Protected regex_dlink.i = CreateRegularExpression(#PB_Any, Chr(34) + ".*" + Chr(34), #PB_RegularExpression_DotAll)
    Protected Dim t$(0) 
    Protected Dim l$(0)         
    Protected Dim dlink$(0)
    
    If ReadFile(0,rsb$)
      While Not Eof(0)
      ThisLine$ + ReadString(0, ReadStringFormat(0))
      Wend
      CloseFile(0)
      nbr = ExtractRegularExpression(regex_all, ThisLine$, t$())
    EndIf
    gDownloadFinished = 1
    SetWindowTitle(Window_0, "Processing Index")   
    With dat()
      For i=0 To nbr-1
        ExtractRegularExpression(regex_list, t$(i), l$())
        AddElement(dat())
        For p = 0 To 3
          l$(p) = RemoveString(l$(p), "<td>")
          l$(p) = RemoveString(l$(p), "</td>")
        Next   
        If FindString(l$(3), "&", 1) > 0         ;  &  vs
          l$(3) = ReplaceString(l$(3), "&", "&")
        EndIf
        ExtractRegularExpression(regex_dlink, l$(3),dlink$())
        \name = UTF8ToAscii(URLDecoder(GetFilePart(GetURLPart(Trim(dlink$(0), Chr(34)), #PB_URL_Path))))
        \size = LCase(l$(1)) ;  l$(1)
        \date = l$(2)
        \rdate = Date( Val(StringField(\date, 3, ".")), Val(StringField(\date, 2 ,".")),Val(StringField(\date, 1 , ".")), 0, 0, 0)
        \dwll = dlink$(0)   ; URLDecoder(dlink$(0))
        \mark = 0         ; vs
      Next   
      
      ForEach dat()
        AddGadgetItem(Window_0_ListIcon, -1, \name +Chr(10) +\size +Chr(10) +\date +Chr(10) +\dwll)
      Next
      
      StatusBarText(StatusBar_Window_0,1, " " + Str(ListSize(dat())))
    EndWith
  Else
    MessageRequester("Download Error", "please restart anew")
    End
  EndIf
  
  SetWindowTitle(Window_0, "RS BackUp Download-Index          Processing Complete")
  FreeArray(l$())
  FreeArray(t$())
  FreeArray(dlink$())
  FreeRegularExpression(regex_all)
  FreeRegularExpression(regex_dlink)
  FreeRegularExpression(regex_list)
  gDownloadFinished = 1
  DisableGadget(but1,0) : DisableGadget(but2,0) : DisableGadget(but3,0)          ; vs
  DisableGadget(search1,0) : DisableGadget(checkCS,0)
  CheckBackup()
  SetWindowTitle(Window_0, "RS BackUp Download-Index")
EndProcedure


Procedure SearchItem()
  
  If caseS
    sTerm = GetGadgetText(search1)
  Else
    sTerm = LCase(GetGadgetText(search1))
  EndIf
  
  If sTerm <> "SearchTerm"
    j=0
    ForEach dat() : j+1
      If caseS
        entyS = dat()\name
      Else
        entyS = LCase(dat()\name)
      EndIf
      If FindString(entyS, sTerm, 0)
        SetGadgetItemColor(Window_0_ListIcon, j-1 , #PB_Gadget_FrontColor, $3030FB)
        dat()\mark = 1
      Else
        SetGadgetItemColor(Window_0_ListIcon, j-1 , #PB_Gadget_FrontColor, -1)
        dat()\mark = 0
      EndIf
    Next
  EndIf
EndProcedure

Procedure OpenWindow_Window_0()
  Window_0 = OpenWindow(#PB_Any, 51, 11, 667, 600, "RS BackUp Download-Index", #PB_Window_SystemMenu |#PB_Window_MinimizeGadget |#PB_Window_TitleBar |#PB_Window_SizeGadget)
  If Window_0
    
    but1 = ButtonGadget(#PB_Any, 0, 4, 80, 22, "sort files")         ; vs
    but2 = ButtonGadget(#PB_Any, 90, 4, 80, 22, "sort date")
    but3 = ButtonGadget(#PB_Any, 210, 4, 80, 22, "sort finds")
    search1 = StringGadget(#PB_Any, 300, 4, 175, 22, "SearchTerm")
    checkCS = CheckBoxGadget(#PB_Any, 480, 4, 65, 22, "caseS")
    but4 = ButtonGadget(#PB_Any, 570, 4, 80, 22, "mark news")
    DisableGadget(but1,1) : DisableGadget(but2,1) : DisableGadget(but3,1) 
    DisableGadget(search1,1) : DisableGadget(checkCS,1) : DisableGadget(but4,1)
    
    Window_0_ListIcon = ListIconGadget(#PB_Any, 0, 30, 667, 545, "File", 200, #PB_ListIcon_AlwaysShowSelection |#PB_ListIcon_GridLines |#PB_ListIcon_FullRowSelect)
    AddGadgetColumn(Window_0_ListIcon, 1, "Size", 70)         ; vs
    AddGadgetColumn(Window_0_ListIcon, 2, "Date", 90)
    AddGadgetColumn(Window_0_ListIcon, 3, "Download Link", 467)
    StatusBar_Window_0 = CreateStatusBar(#PB_Any, WindowID(Window_0))
    If StatusBar_Window_0
      AddStatusBarField(60) : AddStatusBarField(60) : AddStatusBarField(#PB_Ignore)
      StatusBarText(StatusBar_Window_0,0," Entries: ")
    EndIf
  EndIf
    WindowBounds(Window_0, 360, 200, #PB_Ignore, #PB_Ignore)
EndProcedure

OpenWindow_Window_0()

gThread = CreateThread(@ProcessFile(),0)
gThread2 = CreateThread(@DownloadFileUpdater(),0)

;- loop

Repeat
  Event = WaitWindowEvent()
  Select Event
    Case #PB_Event_Gadget
      Select EventGadget()
        Case Window_0_ListIcon
          Select EventType()
            Case #PB_EventType_LeftDoubleClick
              url$ = RemoveString(GetGadgetItemText(Window_0_ListIcon, GetGadgetState(Window_0_ListIcon), 3), Chr(34))
              If SetClipboardText(url$)         ; vs  URLEncoder(url$)     
                StatusBarText(StatusBar_Window_0, 2, " Download-link of: _ "+ GetGadgetItemText(Window_0_ListIcon, GetGadgetState(Window_0_ListIcon), 0) +" _ set to clipboard")
              EndIf
          EndSelect
          
        Case but1
          CompilerIf #PB_Compiler_Version > 500
            SortStructuredList(dat(), #PB_Sort_NoCase, OffsetOf(dat\name) , #PB_String)
          CompilerElse
            SortStructuredList(dat(), #PB_Sort_NoCase, OffsetOf(dat\name) , #PB_Sort_String)
          CompilerEndIf
          ClearGadgetItems(Window_0_ListIcon) 
          ForEach dat()
            AddGadgetItem(Window_0_ListIcon, -1, dat()\name +Chr(10) +dat()\size +Chr(10) +dat()\date +Chr(10) +dat()\dwll)
            If dat()\mark = 1
              SetGadgetItemColor(Window_0_ListIcon, CountGadgetItems(Window_0_ListIcon) -1 , #PB_Gadget_FrontColor, $3030FB)
            EndIf
          Next
          
        Case but2
          CompilerIf #PB_Compiler_Version > 500
            SortStructuredList(dat(), #PB_Sort_Descending, OffsetOf(dat\rdate) , #PB_Integer)
          CompilerElse
            SortStructuredList(dat(), #PB_Sort_Descending, OffsetOf(dat\rdate) , #PB_Sort_Integer)
          CompilerEndIf
          ClearGadgetItems(Window_0_ListIcon) 
          ForEach dat()
            AddGadgetItem(Window_0_ListIcon, -1, dat()\name +Chr(10) +dat()\size +Chr(10) +dat()\date +Chr(10) +dat()\dwll)
            If dat()\mark = 1
              SetGadgetItemColor(Window_0_ListIcon, CountGadgetItems(Window_0_ListIcon)-1 , #PB_Gadget_FrontColor,  $3030FB)
            EndIf
          Next
          
        Case but3
          CompilerIf #PB_Compiler_Version > 500
            SortStructuredList(dat(), #PB_Sort_Descending, OffsetOf(dat\mark) , #PB_Integer)
          CompilerElse
            SortStructuredList(dat(), #PB_Sort_Descending, OffsetOf(dat\mark) , #PB_Sort_Integer)
          CompilerEndIf
          ClearGadgetItems(Window_0_ListIcon) 
          ForEach dat()
            AddGadgetItem(Window_0_ListIcon, -1, dat()\name+Chr(10) +dat()\size +Chr(10) +dat()\date +Chr(10) +dat()\dwll)
            If dat()\mark = 1
              SetGadgetItemColor(Window_0_ListIcon, CountGadgetItems(Window_0_ListIcon)-1 , #PB_Gadget_FrontColor,  $3030FB)
            EndIf
          Next
          

        Case search1
          If EventType() = #PB_EventType_Change
            SearchItem()
          EndIf
          
        Case checkCS                        ; case-sensitive
          caseS = GetGadgetState(checkCS)
          SearchItem()
      EndSelect
      
    Case #PB_Event_CloseWindow
      Select EventWindow() 
        Case Window_0
          CloseWindow(Window_0)
          Window_0 = 0
          Break
      EndSelect
      
    Case #PB_Event_SizeWindow
      wWidth  = WindowWidth(Window_0)
      wHeight = WindowHeight(Window_0)
      ResizeGadget(Window_0_ListIcon, #PB_Ignore, #PB_Ignore, wWidth, wHeight - 57)
  EndSelect
ForEver

FreeList(dat())
Remaining issues:
- occasionally the app doesn't proceed after downloading the file, esp. when being restarted too quickly after closing

- there are several html-entities (eg: &#8212; ) in the names that I don't know how to remove (decode)
They don't matter too much but one of them is also corrupting the download-links.
It's: & and in concerns 5 files:
Otter&Fench.pb, Otters & Fenech Setup.exe, drag & drop.zip, PF & T (Test).pb, Toys&Tools.exe

Does this also happen in the Win-version?
And how is the umlaut 'ü' displayed to you? I could fix their display by changing the following:

Code: Select all

 ;     ThisLine$ + ReadString(0, ReadStringFormat(0))
       ThisLine$ + ReadString(0, #PB_UTF8)         ; to display umlauts -vs
update: I've found a way to cope with those html-entities without additional html-decoding and keeping the 'umlauts' displayed.
Last edited by Vera on Sat Aug 29, 2015 6:05 pm, edited 2 times in total.
User avatar
Zebuddi123
Enthusiast
Enthusiast
Posts: 794
Joined: Wed Feb 01, 2012 3:30 pm
Location: Nottinghamshire UK
Contact:

Re: RSBasic Backup Desktop download tool

Post by Zebuddi123 »

Hi Vera Thanks for posting the code :)

Some observations:

PB 5.31 + Deprecated #PB_Sort_String etc _Sort part removed ie now #PB_String, #PB_Integer etc.

Clearing the listview and showing only the items searched for.
ButtonGadget to restore the list after search.

Zebuddi. :)
malleo, caput, bang. Ego, comprehendunt in tempore
User avatar
Vera
Addict
Addict
Posts: 858
Joined: Tue Aug 11, 2009 1:56 pm
Location: Essen (Germany)

Re: RSBasic Backup Desktop download tool

Post by Vera »

Ah, thanks for the hint :) - I added some compiler directives to 'sort' that out.

I think about the other suggestion, but on first impulse I wouldn't want to loose the other items and having to make them visible again with a further click.
It's interesting to see when the highlighting changes when switching the case-sensitivity (while the entries stay visible where they are). The naming of the files is quite inconsistent and this way you can detect more of similar entries.
At times the backedup filenaming doesn't fit exactely the filenames that are used on the forum and a wider range of results is often helpful to find them if they are among the list.

Image ~ Vera
Num3
PureBasic Expert
PureBasic Expert
Posts: 2810
Joined: Fri Apr 25, 2003 4:51 pm
Location: Portugal, Lisbon
Contact:

Re: RSBasic Backup Desktop download tool

Post by Num3 »

Great stuff Zebuddi123 and Vera!
Thanks :D
Post Reply