File: D:/HostingSpaces/RImmers/duitsedog.tk/wwwroot/inc_functions.asp
<%
Const c_intAantFotosPerPagina = 8
Function ValidEmailAddress(ByVal strEmail)
ValidEmailAddress = InStr(strEmail,"@") > 1 And InStr(strEmail,".")>3 And InStr(strEmail," ")="0" And Len(strEmail)>4
End Function
Sub WriteTableHead(ByVal strColumnName, ByVal strSort, ByVal strCurSort, ByVal strSortOrder, ByVal strUrl, ByVal strParams)
Dim strImgSort, strRevSortOrder, blnSortChanged
If inStr(strCurSort,",") Then
blnSortChanged = (strSort = Left(strCurSort,inStr(strCurSort,",")-1))
Else
blnSortChanged = (strSort = strCurSort)
End If
If blnSortChanged Then
If strSortOrder = "ASC" Then
strImgSort =" <img src=""/images/icons/ascend.gif"" border=""0"">"
strRevSortOrder = "DESC"
Else
strImgSort = " <img src=""/images/icons/descend.gif"" border=""0"">"
strRevSortOrder = "ASC"
End If
Else
strImgSort= ""
strRevSortOrder = strSortOrder
End If
If Instr(strUrl,"?") Then
Response.Write("<a href=""" & strUrl & "&" & strParams & "sort=" & strSort & "&order=" & strRevSortOrder & """>" & strColumnName & strImgSort & "</a>")
Else
Response.Write("<a href=""" & strUrl & "?" & strParams & "sort=" & strSort & "&order=" & strRevSortOrder & """>" & strColumnName & strImgSort & "</a>")
End If
End Sub
Function IntToMonth(ByVal intM)
Select Case intM
Case 1: IntToMonth = "januari"
Case 2: IntToMonth = "februari"
Case 3: IntToMonth = "maart"
Case 4: IntToMonth = "april"
Case 5: IntToMonth = "mei"
Case 6: IntToMonth = "juni"
Case 7: IntToMonth = "juli"
Case 8: IntToMonth = "augustus"
Case 9: IntToMonth = "september"
Case 10: IntToMonth = "oktober"
Case 11: IntToMonth = "november"
Case 12: IntToMonth = "december"
End Select
End Function
Function IntToDayShort(ByVal intDay)
Select Case intDay
Case 1: IntToDayShort = "zo"
Case 2: IntToDayShort = "ma"
Case 3: IntToDayShort = "di"
Case 4: IntToDayShort = "wo"
Case 5: IntToDayShort = "do"
Case 6: IntToDayShort = "vr"
Case 7: IntToDayShort = "za"
End Select
End Function
Function IntToDayLong(ByVal intDay)
Select Case intDay
Case 1: IntToDayLong = "zondag"
Case 2: IntToDayLong = "maandag"
Case 3: IntToDayLong = "dinsdag"
Case 4: IntToDayLong = "woensdag"
Case 5: IntToDayLong = "donderdag"
Case 6: IntToDayLong = "vrijdag"
Case 7: IntToDayLong = "zaterdag"
End Select
End Function
Function Day_long(ByVal dat)
If dat <> "" Then
Select Case Weekday(dat)
Case 1: Day_long = "zondag"
Case 2: Day_long = "maandag"
Case 3: Day_long = "dinsdag"
Case 4: Day_long = "woensdag"
Case 5: Day_long = "donderdag"
Case 6: Day_long = "vrijdag"
Case 7: Day_long = "zaterdag"
End Select
Else
Day_long = ""
End if
End Function
Function IntToMonthShort(ByVal intM)
Select Case intM
Case 1: IntToMonthShort = "jan"
Case 2: IntToMonthShort = "feb"
Case 3: IntToMonthShort = "mrt"
Case 4: IntToMonthShort = "apr"
Case 5: IntToMonthShort = "mei"
Case 6: IntToMonthShort = "jun"
Case 7: IntToMonthShort = "jul"
Case 8: IntToMonthShort = "aug"
Case 9: IntToMonthShort = "sep"
Case 10: IntToMonthShort = "okt"
Case 11: IntToMonthShort = "nov"
Case 12: IntToMonthShort = "dec"
End Select
End Function
Function ISOWeek(dat)
Dim dbl
dbl = DateSerial(Year(dat + (8 - WeekDay(dat)) Mod 7 - 3), 1, 1)
ISOWeek = (dat - dbl - 3 + (WeekDay(dbl) + 1) Mod 7) \ 7 + 1
End Function
Function Werkdag(ByVal Datum)
Dim intDag
If IsDate(Datum) Then
If (Weekday(Datum, 2) = 7) Or (Weekday(Datum, 2) = 6) Then
Werkdag = False
Else
Werkdag = True
End If
Else
Werkdag = False
End If
End Function
Function initCap(ByVal str)
If Not IsNull(str) Then
initCap = Ucase(Left(str,1)) & Right(str,Len(str)-1)
Else
initCap = Null
End If
End function
Function FormatPercentage(ByVal pct)
If IsNull(pct) Then
FormatPercentage = "0"
Else
FormatPercentage = CStr(Round(pct*100,1))
End If
End Function
Function UD_FormatCurrency(ByVal dblC)
Dim strTmp
If Not IsNull(dblC) Then
strTmp = CStr(Int(dblC))
If Len(strTmp)>3 Then
strTmp = Mid(strTmp, 1, Len(strTmp)-3) & "," & Mid(strTmp, Len(strTmp)-2)
If Len(strTmp)>7 Then
strTmp = Mid(strTmp, 1, Len(strTmp)-7) & "," & Mid(strTmp, Len(strTmp)-6)
If Len(strTmp)>11 Then
strTmp = Mid(strTmp, 1, Len(strTmp)-11) & "," & Mid(strTmp, Len(strTmp)-10)
End If
End If
End If
Else
strTmp = ""
End If
UD_FormatCurrency = strTmp
End Function
Function FormatCurrency(ByVal dblC)
FormatCurrency = UD_FormatCurrency(dblC)
End Function
Function DayLong(ByVal dtm)
If Day(dtm)<10 Then
DayLong = "0" & Day(dtm)
Else
DayLong = Day(dtm)
End If
End Function
Function MonthLong(ByVal dtm)
If Month(dtm)<10 Then
MonthLong = "0" & Month(dtm)
Else
MonthLong = Month(dtm)
End If
End Function
Function HourLong(ByVal dtm)
If Hour(dtm)<10 Then
HourLong = "0" & Hour(dtm)
Else
HourLong = Hour(dtm)
End If
End Function
Function MinuteLong(ByVal dtm)
If Minute(dtm)<10 Then
MinuteLong = "0" & Minute(dtm)
Else
MinuteLong = Minute(dtm)
End If
End Function
Function Period(ByVal datum)
dim strMaand, strJaar
strMaand = Month(datum)
If LEN(strMaand)=1 Then
strMaand = "0" & strMaand
End If
strJaar = Year(datum)
Period = strMaand & "/" & strJaar
End Function
Function FormatDateParam(ByVal dat, ByVal strFormat)
If Not IsNull(dat) Then
Select Case strFormat
Case "dd-mm-yyyy": FormatDateParam = DayLong(dat) & "-" & MonthLong(dat) & "-" & Year(dat)
Case "hh:mm:ss": FormatDateParam = FormatTime(dat)
Case "dd-mm-yyyy hh:mm": FormatDateParam = DayLong(dat) & "-" & MonthLong(dat) & "-" & Year(dat) & " " & HourLong(dat) & ":" & MinuteLong(dat)
Case "dd-mmm-yyyy hh:mm": FormatDateParam = DayLong(dat) & "-" & IntToMonthShort(Month(dat)) & "-" & Year(dat) & " " & HourLong(dat) & ":" & MinuteLong(dat)
Case "dd mmm yyyy hh:mm": FormatDateParam = DayLong(dat) & " " & IntToMonthShort(Month(dat)) & " " & Year(dat) & " " & HourLong(dat) & ":" & MinuteLong(dat)
Case "dd-mmm-yyyy": FormatDateParam = DayLong(dat) & "-" & IntToMonthShort(Month(dat)) & "-" & Year(dat)
Case "dd mmm yyyy": FormatDateParam = DayLong(dat) & " " & IntToMonthShort(Month(dat)) & " " & Year(dat)
Case "dddd, mmmm yyyy": FormatDateParam = Day_long(dat) & ", " & IntToMonth(Month(dat)) & " " & Year(dat)
Case "dddd, dd mmmm yyyy": FormatDateParam = Day_long(dat) & ", " & Day(dat) & " " & IntToMonth(Month(dat)) & " " & Year(dat)
Case Else: FormatDateParam = CStr(dat)
End Select
Else
FormatDateParam = Null
End If
End Function
Function GeldigeDatum(intMonth,intDay,intYear)
GeldigeDatum = IsDate(Cstr(intMonth) & "-" & Cstr(intDay) & "-" & Cstr(intYear))
End Function
Function LaatsteDagnrVandeMaand(intMaand,intJaar)
dim dag
dag = 31
While (not GeldigeDatum(intmaand,dag,intjaar)) and (dag>0)
dag = dag - 1
Wend
LaatsteDagnrVandeMaand = dag
End Function
Function DecimalValue(ByVal dbl)
DecimalValue = (dbl - Fix(dbl))
End Function
Function FormatMinute(intMinute)
If Not IsNull(intMinute) Then
If intMinute<=9 Then
FormatMinute = "0" & intMinute
Else
FormatMinute = intMinute
End If
Else
FormatMinute = Null
End If
End Function
Function DblToMinuts(Byval dbl)
If Not IsNull(dbl) Then
DblToMinuts = CInt((60 * (100 * DecimalValue(dbl) ) ) / 100 )
If DblToMinuts<=9 Then DblToMinuts = "0" & DblToMinuts
Else
DblToMinuts = Null
End If
End Function
Function DblToHoursMinuts(Byval dbl)
dim intHours,intMinuts,strHours,strMinuts
If Not IsNull(dbl) Then
intHours = Fix(dbl)
intMinuts = CInt((60 * (100 * DecimalValue(dbl) ) ) / 100 )
strHours = intHours
If intMinuts<=9 Then
strMinuts = "0" & intMinuts
Else
strMinuts = intMinuts
End If
DblToHoursMinuts = strHours & ":" & strMinuts
Else
DblToHoursMinuts = Null
End If
End Function
Function FormatDouble(ByVal dbl, ByVal strFormat)
dim intUren,intMinuten
intUren = Fix(dbl)
intMinuten = DblToMinuts(dbl)
Select Case strFormat
Case "hh:mm" If (intMinuten = 0) Then
FormatDouble = Cstr(intUren)
Else
If Len(Cstr(intMinuten)) = 1 Then
FormatDouble = Cstr(intUren) & ":0" & Cstr(intMinuten)
Else
FormatDouble = Cstr(intUren) & ":" & Cstr(intMinuten)
End If
End If
Case Else FormatDouble = dbl
End Select
End Function
Function FormatTime(ByVal datD, ByVal strFormat)
Dim intUren,intMinuten
If Not IsNull(datD) Then
intUren = Hour(datD)
intMinuten = Minute(datD)
Select Case strFormat
Case "hh:mm" If (intMinuten = 0) Then
FormatTime = Cstr(intUren) & ":00"
Else
If intMinuten < 10 Then
FormatTime = Cstr(intUren) & ":0" & Cstr(intMinuten)
Else
FormatTime = Cstr(intUren) & ":" & Cstr(intMinuten)
End If
End If
Case Else FormatTime = ""
End Select
Else
FormatTime = ""
End If
End Function
Function FormatFilesize(ByVal bytes)
If bytes < 1024 Then
FormatFileSize = Cstr(bytes) & " b"
ElseIf bytes < 1024000 Then
FormatFileSize = Cstr(Round(bytes/1024,0)) & " Kb"
ElseIf bytes < 1024000000 Then
FormatFileSize = Cstr(Round(bytes/1024000,1)) & " Mb"
ElseIf bytes < 1024000000000 Then
FormatFileSize = Cstr(Round(bytes/1024000000,2)) & " Gb"
Else FormatFileSize = bytes
End If
End Function
Function FormatTelnr(ByVal str)
dim strS,intI,blnB
If Not IsNull(str) Then
strS=""
If str<>"" Then
For intI = 1 to LEN(str)
If IsNumeric(Mid(str,intI,1)) Then
strS = strS & Mid(str,intI,1)
End If
Next
blnB = False
For intI = 1 to LEN(strS)
If (Mid(strS,intI,1)="6") and (Not blnB) Then
FormatTelnr = "06-"& Mid(strS,intI+1,4) &" "&Mid(strS,intI+5,4)
blnB = True
End if
Next
Else
FormatTelnr = ""
End If
Else
FormatTelnr = Null
End If
End Function
Function Bestandsnaam(ByVal str)
If Not IsNull(str) Then
Bestandsnaam = Mid(str, InstrRev(str, "\") + 1)
Else
Bestandsnaam = Null
End If
End Function
Function BestandsnaamZonderExtensie(ByVal str)
Dim strBestandsnaam, intEindPositie
If Not IsNull(str) Then
strBestandsnaam = Bestandsnaam(str)
intEindPositie = InStrRev(strBestandsnaam, ".") - 1
If intEindPositie<0 Then
intEindPositie = Len(strBestandsnaam)
End If
BestandsnaamZonderExtensie = Mid(strBestandsnaam, 1, intEindPositie)
Else
BestandsnaamZonderExtensie = Null
End If
End Function
Function Extensie(ByVal str)
If Not IsNull(str) Then
Extensie = Mid(str, InstrRev(str, ".") + 1)
Else
Extensie = Null
End If
End Function
Function IsInt(ByVal param)
on error resume next
IsInt = CInt(param)<>""
If Err.Number <> 0 Then
IsInt = False
End If
End Function
Function IsDbl(ByVal param)
on error resume next
IsDbl = CDbl(param)<>""
If Err.Number <> 0 Then
IsDbl = False
End If
End Function
Function Max(ByVal A, ByVal B)
If A<B Then
Max = B
Else
Max = A
End If
End Function
Function Min(ByVal A, ByVal B)
If A<B Then
Min = A
Else
Min = B
End If
End Function
Function Minimum(int1,int2)
If Cint(int1)<Cint(int2) Then
Minimum = int1
Else
Minimum = int2
End if
End Function
Function ISOWeek(dat)
Dim dbl
dbl = DateSerial(Year(dat + (8 - WeekDay(dat)) Mod 7 - 3), 1, 1)
ISOWeek = (dat - dbl - 3 + (WeekDay(dbl) + 1) Mod 7) \ 7 + 1
End Function
Function ISOYear(dat)
ISOYear = Year(dat + (8 - WeekDay(dat)) Mod 7 - 3)
End Function
Function NullReplace(str,s1,s2)
If Not IsNull(str) And Not IsNull(s1) And Not IsNull(s2) Then
NullReplace = replace(str,s1,s2)
ElseIf Not IsNull(str) And Not IsNull(s1) Then
NullReplace = replace(str,s1,"")
ElseIf Not IsNull(str) Then
NullReplace = str
Else
NullReplace = ""
End If
End Function
'------------------- SORTING ------------------------------
Sub AssignElAr(A,B,intI)
Dim i
For i = 0 To UBound(B,2)-1
A(i) = B(intI,i)
Next
End Sub
Sub AssignArEl(A,intI,B)
Dim i
For i = 0 To UBound(B)-1
A(intI,i) = B(i)
Next
End Sub
Sub AssignArAr(A,intI,B,intJ)
Dim i
For i = 0 To UBound(B,2)-1
A(intI,i) = B(intJ,i)
Next
End Sub
Sub QuickSort2(vec,intC,loBound,hiBound)
Dim pivotEl, pivotVal,loSwap,hiSwap,temp
ReDim pivotEl(UBound(vec,2))
ReDim temp(UBound(vec,2))
'== Two items to sort
if hiBound - loBound = 1 then
if vec(loBound,intC) > vec(hiBound,intC) then
Call AssignElAr(temp,vec,loBound)
Call AssignArAr(vec,loBound,vec,hiBound)
Call AssignArEl(vec,hiBound,temp)
End If
End If
'== Three or more items to sort
Call AssignElAr(pivotEl,vec,int((loBound + hiBound) / 2))
'pivotEl = vec(int((loBound + hiBound) / 2))
pivotVal = vec(int((loBound + hiBound) / 2),intC)
Call AssignArAr(vec,int((loBound + hiBound) / 2),vec,loBound)
Call AssignArEl(vec,loBound, pivotEl)
loSwap = loBound + 1
hiSwap = hiBound
do
'== Find the right loSwap
while loSwap < hiSwap and vec(loSwap,intC) <= pivotVal
loSwap = loSwap + 1
wend
'== Find the right hiSwap
while vec(hiSwap,intC) > pivotVal
hiSwap = hiSwap - 1
wend
'== Swap values if loSwap is less then hiSwap
if loSwap < hiSwap then
Call AssignElAr(temp,vec,loSwap)
Call AssignArAr(vec,loSwap,vec,hiSwap)
Call AssignArEl(vec,hiSwap,temp)
End If
loop while loSwap < hiSwap
Call AssignArAr(vec,loBound, vec,hiSwap)
Call AssignArEl(vec,hiSwap,pivotEl)
'== Recursively call function .. the beauty of Quicksort
'== 2 or more items in first section
if loBound < (hiSwap - 1) then Call QuickSort2(vec,intC,loBound,hiSwap-1)
'== 2 or more items in second section
if hiSwap + 1 < hibound then Call QuickSort2(vec,intC,hiSwap+1,hiBound)
End Sub 'QuickSort
Sub Sort2(ByRef Ar, ByVal intC)
Call QuickSort2(Ar,intC,0,UBound(Ar,1)-1)
End Sub
Sub AddCommaStr(ByRef strA, ByVal strT)
If IsNull(strA) Or strA = "" Then strA = strT Else strA = strA & ", " & strT
End Sub
Sub AddAndStr(ByRef strA, ByVal strT)
If IsNull(strA) Or strA = "" Then strA = strT Else strA = strA & " AND " & strT
End Sub
Function IntArrayAsCommaStr(ByVal Ar)
Dim strIn, i
If UBound(Ar)>0 Then
strIn = Null
For i = 0 To UBound(Ar)-1
Call AddCommaStr(strIn, CStr(Ar(i)))
Next
End If
IntArrayAsCommaStr = strIn
End Function
function GenerateRandomString(byVal maxLen)
Dim strNewStr
Dim whatsNext, upper, lower, intCounter
Randomize
For intCounter = 1 To maxLen
whatsNext = Int((1 - 0 + 1) * Rnd + 0)
If whatsNext = 0 Then
'character
upper = 90
lower = 65
Else
upper = 57
lower = 48
End If
strNewStr = strNewStr & Chr(Int((upper - lower + 1) * Rnd + lower))
Next
GenerateRandomString = strNewStr
end function
Sub AddCommaStr(ByRef strA, ByVal strT)
If IsNull(strA) Or strA = "" Then strA = strT Else strA = strA & ", " & strT
End Sub
Sub AddAndStr(ByRef strA, ByVal strT)
If IsNull(strA) Or strA = "" Then strA = strT Else strA = strA & " AND " & strT
End Sub
Function MaakZipFile(strFilelist,strZipFileName)
dim sFTP
dim sItemList
dim sUnique
Dim ZIPObject
Set ZIPObject = Server.CreateObject("dzactxctrl.dzactxctrl.1")
sUnique =1
ZIPObject.ZipFile = strZipFileName
sItemList = strFilelist
ZIPObject.ItemList = sItemList
ZIPObject.MessageCallbackFlag = 1
ZIPObject.AllQuiet = 1
ZIPObject.noDirectoryEntriesFlag = 1
ZIPObject.noDirectoryNamesFlag = 1
ZIPObject.WaitSeconds = 0
ZIPObject.ErrorCode = 0
On Error Resume Next
ZIPObject.ActionDZ = 4
Maakzip = ZIPObject.ErrorCode
ZIPObject.ActionDZ = 0
Set ZIPObject = Nothing
End Function
Function StrToStrWOcrlf (strString)
If IsNull(strString) Then
StrToStrWOcrlf = Null
Else
StrToStrWOcrlf = Replace(Replace(strString, vbCrLf, " "), vbCr, " ")
End If
End Function
Function FillString(ByVal str, ByVal char, ByVal length)
dim i
If Not IsNull(str) Then
If Len(str) > length Then
FillString = Left(str,length)
Else
FillString = str
For i = 1 To (length-Len(str))
FillString = FillString & char
Next
End If
Else
FillString = ""
For i = 1 To length
FillString = FillString & char
Next
End If
End Function
function GenerateRandomInteger(ByVal intMax)
Randomize
GenerateRandomInteger = Int(intMax * Rnd)
end function
%>