Dim arFormItems

Function GetField(ByVal riga, ByVal num , ByVal FieldSep)
Dim pos
'cerca nella riga il campo num; i campi sono separati da FieldSep
'riga= campo0 TAB campo1 TAB ....... campoN
'
'ritorna il valore del campo richiesto e res=1
'se non lo trova ritorna "" e res=0

  If FieldSep = "" Then
    'res = 0
    GetField = ""
  Else
    Do While num > 0
      pos = InStr(riga, FieldSep)
      If pos = 0 Then
        'res = 0
        GetField = ""
        Exit Function
      End If
      riga = Mid(riga, pos + Len(FieldSep))
      num = num - 1
    Loop
    pos = InStr(riga, FieldSep)
    If pos = 0 Then
      GetField = Trim(riga)
    ElseIf pos = 1 Then
      GetField = ""
    Else
      GetField = Trim(Left(riga, pos - 1))
    End If
    'res = 1
  End If
End Function

function SQLEmailTo(byval szEmailField)
	SQLEmailTo = "'<a href=""mailto:' + " & szEmailField & " + '"">' + " & szEmailField & " + '</a>'"
end function
					
'date -> 'yyyymmdd'
function SQLDate(byval dtDate)
dim szMonth, szDay
		
	if IsNull(dtDate) then 
		SQLDate = ""
	else
		szMonth = PadStr(Month(dtDate), 2)
		szDay = PadStr(Day(dtDate),2)
		SQLDate = "'" & year(dtDate) & szMonth & szDay & "'"
	end if
end function

' 'yyyymmdd' > date
function DateSQL(byval szDate)
dim szMonth, szDay
		
	if szDate = "" or IsNull(szDate) then
		DateSQL = null
	else
		DateSQL = DateSerial(Cint(mid(szDate,2,4)), Cint(mid(szDate,6,2)), Cint(mid(szDate,8,2)))
	end if
end function

' Date --> yyyymmdd
function FSQLDate(dDate)
	FSQLDate = Mid(SQLDate(dDate),2,8)
end function

' Date -> #mm/dd/yyyy#
function MDBDate(byval dtDate)
dim szMonth, szDay
		
	if IsNull(dtDate) then 
		MDBDate = ""
	else
		szMonth = PadStr(Month(dtDate), 2)
		szDay = PadStr(Day(dtDate),2)
		MDBDate = "#" & szMonth & "/" & szDay & "/" & year(dtDate) & "#"
	end if
end function

' Date -> #mm/dd/yyyy hh:nn:ss AM# ( #5/2/2005 10:14:00 PM# )
function MDBDateTime(byval dtDate)
	if IsNull(dtDate) then 
		MDBDateTime = ""
	else
		MDBDateTime = "#" & Month(dtDate) & "/" & Day(dtDate) & "/" & year(dtDate) & " " & _
									iif(Hour(dtDate)>=12, Hour(dtDate)-12, Hour(dtDate)) & ":" & Minute(dtDate) & ":" & Second(dtDate) & " " & iif(Hour(dtDate)>=12, "PM", "AM") & "#"
	end if
end function

' #mm/dd/yyyy# -> date
function DateMDB(byval szDate)
dim szMonth, szDay
		
	if szDate = "" or IsNull(szDate) then
		DateMDB = null
	else
		DateMDB = DateSerial(CInt(mid(szDate,8,4)), Cint(mid(szDate,2,2)), Cint(mid(szDate,5,2)))
	end if
end function

' #mm/dd/yyyy# --> yyyymmdd
function FSQLMDB(szMDBDate)
	FSQLMDB = FSQLDate(DateMDB(szMDBDate))
end function
	
function ITADate(byval dtDate)
	if IsNull(dtDate) then
		ITADate = ""
	else
		ITADate = PadStr(Day(dtDate),2) & "/" & PadStr(Month(dtDate),2) & "/" & Year(dtDate)
	end if
end function

function DateITA(byval szDate)
dim nDay, nMonth, nYear

	'gg/mm/aaaa
	if szDate = "" then
		DateITA = null
	else
		nDay = CInt(mid(szDate,1,2))
		nMonth = CInt(mid(szDate,4,2))
		nYear = CInt(mid(szDate,7,4))
		'msgbox "nDay=" & nDay & " nMonth=" & nMonth & " nYear=" & nYear
		if nMonth<1 or nMonth>12 or nDay<1 or nDay>MonthDays(nYear, nMonth) or nYear<1 then
			err.raise 1,,"Invalid Italian Date"
		else
			DateITA = DateSerial(nYear, nMonth, nDay)
		end if
	end if
end function

'12/07/2003 [23:50[:59]]
function DateITATime(byval szDateTime)
dim szDate, szTime, szSecs

	szDate = Left(szDateTime, 10)
	if Len(szDateTime) > 11 then
		szTime = Mid(szDateTime, 12)
		if Len(szDateTime) > 16 then
			szSecs = Mid(szTime, 7, 2)
		end if
		DateITATime = DateITA(szDate) + TimeSerial(Left(szTime,2), Mid(szTime, 4, 2) , szSecs)
	else
		DateITATime = DateITA(szDate)
	end if
end function

function IsITADate(byval szDate)
dim szFmtDate

on error resume next
	szFmtDate = DateITA(szDate)
	if Err then
		'msgbox Err.description
		IsITADate = False
	else
		IsITADate = True
	end if
end function

Function SecDateTime(ByVal dValue)
   SecDateTime = DateDiff("s", DateSerial(2000, 1, 1), dValue)
End Function

Function DateTimeSec(ByVal nValue)
   DateTimeSec = DateAdd("s", nValue, DateSerial(2000, 1, 1))
End Function

function StripTime(dValue)
	StripTime = DateSerial(Year(dValue), Month(dValue), Day(dValue))
end function

function StripDate(dValue)
	StripDate = TimeSerial(Hour(dValue), Minute(dValue), Second(dValue))
end function

function FmtTime(byval dtDate)
	if IsNull(dtDate) then
		FmtTime = "00:00:00"
	else
		FmtTime = PadStr(Hour(dtDate),2) & ":" & PadStr(Minute(dtDate),2) & ":" & PadStr(Second(dtDate),2)
	end if
end function

function SafeFormatDateTime(byval dDate, byval nFmt)
on error resume next	
	SafeFormatDateTime = FormatDateTime(dDate, nFmt)
end function

function PadStr(ByVal szValue, ByVal nLen)
	do while len(szValue) < nLen
		szValue = "0" & szValue
	loop
	PadStr = szValue
end function

function PadStrEx(ByVal szValue, ByVal nLen, Byval szChar)
	if szChar = "" then szChar = "0"
	do while len(szValue) < nLen
		szValue = szChar & szValue
	loop
	PadStrEx = szValue
end function

function MonthDays(byval nYear, byval nMonth)
	MonthDays = day(dateserial(nYear, nMonth + 1,0))
end function

function DateMonthStart(byval dDate)
	DateMonthStart = DateSerial( Year(dDate), Month(dDate), 1)
end function
	
function DateMonthEnd(byval dDate)
	DateMonthEnd = DateSerial( Year(dDate), Month(dDate)+1, 0)
end function

function iif(byval bValue, byval ValueTrue, byval ValueFalse)
	if bValue then
		iif = ValueTrue
	else
		iif = ValueFalse
	end if
end function

function LocCBool(byval szValue)
	if szValue="True" or szValue="Vero" then
		LocCBool = True
	else
		LocCBool = False
	end if
end function

function SafeCDbl(byval szValue)

On Error Resume Next

	if szValue = "" or IsNull(szValue) then	
		SafeCDbl = 0
	else
		SafeCDbl = CDbl(szValue)
	end if
	
	Err.Clear
end function

function SafeCStr(byval szValue)
	if szValue = "" or IsNull(szValue) then	
		SafeCStr = ""
	else
		SafeCStr = CStr(szValue)
	end if
end function

function QStr(sVal)
	QStr = chr(34) & sVal & chr(34)
end function

Function GetOnlyName(ByVal szNomeFile)
Dim nPos

  nPos = InStrRev(szNomeFile, ".")
  If nPos > 1 Then
    szNomeFile = Left(szNomeFile, nPos - 1)
  ElseIf nPos = 1 Then
    szNomeFile = ""
  End If
  GetOnlyName = szNomeFile
End Function

Function GetName(ByVal PathName)
Dim pos

  pos = InStrRev(Replace(PathName, "/", "\"), "\")
  If pos Then
    GetName = Mid(PathName, pos + 1)
  Else
    GetName = PathName
  End If
end	 function
	
Function GetPath(ByVal szPathName) 
Dim nPos

	'PAOLO171095 - gestisce anche la notazione di rete \\SERVER
	If IsRootDir(szPathName) Or Mid(szPathName, 2) = ":" Then
	  GetPath = szPathName
	  Exit Function
	End If
  
	nPos = InStrRev(szPathName, "\")
	if nPos = 0 then nPos = InStrRev(szPathName, "/")
	If nPos <= 1 Then
	  GetPath = ""
	Else
	  GetPath = Left(szPathName, nPos - 1)
	End If
End Function
	
Function IsRootDir(ByVal NomeDir)
Dim nPos

  NomeDir = Trim(NomeDir)
  'PAOLO171095 - se inizia con due \\ è il nome di un server di rete
  If Left(NomeDir, 2) = "\\" Then
    'è una root se a partire dal terzo carattere non ci sono altri \ (a parte quello di fondo)
    'p.e. \\TOCEH\ oppure \\TOCEH sono root dirs
    '     \\TOCEH\RAI non è una root
    nPos = InStr(3, NomeDir, "\")
    If nPos = 0 Or nPos = Len(NomeDir) Then
      IsRootDir = True
    Else
      IsRootDir = False
    End If
  ElseIf Mid(NomeDir, 2) = ":\" Then
    'C:\ è una root dir
    IsRootDir = True
  Else
    IsRootDir = False
  End If
End Function

Function GetExt(ByVal NomeFile)
Dim pos

	if IsNull(NomeFile) then
		GetExt = ""
	else
		pos = InStrRev(NomeFile, ".")
		If pos Then
		  GetExt = Mid(NomeFile, pos)
		Else
		  GetExt = ""
		End If
  end if
End Function

Function ChangeExt(ByVal NomeFile, ByVal NewExt) 
Dim pos

  'remove dot from NewExt string
  If Left(NewExt, 1) = "." Then
    NewExt = Mid(NewExt, 2)
  End If
  
  'trim the filename before the dot
  pos = InStrRev(NomeFile, ".")
  If pos Then
		NomeFile = Left(NomeFile, pos-1)
	end if
	
	'add the new ext if not empty
	if NewExt <> "" then
    ChangeExt = NomeFile & "." & NewExt
  else
		ChangeExt = NomeFile
  End If
end function

Function IsLeft(ByVal szStr, ByVal szLeft)
  IsLeft = (StrComp(Left(szStr, Len(szLeft)), szLeft, vbTextCompare) = 0)
End Function

Function IsRight(ByVal szStr, ByVal szRight)

  IsRight = (StrComp(Right(szStr, Len(szRight)), szRight, vbTextCompare) = 0)
  if Err then 
		Response.write "IsRight:" & Err.Description & "<br>"
  	Response.write "szStr=" & szStr & " szRight=" & szRight & "<br>"
		Response.end
	end if
End Function

Function BackSlash(ByVal szURLPath , ByVal bValue)
  szURLPath = Trim(szURLPath)
  If Right(szURLPath, 1) = "\" Then
    If bValue = False Then
      szURLPath = Left(szURLPath, Len(szURLPath) - 1)
    End If
  Else
    If bValue = True and Right(szURLPath, 1) <> "\" Then
      szURLPath = szURLPath & "\"
    End If
  End If
  BackSlash = szURLPath
End Function

Function Slash(ByVal szURLPath , ByVal bValue)
  szURLPath = Trim(szURLPath)
  If Right(szURLPath, 1) = "/" Then
    If bValue = False Then
      szURLPath = Left(szURLPath, Len(szURLPath) - 1)
    End If
  Else
    If bValue = True and Right(szURLPath, 1) <> "/" Then
      szURLPath = szURLPath & "/"
    End If
  End If
  Slash = szURLPath
End Function

function SafeValueStr(vValue)
	if IsNull(vValue) then
		SafeValueStr = ""
	else
		SafeValueStr = vValue
	end if
end function

function SafeValueNum(vValue)

on error resume next

	if IsNull(vValue) = True or vValue = "" then
		SafeValueNum = 0
	elseif IsAllNum(vValue, True) = False then
		SafeValueNum = 0
	else
		SafeValueNum = SafeCDbl(vValue)
	end if
	
	if Err then
		'response.write "SafeValueNum-" & Err.description & "<br>"
		'response.write "vValue=" & vValue & "<br>"
		Err.clear
	end if
end function

function SafeValueDate(byval sDate)

on error resume next

	if IsDate(sDate) then
		SafeValueDate = CDate(sDate)
	elseif IsLeft(sDate, "'") then
		SafeValueDate = DateSQL(sDate)
	else
		SafeValueDate = empty
	end if
	if Err then
		SafeValueDate = empty
	end if
end function

'************************ FORM EDITING **********************
function ElemValue(objElem) 
	if objElem.type = "checkbox" then
		ElemValue = objElem.checked
	else
		ElemValue = objElem.value
	end if
end function

Sub StoreFormValues(frmObj)
dim nIndex

	Redim arFormItems(frmObj.elements.length)
	nIndex = 0
	for each objElem in frmObj.elements
		arFormItems(nIndex) = ElemValue(objElem)
		nIndex = nIndex + 1
	next 
End Sub

function GetFormSavedValue(frmObj, szFldName)
dim nIndex, objElem

	nIndex = 0
	for each objElem in frmObj.elements
		if Ucase(objElem.name) = UCase(szFldName) then
			GetFormSavedValue = arFormItems(nIndex)
			exit function
		end if
		nIndex = nIndex + 1
	next 
	
	GetFormSavedValue = "(not found)"
End function

function IsFormDirty(frmObj)
dim nIndex, bDirty

	nIndex = 0
	bDirty = False
	for each objElem in frmObj.elements 
		if arFormItems(nIndex) <> ElemValue(objElem) then
			bDirty = True
			objElem.style.backgroundcolor = "hotpink"
		end if
		nIndex = nIndex + 1
	next 	
	
	IsFormDirty = bDirty
end function

function CheckFormFields(frmObj)
dim objElem

	for each objElem in frmObj.elements 
		if objElem.classname = "NumInput" then
			if not IsAllNum(objElem.value, False) then
				msgbox "Invalid number format in field " & objElem.name & "!", vbExclamation 
				objElem.focus
				CheckFormFields = false
				exit function
			end if
		elseif objElem.classname = "NegNumInput" then
			if not IsAllNum(objElem.value, True) then
				msgbox "Invalid number format in field " & objElem.name & "!", vbExclamation 
				objElem.focus
				CheckFormFields = false
				exit function
			end if
		elseif objElem.classname = "IntNumInput" then
			if IsAllNumInt(objElem.value)=False then
				msgbox "Invalid number format in field " & objElem.name & "!", vbExclamation 
				objElem.focus
				CheckFormFields = false
				exit function
			end if					
		elseif objElem.classname = "DateInput" then
			if not IsITADate(objElem.value) then
				msgbox "Invalid date format in field " & objElem.name & " (please use dd/mm/yyyy)!", vbExclamation 
				objElem.focus
				CheckFormFields = false
				exit function
			end if
		elseif objElem.classname = "TimeInput" then
			if not IsTimeFmt(objElem.value) then
				msgbox "Invalid time format in field " & objElem.name & " (please use hh.mm)!", vbExclamation 
				objElem.focus
				CheckFormFields = false
				exit function
			end if
		end if
	next
	CheckFormFields = True
end function

'check if format is 'hh.mm(.ss)', hh<24, mm<60, (ss<60)
function IsTimeFmt(szTime)
dim szH, szM, szS

	szH = Left(szTime, 2)
	szM = Mid(szTime, 4, 2)
	if Len(szTime) > 5 then 
		szS = Mid(szTime, 7, 2)
	else
		szS = "00"
	end if
		
	if IsAllNumInt(szH) = False then
		IsTimeFmt = False
	elseif IsAllNumInt(szM) = False then
		IsTimeFmt = False
	elseif IsAllNumInt(szS) = False then
		IsTimeFmt = False
		
	elseif CInt(szH)>23 then
		IsTimeFmt = False
	elseif CInt(szM)>59 then
		IsTimeFmt = False
	elseif CInt(szS)>59 then
		IsTimeFmt = False
	else
		IsTimeFmt = True
	end if
end function

Function IsAllNum(ByVal szStr, Byval bNeg)
Dim nPos
Dim szCar

	szStr = Trim(szStr)
	For nPos = 1 To Len(szStr)
	  szCar = Mid(szStr, nPos, 1)
	  If Not (InStr("0123456789+,.", szCar) <> 0 or (szCar = "-" and bNeg = True)) Then
	    IsAllNum = False
	    Exit Function
	  End If
	Next
	IsAllNum = True
End Function

Function IsAllNumInt(ByVal szStr)
	IsAllNumInt = IsAllInCharSet(szStr, "0123456789")
End Function

Function IsAllInCharSet(ByVal szStr, Byval szCharSet)
Dim nPos
Dim szCar

	szStr = Trim(szStr)
	For nPos = 1 To Len(szStr)
	  szCar = Mid(szStr, nPos, 1)
	  If InStr(szCharSet, szCar)=0 Then
	    IsAllInCharSet = False
	    Exit Function
	  End If
	Next
	IsAllInCharSet = True
End Function

function MakeIDName(byval szValue)
Dim nPos, szCar, szStr

	szStr = ""
	For nPos = 1 To Len(szValue)
	  szCar = Mid(szValue, nPos, 1)
	  If InStr("0123456789abcdefghijklmnopqrstuvwxyz_", lcase(szCar))=0 Then
			szStr = szStr & "_"
	  else
			szStr = szStr & szCar
	  end if
	next
	MakeIDName = "K" & szStr
end function

function MakeFileName(byval szValue, byval bAcceptAll)
	MakeFileName = MakeFileName2(szValue, bAcceptAll, "", "", "_")
end function

function MakeFileName2(byval szValue, byval bAcceptAll, byval szOKChars, byval szReplChar)
Dim nPos, szCar, szStr

	if szOKChars = "" then szOKChars = "0123456789abcdefghijklmnopqrstuvwxyz-_"
	if bAcceptAll then szOKChars = szOKChars & "£$£%&()='ì^+[]§ù#@;." 
	
	szStr = ""
	For nPos = 1 To Len(szValue)
	  szCar = Mid(szValue, nPos, 1)
	  If InStr(szOKChars, lcase(szCar))=0 Then
			szStr = szStr & szReplChar
	  else
			szStr = szStr & szCar
	  end if
	next
	MakeFileName2 = szStr
end function

Sub EditDateFieldEx(objFld, szDlgTitle, nCanBeNone)
dim szOrigValue, szRet, bUpdated
dim szTimeValue

	szOrigValue = objFld.value
	if szOrigValue <> "" then
		'12/07/2004 22:56
		if Mid(szOrigValue, 11, 1) = " " then
			szTimeValue = Mid(szOrigValue, 12)
		end if
		szOrigValue = SQLDate(DateITA(szOrigValue))
	end if
	bUpdated = False
	szRet = window.showModalDialog("../common/Calendar.asp?DateValue=" & szOrigValue & "&TimeValue=" & szTimeValue & "&CanBeNone=" & nCanBeNone & "&DlgTitle=" & szDlgTitle, _
																 null, "dialogWidth:450px;dialogHeight:440px")
	if IsNull(szRet) then
		objFld.value = ""
		bUpdated = True
	elseif szRet <> "" then
		' '20040712' 22:56
		if Mid(szRet, 11, 1) = " " then
			objFld.value = ITADate(DateSQL(Left(szRet,12))) & " " & Mid(szRet, 12)
		else
			objFld.value = ITADate(DateSQL(szRet))
		end if
		bUpdated = True
	end if
on error resume next
	if bUpdated then
		execute objFld.name & "_onchange"
	end if
end sub
'************************ FORM EDITING END *******************

Function IsUCase(ByVal szChar)
  If szChar >= "A" And szChar <= "Z" Then
    IsUCase = True
  Else
    IsUCase = False
  End If
End Function

Function Ucase2Spaces(ByVal szStr)
Dim nIndex 
Dim szRes 
Dim szChar
  
  For nIndex = 1 To Len(szStr)
    szChar = Mid(szStr, nIndex, 1)
    If IsUCase(szChar) And nIndex > 1 Then
      If IsUCase(Mid(szStr, nIndex - 1, 1)) = False Then
        szRes = szRes & " "
      End If
    End If
    szRes = szRes & szChar
  Next
  
  Ucase2Spaces = szRes
End Function

function CapLetter(byval szStr)
	if len(szStr)>1 then
		CapLetter = Ucase(Left(szStr,1)) & LCase(mid(szStr,2) )
	else
		CapLetter = szStr
	end if
end function

function CapWords(byval szStr)
dim arWords, nWord

	arWords = Split(szStr)
	szStr = ""
	for nWord = 0 to Ubound(arWords)
		if szStr <> "" then szStr = szStr & " "
		szStr = szStr & UCase(Left(arWords(nWord),1)) & LCase(Mid(arWords(nWord),2))
	next
	
	CapWords = szStr
end function

function FldType(objField)
	'if SQLSERVERDB then
		select case objField.type
			case 2, 3, 4, 5, 6, 16, 17, 18, 19, 20 , 21, 131
				FldType = "num"
			case 7, 133, 134, 135
				FldType = "dat"
			case else
				FldType = "str"
		end select
	'else
	'	select case objField.type
	'		case 3, 4, 5, 6, 17
	'			FldType = "num"
	'		case 7
	'			FldType = "dat"
	'		case else
	'			FldType = "str"
	'	end select
	'end if
end function

'ADO - NUMBERS
'2		smallint	0		INT
'3		int				0		INT
'4		single		1
'5		double		1
'6		currency	1
'16		tinyint		0		INT
'17		utinyint	0		INT
'18		usmallint	0		INT
'19		uint			0		INT
'20		bigint		0		INT
'21		ubigint		0		INT
'131	numeric		1

'7		date
'133	dbdate
'134	dbtime
'135	dbtimestamp

function FldHasDec(objField)
		select case objField.type
			case 4, 5, 6, 131
				FldHasDec = True
			case else
				FldHasDec = False
		end select
end function

function FldFmt(nType, vValue)
	if IsNull(vValue) then
		FldFmt = null
	else
		select case ntype
			case 3				'int
				FldFmt = FmtMoney(vValue,0)
			case 5,131		'float?, decimal
				FldFmt = FmtMoney(vValue,2)
			case 135
				FldFmt = ITADate(vValue)
			case else
				FldFmt = vValue
		end select
	end if
end function

function FmtMoney(byval nValue, Byval nDec)
on error resume next
	FmtMoney = FormatNumber(nValue, nDec)
end function

function FmtGenNum(byval nValue, Byval nDec)
on error resume next
	FmtGenNum = FormatNumber(nValue, nDec,,,False)
end function

Function FmtFileSizeKB(ByVal nSize)
  FmtFileSizeKB = FormatNumber(nSize / 1024, 2,,,true) & " Kb"
End Function

Function FmtFileSizeMB(ByVal nSize)
  FmtFileSizeMB = FormatNumber(nSize / 1024 / 1024, 2,,,true) & " Mb"
End Function

Function FmtFileSizeGB(ByVal nSize)
  FmtFileSizeGB = FormatNumber(nSize / 1024 / 1024 / 1024, 2,,,true) & " Gb"
End Function

Function FmtFileSizeAuto(ByVal nSize)

On Error resume next
  
  If nSize >= 1024 * 1024 * 1024 Then
    FmtFileSizeAuto = FmtFileSizeGB(nSize)
  ElseIf nSize >= 1024 * 1024 Then
    FmtFileSizeAuto = FmtFileSizeMB(nSize)
  ElseIf nSize >= 1024 Then
    FmtFileSizeAuto = FmtFileSizeKB(nSize)
  Else
    FmtFileSizeAuto = FormatNumber(nSize, 0,,,true) & " bytes"
  End If

	if Err then
		FmtFileSizeAuto = FormatNumber(nSize, 0,,,true) & " bytes"
	end if
End Function

function GetMin(byval Val1, byval Val2)
	GetMin = iif(Val1 < Val2, Val1, Val2)
end function
	
function GetMax(byval Val1, byval Val2)
	GetMax = iif(Val1 < Val2, Val2, Val1)
end function

function ReplStr(byval nTimes, byval szStr)
dim szRes

	do while nTimes
		szRes = szRes & szStr	
		nTimes = nTimes - 1
	loop
	
	ReplStr = szRes
end function

'add a new param/value pair into querystring replacing the param if already exists
Function AddQSParam(byval szQS, byval szParamName,byval  szParamValue)
Dim nPos, nEnd

  nPos = InStr(1, szQS, szParamName & "=", vbTextCompare)
  If nPos Then
    nEnd = InStr(nPos, szQS, "&")
    If nEnd = 0 Then nEnd = Len(szQS)+1
    szQS = Left(szQS, nPos - 1) & szParamName & "=" & szParamValue & Mid(szQS, nEnd)
  Else
    If InStr(szQS, "?") Then
      szQS = szQS & "&" & szParamName & "=" & szParamValue
    Else
      szQS = szQS & "?" & szParamName & "=" & szParamValue
    End If
  End If
	  
  AddQSParam = szQS
End Function

'used by EditContent HTC (Action-Picture/Link to Page)
function SelFile(byval szFileExt, byval szStartFolder, byval szWebBase, byval bAbsLink)
dim szRet, szFolder
dim szNewFolder, nPos, nFltImageSize
dim bPreview, bViewAll

	SelFile = ""
	szFolder = GetPath(szStartFolder)
	bPreview = false
	bViewAll = false
	nFltImageSize = 0
	do while true
		szRet = window.showModalDialog(szWebBase & "Common/SelFile.asp?FileExts=" & szFileExt & "&StartFolder=" & szFolder & _
																	"&AbsLink=" & iif(bAbsLink,1,0) & "&FltImageSize=" & nFltImageSize & "&Preview=" & iif(bPreview, 1, 0) & "&ViewAll=" & iif(bViewAll, 1, 0) , _
																	null, "dialogWidth:900px;dialogHeight:700px;resizable:yes;")
		if szRet = "" then
			exit do
		elseif IsLeft(szRet, "file=") then
			szRet = Mid(szRet, len("file=")+1)
			if Not IsLeft(szRet, "/") then
				szRet = Slash(szFolder, iif(szFolder<>"", true, false)) & szRet
			end if
			SelFile = szRet
			exit do
		elseif IsLeft(szRet, "folder=") then
			szNewFolder = Mid(szRet, len("folder=")+1)
			if szNewFolder = ".." then
				nPos = InstrRev(szFolder, "/")
				if nPos then
					szFolder = Left(szFolder, nPos-1)
				else
					szFolder = ""
				end if
			else
				szFolder = Slash(szFolder, iif(szFolder<>"", true, false)) & szNewFolder
			end if
		elseif IsLeft(szRet, "preview=0") then
			bPreview = false
		elseif IsLeft(szRet, "preview=1") then
			bPreview = true
		elseif IsLeft(szRet, "viewall=0") then
			bViewAll = false
		elseif IsLeft(szRet, "viewall=1") then
			bViewAll = true
		elseif IsLeft(szRet, "FltImageSize=") then 
			nFltImageSize = Mid(szRet, len("FltImageSize=")+1)
		end if
	loop
end function

function IsAbsURL(szURL)
	if IsLeft(szURL, "http://") or IsLeft(szURL, "https://") or IsLeft(szURL, "/") then
		IsAbsURL = True
	else
		IsAbsURL = False
	end if
end function

function URLHasProtocolOrJS(byval szURL)
	if Instr(szURL, "://") then
		URLHasProtocolOrJS = True
	elseif IsLeft(szURL, "Javascript:") then
		URLHasProtocolOrJS = True
	else
		URLHasProtocolOrJS = False
	end if
end function

function GetURLServer(byval szURL)
	if IsLeft(szURL, "http://") then
		szURL = Mid(szURL, len("http://") + 1)
	elseif IsLeft(szURL, "https://") then
		szURL = Mid(szURL, len("https://") + 1)
	else
		szURL = ""
	end if
	GetURLServer = GetField(szURL, 0, "/")
end function

Function SecDateTime(ByVal dValue)
  SecDateTime = DateDiff("s", DateSerial(2000, 1, 1), dValue)
End Function

Function DateTimeSec(ByVal nValue)
	DateTimeSec = DateAdd("s", nValue, DateSerial(2000, 1, 1))
End Function

Function TimeToMin(ByVal dValue)
	TimeToMin = hour(dValue) * 60 + minute(dValue)
End Function

Function MinToTime(ByVal nValue)
	MinToTime = TimeSerial(Int(nValue/60), nValue mod 60, 0)
End Function

Const GETDELIMSTR_NOTFOUND = "(not found!)"

Function GetDelimStr(ByVal szBuffer , ByVal szStartDelim , ByVal szEndDelim )
Dim nStartPos 
Dim nEndPos 
Dim szValue 
  
  If szStartDelim = "" Then
    nStartPos = 1
  Else
    nStartPos = InStr(1, szBuffer, szStartDelim, vbTextCompare)
  End If
  If nStartPos Then
    If szEndDelim = "" Then
      nEndPos = Len(szBuffer) + 1
    Else
      nEndPos = InStr(nStartPos + Len(szStartDelim), szBuffer, szEndDelim, vbTextCompare)
    End If
    If nEndPos > nStartPos Then
      GetDelimStr = Mid(szBuffer, nStartPos + Len(szStartDelim), _
                    nEndPos - nStartPos - Len(szStartDelim))
      Exit Function
    End If
  End If
  GetDelimStr = GETDELIMSTR_NOTFOUND
End Function

Function GetDelimStrRev(ByVal szBuffer , ByVal szStartDelim , ByVal szEndDelim )
Dim nStartPos 
Dim nEndPos 
Dim szValue 
  
  If szStartDelim = "" Then
    nStartPos = 1
  Else
    nStartPos = InStrRev(szBuffer, szStartDelim, len(szBuffer), vbTextCompare)
  End If
  If nStartPos Then
    If szEndDelim = "" Then
      nEndPos = Len(szBuffer) + 1
    Else
      nEndPos = InStr(nStartPos + Len(szStartDelim), szBuffer, szEndDelim, vbTextCompare)
    End If
    If nEndPos > nStartPos Then
      GetDelimStrRev = Mid(szBuffer, nStartPos + Len(szStartDelim), nEndPos - nStartPos - Len(szStartDelim))
      Exit Function
    End If
  End If
  GetDelimStrRev = GETDELIMSTR_NOTFOUND
End Function

function SafeInt(byval cValue)
	if cValue = "" then
		SafeInt = 0
	else
		SafeInt = Cint(cValue)
	end if
end function

function HexLng(byval szHex)
	HexLng = CLng("&H" & szHex)
end function

function HexColor(byval nRed, byval nGreen, byval nBlue)
	HexColor = "#" & ucase(PadStr(hex(nRed),2) & PadStr(hex(nGreen),2) & PadStr(hex(nBlue),2))
end function

'szColor = #F0F0F0
sub GetColorsRGB(byval szColor, byref nRed, byref nGreen , byref nBlue)
	nRed = HexLng(Mid(szColor, 2, 2))
	nGreen = HexLng(Mid(szColor, 4, 2))
	nBlue = HexLng(Mid(szColor, 6, 2))
end sub

'nSeed (higher => more ids less differentiation)
'# unique colors (ids) = nSeed ^ 3
' 2 for 8 ids
' 3 for 27 ids
' 4 for 64 ids
' 5 for 225 ids ...
' nBrightness = 
function IDtoColor(byval nID, byval nSeed, byval nBrightness)
Dim nR, nG, nB, nStep
				
	nStep = (256 / nSeed) + nBrightness
	nR = Int((nID-1) / (nSeed * nSeed)) mod nSeed
	nG = Int((nID-1) / nSeed) mod nSeed
	nB = (nID-1) mod nSeed
					
	IDtoColor = HexColor(nR * nStep, nG * nStep, nB * nStep)
end function

function DelTrailChar(byval szValue, byval szChar)
	if Right(szValue,1) = szChar then 
		szValue = Left(szValue, Len(szValue)-1)
	end if
	DelTrailChar = szValue
end function

Function DelTrailStr(ByVal szValue, ByVal szStr)
  If Right(szValue, Len(szStr)) = szStr Then
    szValue = Left(szValue, Len(szValue) - Len(szStr))
  End If
  DelTrailStr = szValue
End Function
	
function SQLQuotes(byval szValue)
	if IsNull(szValue) then
		SQLQuotes = ""
	else
		SQLQuotes = Replace(szValue , "'", "''")
	end if
end function
	
function StrCat(byval nNumber, byval szStr)
dim szRes
	
	szRes = ""
	do while nNumber > 0 
		szRes = szRes & szStr
		nNumber = nNumber -1
	loop
	StrCat = szRes
end function	

function FindPrevDay(byval dDate, byval nWDay, byval bSkipCurrent)
	if bSkipCurrent = False then
		if WeekDay(dDate) = nWDay then
			FindPrevDay = dDate
			exit function
		end if
	end if
	
	do while True
		dDate = DateAdd("d", -1, dDate)
		if WeekDay(dDate) = nWDay then exit do
	loop
	FindPrevDay = dDate
end function

function FindNextDay(byval dDate, byval nWDay, byval bSkipCurrent)
	if bSkipCurrent = False then
		if WeekDay(dDate) = nWDay then
			FindNextDay = dDate
			exit function
		end if
	end if

	do while True
		dDate = DateAdd("d", +1, dDate)
		if WeekDay(dDate) = nWDay then exit do
	loop
	FindNextDay = dDate
end function

function GetValueOrDefault(byval vValue, byval vDefault)
	if IsNull(vValue) then
		GetValueOrDefault = vDefault
	else
		GetValueOrDefault = vValue
	end if
end function
	
function FormatTime12(byval dTime)
	FormatTime12 = FormatTime12Ex(dTime, True)
end function

function FormatTime12Ex(byval dTime, byval bPMAM)
dim nHour

	nHour = Hour(dTime)
	if nHour >= 13 then nHour = nHour -12
	
	if bPMAM = False then
		FormatTime12Ex = nHour & ":" & PadStr(Minute(dTime),2)
	elseif Hour(dTime) >= 12 then	
		FormatTime12Ex = nHour & ":" & PadStr(Minute(dTime),2) & " pm"
	else
		FormatTime12Ex = nHour & ":" & PadStr(Minute(dTime),2) & " am"
	end if
end function

function Int2YesNo(byval nValue)
	if nValue then
		Int2YesNo = "Yes"
	else
		Int2YesNo = "No"
	end if
end function

Function RemoveHTMLTags(ByVal szRiga)
Dim bInTag, nIndex, szRes, nChar

  szRes = ""
  bInTag = False
  For nIndex = 1 To Len(szRiga)
    nChar = Asc(Mid(szRiga, nIndex, 1))
    If Chr(nChar) = "<" Then
      bInTag = True
    ElseIf Chr(nChar) = ">" Then
      bInTag = False
    ElseIf Not bInTag Then
      szRes = szRes & Chr(nChar)
    End If
  Next
  RemoveHTMLTags = szRes
End Function

function HTML2Text(byval szBuffer)
	szBuffer = Replace(szBuffer, vbcrlf, vblf)
	szBuffer = Replace(szBuffer, vblf, "")
	szBuffer = Replace(szBuffer, vbTab, "")
	szBuffer = Replace(szBuffer, "<br>", vbcrlf, 1, -1, vbTextCompare)
	szBuffer = Replace(szBuffer, "</div>", vbcrlf, 1, -1, vbTextCompare)
	szBuffer = RemoveHTMLTags(szBuffer)
	szBuffer = DecodeHTMLMacros(szBuffer)
	do while Instr(szBuffer, "  ") > 0
		szBuffer = Replace(szBuffer, "  ", " ")
  loop
  HTML2Text = szBuffer
end function
	
Function DecodeHTMLMacros(ByVal szRiga)
	'&#224;
	szRiga = Replace(szRiga, "&nbsp;", " ")
  szRiga = Replace(szRiga, "&nbsp;", " ")
  szRiga = Replace(szRiga, "&#9;", vbTab)
  szRiga = Replace(szRiga, "&#9", "")
  If szRiga = " " Then szRiga = ""
  DecodeHTMLMacros = szRiga
End Function

function SafeDateDiff(byval szUnit, byval dStart, byval dEnd)
dim nDiff
	
	nDiff = DateDiff(szUnit, dStart, dEnd)
	if nDiff = 0 then
		SafeDateDiff = 1
	else
		SafeDateDiff = nDiff
	end if
end function 

function ValueInList(byval szVList, byval szValue, byval szSep)
	if InStr(1, szSep & szVList & szSep, szSep & szValue & szSep, vbTextCompare) then
		ValueInList = True
	else	
		ValueInList = False
	end if
end function 

function RoundBy5(nNum)
	RoundBy5 = Round(nNum * 2/ 10 , 0)* 10 /2
end function

'szValidChars rules over szInvalidChars
function CleanStr(byval szString, byval szInvalidChars,  byval szValidChars, byval nCompare)
dim nCar, szStr

	szStr = ""
	if Not IsNull(szString) then
		for nCar = 1 to len(szString)
			if Instr(1, szValidChars, Mid(szString, nCar, 1), nCompare) > 0 then
				szStr = szStr & Mid(szString, nCar, 1)
			elseif Instr(1, szInvalidChars, Mid(szString, nCar, 1), nCompare) = 0 then
				szStr = szStr & Mid(szString, nCar, 1)
			end if
		next
	end if
		
	CleanStr = szStr
end function 

Function DumpString(ByVal szStr)
Dim nIndex 
Dim szRes
Dim szCar

	szRes = ""
	For nIndex = 1 To Len(szStr)
	  szCar = Mid(szStr, nIndex, 1)
	  If Asc(szCar) >= 32 Then
	    szRes = szRes & szCar
	  Else
	    szRes = szRes & "[" & Asc(szCar) & "]"
	  End If
	Next
	DumpString = szRes
End Function

function GetTagAttr(byval szTag, byval szAttrName)
dim szValue, nPos, nEnd
'<map name="Map5">
		
	szTag = GetDelimStr(szTag, szAttrName & "=", "")
	'"Map5">
	if Isleft(szTag, chr(34)) then
		'<map name="Map5" other=ddd>
		szValue = GetDelimStr(szTag, chr(34), chr(34))
	elseif Instr(szTag, " ") then
		'<map name=Map5 style=diodfio>
		szValue = GetDelimStr(szTag, "", " ")
	else
		'<map pippo=3 name=Map5>
		szValue = GetDelimStr(szTag, "", ">")
	end if
	GetTagAttr = RemoveQuotas(szValue, "")
end function	

Function RemoveQuotas(ByVal szStringa, byval szQuota)
	if szQuota = "" then szQuota = Chr(34)
  If Left(szStringa, 1) = szQuota Then
    szStringa = Mid(szStringa, 2)
  End If
  If Right(szStringa, 1) = szQuota Then
    szStringa = Mid(szStringa, 1, Len(szStringa) - 1)
  End If
  RemoveQuotas = szStringa
End Function

Function GetTimeStr(ByVal nSecs)
Dim szStr

  szStr = ""
  Do While True
    If nSecs < 60 Then
      szStr = szStr & Int(nSecs) & " secs"
      nSecs = 0
    ElseIf nSecs < 60 * 60 Then
      szStr = szStr & Int(nSecs / 60) & " mins"
      nSecs = nSecs - Int(nSecs / 60) * 60
    ElseIf nSecs < CDbl(60) * 60 * 24 Then
      szStr = szStr & Int(nSecs / (60 * 60)) & " hours"
      nSecs = nSecs - Int(nSecs / (60 * 60)) * (60 * 60)
    Else
      szStr = szStr & Int(nSecs / (CDbl(60) * 60 * 24)) & " days"
      nSecs = nSecs - Int(nSecs / (CDbl(60) * 60 * 24)) * (CDbl(60) * 60 * 24)
    End If
    If nSecs <= 0 Then Exit Do
    szStr = szStr & ", "
  Loop
  GetTimeStr = szStr
End Function

'http://support.microsoft.com/kb/320375
Function CreateGUIDRnd(byval nLength)
Dim nCounter, szGUID
Const szValid = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  
  Randomize Timer
  For nCounter = 1 To nLength
    szGUID = szGUID & Mid(szValid, Int(Rnd(1) * Len(szValid)) + 1, 1)
  Next
  CreateGUIDRnd = szGUID
End Function

Function CreateGUID()
Dim tmpTemp

  tmpTemp = Right(String(4,48) & Year(Now()),4)
  tmpTemp = tmpTemp & Right(String(4,48) & Month(Now()),2)
  tmpTemp = tmpTemp & Right(String(4,48) & Day(Now()),2)
  tmpTemp = tmpTemp & Right(String(4,48) & Hour(Now()),2)
  tmpTemp = tmpTemp & Right(String(4,48) & Minute(Now()),2)
  tmpTemp = tmpTemp & Right(String(4,48) & Second(Now()),2)
  CreateGUID = tmpTemp
End Function

'Island_Advisor.asp#Tobago, Island_Advisor.asp?par1=#ciao&par2=pippo ->Island_Advisor.asp
function GetURLWithNoQS(byval szURL)
	szURL = GetField(szURL, 0, "?")
	GetURLWithNoQS = GetField(szURL, 0, "#")
end function

Function Ceiling(intNumber) 
Dim dblNumber 
		
	dblNumber = CDbl(intNumber)
	If Int(dblNumber * 10) MOD 10 > 0 Then
		Ceiling = Int(dblNumber) + 1
	Else
		Ceiling = Int(dblNumber)
	End If
End Function

function GetRoundTime(byval dTime, byval nPrecMin, byval bCeiling)
dim nMinute
	
	if bCeiling then 
		nMinute = Ceiling(Minute(dTime)/nPrecMin) * nPrecMin
	else
		nMinute = Int(Minute(dTime)/nPrecMin) * nPrecMin
	end if
	GetRoundTime = CDate(Hour(dTime) & ":" & nMinute)
end function

sub PermanentRedirect(byval szNewURL)
	'Response.Redirect szNewURL 
	Response.Status = "301 Moved Permanently" 
	Response.addheader "Location", szNewURL
	Response.end
end sub