' ************************************************************************
' DBload.pft - Database load function for RAD - with retries and failure.
'
' The function should be incorporated in a project. Possibly in the
' applibhu high-use library if it is to be used on a number of occasions.
'
' This code may be used and distributed free of charge, comments may be
' removed if the function is distributed as part of an application but
' should be retained if the function is distributed for development.
' ************************************************************************

' *** FUNCTIONS
EXTERNAL get_choice()
PUBLIC _dbloadretry(7)      'loads data-files - error checking & retries
PUBLIC db_ld_fct(4)

MAIN

' *** Examples of usage
' _dbloadretry("datafile",1,"DBLOAD/test1",0,1,1,5)  ' load standard view current path, retry, quit & errro file on filaure
' _dbloadretry("C:\app\files\datafile",2,"DBLOAD/test2",0,0,0,1) 'activate custom view with path, no retries and warn user on failure
' *********************

END MAIN


' ************************************************************ _dbloadretry
FUNCTION _dbloadretry($datafile,#view_type,$project,#exclusive,#load,#retry,#errormode)
' ************************************************************************
' Function:   _dbloadretry(7)                    Version:  3.00 - 8/2/2006
'
' Author:     Neil Parrish, IO Systech Limited
' Website:    www.iosystech.co.uk          Email: nparrish@iosystech.co.uk
' Phone:      +44(0)7041 420182/+44(0)1784 432058   Fax: +44(0)870 7064666
'
' Purpose:    Loads a data file from code under RAD, retrying if necesary.
'             Quits if unsuccessful after #dbloadretries tries.
' Parameters: $datafile  - data-file name, including path if required
'             #view_type - 1=standard, 2=custom
'             $project   - calling project file, for failure reporting
'             #exclusive - 0=normal load, 1=exclusive load
'             #load      - 0=activate, 1=load
'             #retry     - 0=single, 1=retries (#dbloadretries times)
'             #errormode - 0=no action, 1=warns user, 2=writes to file
'                          3=warning & writes to file, 4=quits
'                          5=writes to file & quits
' Returns:    0=load failed, 1=successful
'
' Notes:
' Interval between retries increases for each try. Uses RAD get_choice()
' function with ==> on the first button and only responds to the second
' button being pressed (OK) to avoid users just pressing return.
' Even if passwords are not being used on views/data-files the db_ld_fct
' lines may be retained - RAD sets ##db_ld_fct to 0 by default.
' Could easily be amended for use outside RAD by removing get_choice,
' open_file and db_ld_fct.
'
' This code may be used and distributed free of charge, comments may be
' removed if the function is distributed as part of an application but
' should be retained if the function is distributed for development.
' ************************************************************************
 LOCAL #try #retries #error $view_type #error_on #fh1
	SMARTPEEK $_error #error_on
	IF #error_on
		ERROR OFF
	END IF
	#error = 35  'user error
	IF #retry
		#retries = MAX(#dbloadretries,1)
	ELSE
		#retries = 1
	END IF
	#try = 1
	WHILE (#error <> 0 AND #try <= #retries)
		CLEARERROR
		IF ##db_ld_fct
			$view_type = CASE #view_type (1,"vws")(2,"vw") ELSE ""
			db_ld_fct($view_type,$datafile,#exclusive,#load)
		ELSE
			IF #view_type = 2 'custom view
				IF #exclusive
					FILE LOAD CUSTOM-VIEW $datafile EXCLUSIVE
				ELSE
					IF #load
						FILE LOAD CUSTOM-VIEW $datafile
					ELSE
						FILE ACTIVATE CUSTOM-VIEW $datafile
					END IF
				END IF
			ELSE 'standard view
				IF #exclusive
					FILE LOAD STANDARD-VIEW $datafile EXCLUSIVE
				ELSE
					IF #load
						FILE LOAD STANDARD-VIEW $datafile
					ELSE
						FILE ACTIVATE STANDARD-VIEW $datafile
					END IF
				END IF
			END IF
		END IF
		#error = lerror
		IF #error <> 0
			IF #try = #retries
				#errormode = MOD(#errormode,6)
				IF CASE #errormode (1,1)(3,1) ELSE 0 'warn the user
					get_choice("ERROR! - Unable to load a datafile: note the details below","and call IT support","View:" & $datafile|CASE #view_type(1,".vws") ELSE ".vw","Error:" & STR(#error) & "Project/Menu:" & $project,"OK",4)
				END IF
				IF CASE #errormode (2,1)(3,1)(5,1) ELSE 0 'write to the file
					IF FILE ($$workdir|"lcerror.txt")
						TOOLS FILE ERASE $$workdir|"lcerror.txt"
					END IF
					#fh1 = open_file($$workdir,"lcerror.txt",rw_mode)
					FWRITE #fh1 FROM FORMAT(NOW,"Ddd/mm/yyyy") & FORMAT(NOW,"T2")
					FWRITE #fh1 FROM "View:" & $datafile
 					FWRITE #fh1 FROM "Type:" & CASE #view_type (1,"STANDARD")(2,"CUSTOM") ELSE ""
					FWRITE #fh1 FROM "Error:" & STR(#error) & ERRORTEXT(#error)
					FWRITE #fh1 FROM "Project/Menu:" & $project
					FWRITE #fh1 FROM "Flags:"
					FWRITE #fh1 FROM "  " & CASE #exclusive (0,"Shared")(1,"Exclusive") ELSE "Unknown"
					FWRITE #fh1 FROM "  " & CASE #load (0,"Activate")(1,"Load") ELSE "Unknown"
					FWRITE #fh1 FROM "  " & CASE #retry (0,"Single Attempt")(1,"Retry" & STR(#retries) & "times") ELSE "Unknown"
					FCLOSE #fh1
				END IF
				IF CASE #errormode (4,1)(5,1) ELSE 0 'quit
					WHILE get_choice("Unable to load a datafile: note the details below","and call IT Support","Error:"&STR(#error)&"Project/Menu:"&$project,"Datafile:"&$datafile|CASE #view_type(1,".vws")ELSE ".vw","--> Quit",4) <> 2
					END WHILE
					QUIT QUIT
				END IF
				IF #error_on
					ERROR ON
				END IF
				RETURN 0 'failed
			END IF
			MILLI-WAIT #try*100
		END IF
		#try = #try + 1
	END WHILE
	IF #error_on
		ERROR ON
	END IF
	RETURN 1 'loaded
END FUNCTION

' *************************************************************** db_ld_fct
FUNCTION db_ld_fct($type,$pathnfile,#exclusive,#load)
' ************************************************************************
' Function:   db_ld_fct(4)                       Version:  3.00 - 8/2/2006
'
' Author:     Neil Parrish, IO Systech Limited
' Website:    www.iosystech.co.uk          Email: nparrish@iosystech.co.uk
' Phone:      +44(0)7041 420182/+44(0)1784 432058   Fax: +44(0)870 7064666
'
' Purpose:    Loads a password protected view\datafile under RAD.
'             RAD specified function used during RAD loading if variable
'             ##db_ld_fct is set to 1. It is also used by IO Systech
'             function _dbloadretry().
' Parameters: $type      - "vw" for custom and "vws" for standard views
'             $pathnfile - data-file name, including path if required
'             #exclusive - 0=normal load, 1=exclusive load
'             #load      - 0=activate, 1=load
' Returns:    None - check value of lerror
'
' Notes:
' Based on the sample password.pf3 project-file in ..\angoss\apsys\dev
' of a standard install.
' This version supports a single password for all datafiles and views.
' The repeat count (after lookon) in the 6 KEYS lines (default #50),
' may be lowered to reflect the maximum number of passwords required to
' load a view in a particular application.
' $temp = "IOSystech" and encryption to $pw should be tailored to the
' desired password - this technique is used so the password cannot simply
' be read from the rf3 file.
'
' This code may be used and distributed free of charge, comments may be
' removed if the function is distributed as part of an application but
' should be retained if the function is distributed for development.
' ************************************************************************
 LOCAL $pw $temp #i
	$pw = ""
	$temp = "IOSystech"
	FOR #i = 1 TO LEN($temp)
		$pw = $pw|CHR(MOD(ASC(MID($temp,#i,1))*#i+42,26)+65)
	END
	KEY DEFINE "#1000" CHR(34)|$pw|CHR(34)|",enter"
	WHILE NEXTKEY <> 0
		$temp = INCHAR
	END WHILE
	CASE LOWER($type)
	WHEN "vw"
		IF #exclusive
			FILE LOAD CUSTOM-VIEW $pathnfile EXCLUSIVE
			KEYS lookon,repeat,#25,#1000
		ELSE
			IF #load
				FILE LOAD CUSTOM-VIEW $pathnfile
				KEYS lookon,repeat,#25,#1000
			ELSE
				FILE ACTIVATE CUSTOM-VIEW $pathnfile
				KEYS lookon,repeat,#25,#1000
			END IF
		END IF
	WHEN "vws"
		IF #exclusive
			FILE LOAD STANDARD-VIEW $pathnfile EXCLUSIVE
			KEYS lookon,repeat,#25,#1000
		ELSE
			IF #load
				FILE LOAD STANDARD-VIEW $pathnfile
				KEYS lookon,repeat,#25,#1000
			ELSE
				FILE ACTIVATE STANDARD-VIEW $pathnfile
				KEYS lookon,repeat,#25,#1000
			END IF
		END IF
	OTHERWISE
		get_choice("ERROR ! Unable to load datafile","Invalid view type specified for db_ld_fct()","$pathnfile:" & $pathnfile,"$type" & $type,"OK",4)
	END CASE
	KEY REMOVE "#1000"
	$pw = REPEAT(CHR(INT(UNIFORM(26))+66),LEN($pw))
	WHILE NEXTKEY <> 0
		$temp = INCHAR
	END WHILE
END FUNCTION