SitePoint Sponsor

User Tag List

Page 3 of 6 FirstFirst 123456 LastLast
Results 51 to 75 of 127
  1. #51
    SitePoint Enthusiast Vpekulas's Avatar
    Join Date
    Mar 2000
    Location
    Winnipeg, Canada
    Posts
    68
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Talking SERVER TIME TO SWATCH .BEAT TIME

    The "H" value is the time in hours differecne between BMT (Biel meridian) and your server zone. For example 8 is for chicago

    '// DISPLAY SWATCH .BEAT TIME
    FUNCTION SWATCH_BEATS(H)
    Dim BEATS, C_SEC, C_MIN, C_HRS, TIME_TO_C
    TIME_TO_C = Time + TimeSerial(H,34,32)
    C_SEC = Second(TIME_TO_C)
    C_MIN = Minute(TIME_TO_C)
    C_HRS = Hour(TIME_TO_C)
    BEATS = INT((C_SEC+(C_MIN*60)+((C_HRS*60)*60))/ 86.4)
    if BEATS < 10 Then BEATS = "00" & BEATS
    if BEATS < 100 and BEATS > 10 Then BEATS = "0" & BEATS
    SWATCH_BEATS = "@" & BEATS & " .beats"
    END FUNCTION
    Vladimir S. Pekulas
    http://www.Europeum.net
    http://wap.Europeum.net

  2. #52
    Froot r gewd SubKamran's Avatar
    Join Date
    May 2002
    Location
    North Star State
    Posts
    597
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    This functions(s) hyperlinks the following text:

    www.test.com
    http://www.test.com/
    ftp://www.test.com/
    https://www.test.com/
    lala@test.com

    Great for articles, where people submit links, and it will auto-link them for you...great stuff.

    Put in inc_functions.asp
    [vbs]
    <script language="javascript1.2" runat="server">

    // This JavaScript function gets and writes the HTML hyperlinks. This is
    // called by the ASP script in functions.asp

    function edit_hrefs(s_html, type){
    s_str = new String(s_html);
    if (type == 1) {
    s_str = s_str.replace(/\b(http\:\/\/[\w+\.]+[\w+\.\:\/\_\?\=\&\-\'\#\%\~\;\,\$\!\+\*]+)/gi,
    "<a href=\"$1\" target=\"_blank\">$1<\/a>");
    }
    if (type == 2) {

    s_str = s_str.replace(/\b(https\:\/\/[\w+\.]+[\w+\.\:\/\_\?\=\&\-\'\#\%\~\;\,\$\!\+\*]+)/gi,
    "<a href=\"$1\" target=\"_blank\">$1<\/a>");
    }
    if (type == 3) {
    s_str = s_str.replace(/\b(file\:\/\/\/\w\:\\[\w+\/\w+\.\:\/\_\?\=\&\-\'\#\%\~\;\,\$\!\+\*]+)/gi,
    "<a href=\"$1\" target=\"_blank\">$1<\/a>");
    }
    if (type == 4) {

    s_str = s_str.replace(/\b(www\.[\w+\.\:\/\_\?\=\&\-\'\#\%\~\;\,\$\!\+\*]+)/gi,
    "<a href=\"http://$1\" target=\"_blank\">$1</a>");
    }
    if (type == 5) {
    s_str = s_str.replace(/\b([\w+\-\'\#\%\.\_\,\$\!\+\*]+@[\w+\.?\-\'\#\%\~\_\.\;\,\$\!\+\*]*)/gi,
    "<a href=\"mailto\:$1\">$1</a>");
    }
    if (type == 6) {
    s_str = s_str.replace(/\b(ftp\:\/\/[\w+\.]+[\w+\.\:\/\_\?\=\&\-\'\#\%\~\;\,\$\!\+\*]+)/gi,
    "<a href=\"$1\" target=\"_blank\">$1<\/a>");
    }
    return s_str;
    }

    </script>
    <%
    ' This function will replace any URLs in the specified
    ' string, fString

    Function ReplaceUrls(fString)
    Dim oTag, c1Tag, c2Tag
    Dim roTag, rc1Tag, rc2Tag
    Dim oTagPos, c1TagPos, c2TagPos
    Dim nTagPos
    Dim counter2
    Dim strArray, strArray2, strArray3

    oTag = ""
    c1Tag2 = "
    "
    rc1Tag = """ target=""_blank"">"
    c2Tag = "[/url]"
    rc2Tag = "</a>"
    oTagPos = InStr(1, fString, oTag, 1)
    c1TagPos = InStr(1, fString, c1Tag, 1)

    strTempString = ""
    if (oTagpos > 0) and (c1TagPos > 0) then
    strArray = Split(fString, oTag, -1,1)
    for counter2 = 0 to UBound(strArray)
    if (InStr(1, strArray(counter2), c2Tag, 1) > 0) or (InStr(1, strArray(counter2), c1Tag, 1) > 0) then
    strArray2 = Split(strArray(counter2), c1Tag, -1,1)
    if Instr(1, strArray2(1), c2Tag,1) and not( (Instr(1, UCase(strArray2(1)), "",1) >0) and not(Instr(1, UCase(strArray2(1)), "",1) >0) ) then
    strFirstPart = Left(strArray2(1), Instr(1, strArray2(1),c2Tag,1)-1)
    strSecondPart = Right(strArray2(1), (Len(strArray2(1)) - Instr(1, strArray2(1), c2Tag,1) - len(c2Tag)+1))
    if strFirstPart <> "" then
    if (Instr(strArray2(0),"@") > 0) and UCase(Left(strArray2(0), 7)) <> "MAILTO:" then
    strTempString = strTempString & roTag & "mailto:" & strArray2(0) & rc1Tag & strFirstPart & rc2Tag & strSecondPart
    else
    strTempString = strTempString & roTag & strArray2(0) & rc1Tag & strFirstPart & rc2Tag & strSecondPart
    end if
    else
    if (Instr(strArray2(0),"@") > 0) and UCase(Left(strArray2(0), 7)) <> "MAILTO:" then
    strTempString = strTempString & roTag & "mailto:" & strArray2(0) & rc1Tag & strArray2(0) & rc2Tag & strSecondPart
    else
    strTempString = strTempString & roTag & strArray2(0) & rc1Tag & strArray2(0) & rc2Tag & strSecondPart
    end if
    end if
    else
    strTempString = strTempString & roTag & strArray2(0) & rc1Tag & strArray2(0) & rc2Tag & strArray2(1)
    end if
    elseif (InStr(1, strArray(counter2), c1Tag, 1) > 0) then
    strArray2 = Split(strArray(counter2), c1Tag, -1)
    strTempString = strTempString & roTag & strArray2(0) & rc1Tag & strArray2(0) & rc2Tag & strArray2(1)
    else
    strTempString = strTempString & strArray(counter2)
    end if
    next
    else
    strTempString = fString
    end if

    oTagPos2 = InStr(1, strTempString, oTag2, 1)
    c1TagPos2 = InStr(1, strTempString, c1Tag2, 1)

    if (oTagpos2 > 0) and (c1TagPos2 > 0) then
    strTempString2 = ""
    strArray = Split(strTempString, oTag2, -1,1)
    for counter3 = 0 to Ubound(strArray)
    if (Instr(1, strArray(counter3), c1Tag2,1) > 0) then
    strArray2 = split(strArray(counter3), c1Tag2, -1,1)
    if (Instr(strArray2(0),"@") > 0) and UCase(Left(strArray2(0), 7)) <> "MAILTO:" then
    strTempString2 = strTempString2 & roTag & "mailto:" & strArray2(0) & rc1Tag & strArray2(0) & rc2Tag & strArray2(1)
    else
    strTempString2 = strTempString2 & roTag & strArray2(0) & rc1Tag & strArray2(0) & rc2Tag & strArray2(1)
    end if
    else
    strTempString2 = strTempString2 & strArray(counter3)
    end if
    next
    strTempString = strTempString2
    end if

    ReplaceUrls = strTempString
    end function

    ' Check URLs, make sure they are valid, or what type they are. Such as:
    ' Emails
    ' Web Addresses
    ' FTPs

    function chkUrls(fString, fTestTag, fType)

    Dim strArray
    Dim Counter
    Dim strTempString

    strTempString = fString
    if Instr(1, fString, fTestTag) > 0 then
    strArray = Split(fString, fTestTag, -1)
    strTempString = strArray(0)
    for counter = 1 to UBound(strArray)
    if ((strArray(counter-1) = "" or len(strArray(counter-1)) < 5) and strArray(counter)<> "") then
    strTempString = strTempString & edit_hrefs("" & fTestTag & strArray(counter), fType)
    elseif ((UCase(right(strArray(counter-1),6)) <> "HREF=""") and (UCase(right(strArray(counter-1),5)) <> "[URL]") and (UCase(right(strArray(counter-1),6)) <> "[URL=""") and (UCase(right(strArray(counter-1),7)) <> "FILE:///") and (UCase(right(strArray(counter-1),7)) <> "HTTP://") and (UCase(right(strArray(counter-1),8)) <> "HTTPS://") and (UCase(right(strArray(counter-1),5)) <> "SRC=""") and (UCase(right(strArray(counter-1),5)) <> "SRC=""") and strArray(counter)<> "") then
    strTempString = strTempString & edit_hrefs("" & fTestTag & strArray(counter), fType)
    else
    strTempString = strTempString & fTestTag & strArray(counter)
    end if
    next
    end if

    chkUrls = strTempString

    end function

    ' Check mail types, see if it's a valid email, then hyperlink it...

    function chkMail(fString, fTestTag, fType)

    Dim strArray
    Dim Counter
    Dim strTempString

    strTempString = fString

    if Instr(1, fString, fTestTag) > 0 then
    strArray = Split(fString, fTestTag, -1)
    strTempString = ""
    ' strTempString = strArray(0)
    for counter = 0 to UBound(strArray)
    if (Instr(strArray(counter), "@") > 0) and not(Instr(strArray(counter), "mailto:") > 0) and not(Instr(UCase(strArray(counter)), "[URL") > 0) then
    strTempString = strTempString & edit_hrefs("" & fTestTag & strArray(counter), fType)
    else
    strTempString = strTempString & fTestTag & strArray(counter)
    end if
    next
    end if

    chkMail = strTempString

    end function
    [/vbs]

    Then, add in your 'Replace' function:

    [vbs]
    function Decode(fString)
    fString = ChkUrls(fString,"http://", 1)
    fString = ChkUrls(fString,"https://", 2)
    fString = ChkUrls(fString,"file:///", 3)
    fString = ChkUrls(fString,"www.", 4)
    fString = ChkUrls(fString,"mailto:",5)
    fString = ChkMail(fString," ",5)
    fString = ReplaceUrls(fString)
    Decode = fString

    end function
    %>
    [/vbs]

    Create file "test.asp"

    [vbs]
    <!-- #include file="includes/inc_functions.asp" -->
    <%
    Dim str
    str = "www.kaka.com and y@lala.com"

    %>
    <%=Decode(str)%>
    [/vbs]

    Created by:
    Snitz Forums
    http://forum.snitz.com/
    Last edited by SubKamran; Aug 18, 2002 at 10:20.
    "Sometimes little is more."
    Kamran A
    Web Dev/Designer
    Keyboard not found: Please Press F1 to Continue

  3. #53
    The doctor is in... silver trophy MarcusJT's Avatar
    Join Date
    Jan 2002
    Location
    London
    Posts
    3,509
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    Originally posted by Kings
    You can't decrypt it, it's one way encryption.
    Actually, no it's not, that's called hashing. (Sorry! )

    If something is encrypted then it can always be decrypted (although not necessarily with the same key).

    More precisely, encryption is the process of tranforming plaintext into a form (known as the ciphertext) that (theoretically) cannot be read by anyone other than the intended recipient, who can then decrypt the ciphertext to retrieve the original plaintext again.
    Last edited by M@rco; Nov 19, 2002 at 12:48.
    MarcusJT
    - former ASP web developer / former SPF "ASP Guru"
    - *very* old blog with some useful ASP code

    - Please think, Google, and search these forums before posting!

  4. #54
    SitePoint Member
    Join Date
    Nov 2002
    Location
    N. Providence, RI
    Posts
    5
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    ASP Functions I find useful...

    Here are some functions I use in my ASP code. I'm new to this forum so I don't know how to surround the code in a box like you guys have done, so here's the code unadorned

    Function Zero_Fill ( string, length )
    Zero_Fill = Trim ( string )
    do while len( Zero_Fill ) < length
    Zero_Fill = "0" & Zero_Fill
    loop
    end function

    Calling it: newString = Zero_Fill ( "23", 5 )
    Would take a string like "23" and make it "00023"



    Taking advantage of the usefullness of VBasic with javaScript:

    Formatting a number into either currency or formatted numeric:

    <script language = "VBasic">
    Function currencyFormat ( Value )
    Dim localString
    localString = FormatCurrency ( Value )

    currencyFormat = localString
    end Function

    Function numberFormat ( Value, DecPts )
    Dim localString
    localString = FormatNumber ( Value,DecPts,0,0,0 )

    numberFormat = localString
    end Function
    </script>

    <script language = "JavaScript">
    function displayDollars ( form )
    {
    var newValue = form.dataelement.value;
    newValue = currencyFormat ( newValue );
    form.dataelement.value = newValue;
    }

    function displayNumber ( form )
    {
    var newValue = form.dataelement.value;
    newValue = numberFormat ( newValue, 2 );
    form.dataelement.value = newValue;
    }
    </script>

    In the form:

    <form name="form1" ...>
    <input type = "salary" size=10 onBlur = "displayDollars ( this.form )">
    <input type = "gpa" size=10 onBlur = "displayNumber ( this.form )">


    These place blanks either at the beginning (pad_left) or the end (pad_right)

    Function Pad_Right ( string, length )
    Dim Local_String
    if TypeName ( string ) <> "String" then
    if IsNull ( string ) then
    Local_String = " "
    else
    Local_String = Cstr( string )
    end if
    else
    Local_String = string
    end if

    Local_String = Trim ( Local_String )

    do while len( Local_String ) < length
    Local_String = Local_String & " "
    loop

    Pad_Right = Local_String
    end function

    Function Pad_Left ( string, length )
    Dim Local_String
    if TypeName ( string ) <> "String" then
    if IsNull ( string ) then
    Local_String = " "
    else
    Local_String = Cstr( string )
    end if
    else
    Local_String = string
    end if

    Local_String = Trim ( Local_String )

    do while len( Local_String ) < length
    Local_String = " " & Local_String
    loop

    Pad_Left = Local_String
    end function

  5. #55
    The doctor is in... silver trophy MarcusJT's Avatar
    Join Date
    Jan 2002
    Location
    London
    Posts
    3,509
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    Here's a handy XML creation function that I posted elsewhere on SPF a while ago:
    Code:
    <%
    Function CreateXMLObj(XMLType)
    	dim tmpObj,n
    	dim ObjArray
    	
    	select case UCase(XMLType)
    		case "DOM"
    			ObjArray = Array("Microsoft.XMLDOM","MSXML2.DOMDocument.3.0","MSXML2.DOMDocument.4.0")
    		case "HTTP"
    			ObjArray = Array("Microsoft.XMLHTTP","MSXML2.XMLHTTP.3.0","MSXML2.XMLHTTP.4.0","MSXML2.ServerXMLHTTP.3.0","MSXML2.ServerXMLHTTP.4.0")
    		case else
    			'debugging code removed
    			Set CreateXMLObj = nothing
    			exit function
    	end select
    		
    	On Error Resume Next
    	
    	'test in reverse order to get "best" version
    	for n = UBound(ObjArray) to 0 step -1
    		set tmpObj = CreateObject(ObjArray(n))
    		
    		If Err Then
    			'debugging code removed
    			set tmpObj = nothing
    			Err.Clear
    		Else
    			'debugging code removed
    			exit for
    		End If
    	next
    	
    	If not IsObject(tmpObj) then
    		'debugging code removed
    		CreateXMLObj = nothing
    		exit function
    	End If
    	
    	set CreateXMLobj = tmpObj
    end function
    %>
    It's pretty self-explanatory, I would have thought, but ask if it's not...!
    MarcusJT
    - former ASP web developer / former SPF "ASP Guru"
    - *very* old blog with some useful ASP code

    - Please think, Google, and search these forums before posting!

  6. #56
    SitePoint Member
    Join Date
    Jul 2003
    Location
    Sydney
    Posts
    1
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Thumbs up Variable declaration

    I was tied of declaring all incoming variables from query and form posting so created this

    HTML Code:
    Function grabVariables(typeData)
    '-------------------------------------------------------------
    'Grab all variables from each type of Request and assign
    'variables to them
    'Type = "querystring", "form"
    'If type = 1 (true) then select all
    'You can then use the varialbe name to call on i.e Request.QueryString("blah") 
    'can now be printed by a simple Respone.Write(blah)
    '-------------------------------------------------------------
    
    	Dim VariableString, item
    	typeData = lcase(typeData)
    	
    	If typeData = "querystring" or typeData = "1" Then
    		For Each item in Request.QueryString 'loops through all the fields in the querystring
    			VariableString =  item & " = Request.QueryString(""" & item & """)"
    			execute(VariableString)
    		Next
    	End If
    	
    	If typeData = "form" or typeData = "1" Then
    		For Each item in Request.Form
    			VariableString =  item & " = Request.Form(""" & item & """)"
    			execute(VariableString)
    		Next
    	End If
    
    End Function
    
    call grabVariables(1)
    

    I include this function in a includes file that I insert on every page. You don't ever have to sit there going

    Dim blah, blah2, ...
    blah = Request.QueryString("blah")
    blah2 = ...

    hope it saves some ppl some time..

  7. #57
    SitePoint Zealot fmavituna's Avatar
    Join Date
    Apr 2003
    Location
    istanbul
    Posts
    139
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    Some Functions from my personal ASP library;

    File Exist v1.2
    Code:
    '***P13 ? File Exist v1.2 by Ferruh Mavituna
    '//NFO//
    '	Check server for a file
    '//ARGUMENTS//
    '	filename: Price  (numeric)
    '//RETURN//
    ' True / False
    '//SAMPLE// 
    '	If P13_FileExist("imgs/xx.jpg") Then Response.write "<img src=""imgs/xx.jpg"">"
    Function P13_FileExist(byval filename)
    	If filename <> "" Then
    		Dim p13fso
    		Set p13fso = Server.CreateObject("Scripting.FileSystemObject")
    		If p13fso.FileExists(Server.Mappath(filename)) Then p13_FileExist = True Else P13_FileExist = False
    	Else
    		P13_FileExist = False
    	End If
    End Function

    Random Text v1.2
    Random Text Generator (usefull for generating random passwords)
    Code:
    '***P13 Random Text v1.2 by Ferruh Mavituna
    '//NFO//
    '	Generate random texts by select lenght and pattern
    '//ARGUMENTS//
    '	lenght : Lenght of string will be generate
    '	rp_chars : Adds Special pattern for generate
    '	lcases : Include Lowercase Characters (1=active/0=deactive)
    '	ucases : Include Uppercase Characters (1=active/0=deactive)
    '	exchars : Include Extra Characters (1=active/0=deactive)
    '	numbers : Include Numbers(1=active/0=deactive)
    '//SAMPLES// 
    '	Response.Write P13_RandomPass(7,"p13studio",0,0,0,0)
    '		This will generate some random texts just from p,1,3,s,t,d,i,o and this texts lenght is 7
    '	Response.Write P13_RandomPass(10,"*+-",1,1,0,0)
    '		This will generate some random texts just from lowercases, uppercases, and *,+,-  also this texts lenght is 10
    
    Function P13_RandomPass(lenght,rp_chars,lcases,ucases,exchars,numbers)
    Dim rp_lchars, rp_uchars, rp_,rp_ranval, rp_RndInt, rp_exchars, rp_numbers
    If lenght = 0 Then lenght = 7
    
    	rp_lchars = "abcdefghijklmnopqrstuvwxyz"
    	rp_uchars = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    	rp_exchars = "`~!@#$%^&*()-_=+[{]}\\|;:"""'\,<.>/? "
    	rp_numbers = "0123456789"
    
    	If lcases = 1 Then rp_chars = rp_chars & rp_lchars
    	If ucases = 1 Then rp_chars = rp_chars & rp_uchars
    	If exchars = 1 Then rp_chars = rp_chars & rp_exchars
    	If numbers = 1 Then rp_chars = rp_chars & rp_numbers
    	
    	If rp_chars = "" Then rp_chars = "p13studio"
    
    	For i = 1 to lenght
    		Randomize Timer
    		rp_RndInt = Int(Rnd*Len(rp_chars)+1)
    		rp_ranval = rp_ranval & Mid(rp_chars,rp_RndInt,1)
    	Next
    
    	P13_RandomPass = rp_ranval
    End Function
    Special Variable Writer
    I'm using this function for database based multilingual projects.

    Code:
    '***P13 Special Variable Writer by Ferruh Mavituna
    '//NFO//
    '	Replace a special $author with an ASP Variable
    '//ARGUMENTS//
    '	valx = All text
    '	variablex = ASP Variable (For two or more variables split them by (-) negotation sign)
    '	repvariable = $Variable (For two or more $variables split them by (-) negotation sign)
    '//PLEASE NOTE//
    '	If you use multiple variable change use variables same order
    '	DO		:	val1-val2,$val1-$val2
    '	DON'T	:	val1-val2,$val2-$val1
    '//SAMPLES//
    '	P13_Variable(l.Fields.Item("ranktitle").Value,deger,"$rank")'
    '	P13_Variable(l.Fields.Item("ranktitle").Value,deger-deger2,"$rank-$rank2")'
    
    Function P13_Variable(valx,variablex, repvariable)
    Dim vararr, repvararr, vari
    	If valx <> "" Then 
    		P13_Variable = valx
    		vararr = Split(variablex,"-",-1,1)
    		repvararr = Split(repvariable,"-",-1,1)
    		For vari = 0 to Ubound(vararr)
    			P13_Variable = Replace(P13_Variable,Trim(repvararr(vari)),Trim(vararr(vari)),1,-1,1)
    		Next
    	End If
    End Function

    Lettergraph v1.1
    This is a standart text to image function.

    Code:
    '***Lettergraph  v1.1 by Ferruh Mavituna
    '//NFO//
    '	Write Letters as images
    '//ARGUMENTS//
    '	valx : Text  (alphanumeric)
    '//SAMPLE// 
    '	Response.Write  P13_Lettergraph("soul")
    ' >>> Need alphabet folder <<<
    '******************************
    'Function P13_Lettergraph(valx,folder)
    '	If folder = "" Then folder ="alphabet"
    '******************************
    Function P13_Lettergraph(valx)
    	Dim ix, ix2, valxarr, curletter, lmod
    	If valx <> "" Then
    		valxarr = Split(Trim(valx)," ")
    		For ix2 = 0 to Ubound(valxarr)
    			For ix = 1 to Len(valxarr(ix2))
    				
    				curletter = Left(valxarr(ix2),1)
    					'// Turkish Character Map
    						If Ucase(curletter) = "Ş" Then curletter = "s2"
    						If Ucase(curletter) = "Ğ" Then curletter = "g2"
    						If Ucase(curletter) = "i" Then curletter = "i2"
    						If Ucase(curletter) = "" Then curletter = "u2"
    						If Ucase(curletter) = "" Then curletter = "o2"
    
    				If ix2 mod 2 Then lmod = "2" Else lmod = ""
    
    				P13_Lettergraph = P13_Lettergraph & "<img src=""13mg/lt" & lmod &"/" & curletter &".gif"" alt=""" & curletter & """ />"
    				valxarr(ix2) = Right(valxarr(ix2),Len(valxarr(ix2))-1)
    			Next
    			
    			If ix2 < Ubound(valxarr) Then P13_Lettergraph = P13_Lettergraph & "<img src=""13mg/lt/dot.gif"" alt=""dot"" />"
    
    		Next
    	End If
    End Function

    Timer
    This is one of my favorite small function, It's very usefull for show proccess times.

    Put a timer top of your page like
    Code:
    Dim Xtimer
    Xtimer = Timer
    Call this func at the end of your page
    Code:
    Response.Write P13_Timer(timer-timex)
    Function;
    Code:
    '***P13 Timer v1.3 by Ferruh Mavituna
    '//NFO//
    '	Make clock tiemr format
    '//ARGUMENTS//
    '	timex : Time as Second
    '//RETURN// 
    'Some String Like 00:15
    '//SAMPLE// 
    '	Response.Write P13_Timer(timer)
    Function P13_Timer(timex)
    Dim mn, sc, mntxt, sctxt
    	If isnumeric(timex) Then
    		'// Format Minute
    		mn = Round(timex/60,0)
    		if mn < 0 Then mn = 0
    		if mn < 10 Then mntxt = "0"
    		mntxt = mntxt & mn
    
    		'// Format Second
    		sc = Round(timex Mod 60,0)
    		if sc < 0 Then sc = 0
    		if sc < 10 Then sctxt = "0"
    		sctxt = sctxt & sc
    		
    		'// Final
    		P13_Timer = mntxt & ":" & sctxt
    	Else
    		P13_Timer = "Error value is not numeric !"
    	End If
    End function

  8. #58
    SitePoint Guru asterix's Avatar
    Join Date
    Jun 2003
    Posts
    847
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    Quote Originally Posted by eZe
    I was tied of declaring all incoming variables from query and form posting so created this
    Hey, I like the idea!
    But it isN't it a bit dangerous? In many ASP Scripts you can finde variables named counter,n, rs nad so on. If I modify the URL and add &n=-10 then your code will redimension any "n" variables, which may cause an error...

  9. #59
    SitePoint Guru asterix's Avatar
    Join Date
    Jun 2003
    Posts
    847
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    Quote Originally Posted by mulletboy2
    I'm working on a rewrite of the script as we speak...
    I'll get back to you in a couple of days, but most likely I'll upload a zip to my website for people to download. [img]images/smilies/smile.gif[/img]
    Hey, is it finished? Sounds cool...

  10. #60
    The doctor is in... silver trophy MarcusJT's Avatar
    Join Date
    Jan 2002
    Location
    London
    Posts
    3,509
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    Quote Originally Posted by asterix
    Hey, I like the idea!
    But it isN't it a bit dangerous? In many ASP Scripts you can finde variables named counter,n, rs nad so on. If I modify the URL and add &n=-10 then your code will redimension any "n" variables, which may cause an error...
    I seem to recall that PHP used to have a "feature" which did this by default, but is now usually left switched off because it turned out to have serious security vulnerabilities.
    MarcusJT
    - former ASP web developer / former SPF "ASP Guru"
    - *very* old blog with some useful ASP code

    - Please think, Google, and search these forums before posting!

  11. #61
    The doctor is in... silver trophy MarcusJT's Avatar
    Join Date
    Jan 2002
    Location
    London
    Posts
    3,509
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    It occurred to me that I haven't posted any code for quite a while, so here are some querystring/url manipulation functions that I wrote the other day, and some test code to demonstrate the functionality. I documented it quite heavily so that others might benefit...

    Code:
    <%
    'Add a name/value pair to a URL
    Function QueryStringAdd(ByVal URL, ByVal Name, ByVal Value)
    	'Start with the existing URL
    	QueryStringAdd = URL
    	
    	'Determine whether or not there's a querystring
    	If (InStr(URL, "?") > 0) Then
    		'Yes, so append the name/value pair using an ampersand
    		QueryStringAdd = QueryStringAdd & "&"
    	Else
    		'No, so start one off with a question mark
    		QueryStringAdd = QueryStringAdd & "?"
    	End If
    	
    	'And add the URLEncoded name/value pair
    	QueryStringAdd = QueryStringAdd & Server.URLEncode(Name) & "=" & Server.URLEncode(Value)
    End Function
    
    
    'Remove a name/value pair from a URL
    'Usage:	AllInstances = False	-->		Removes the rightmost instance from the URL
    '		AllInstances = True		-->		Removes all instances from the URL
    Function QueryStringRemove(ByVal URL, ByVal Name, ByVal AllInstances)
    	Dim PositionQueryString, PageLocation, QueryString, Substring, PositionCurrent, PositionEnd, PositionAmpersand
    	PositionQueryString = Instr(URL, "?")
    	
    	'Only process the specified URL if it actually contains a querystring!
    	If (PositionQueryString > 0) Then
    		'Split the URL into the page location and querystring
    		PageLocation = Left(URL, PositionQueryString - 1)
    		QueryString = Mid(URL, PositionQueryString)
    		
    		'Build the substring we will be searching for
    		Substring = Server.URLEncode(Name) & "="
    
    		'Find the last (rightmost) instance of the
    		'specified variable in the querystring
    		PositionCurrent = InStrRev(QueryString, Substring) - Len(SubString)
    		
    		If (AllInstances) Then
    			'Only stop one we've reached the start of the querystring
    			PositionEnd = 0
    		Else
    			'Stop once we've removed the last instance
    			PositionEnd = PositionCurrent
    		End If
    		
    		'Loop until we've reached our set end position
    		While ((PositionCurrent > 0) And (PositionCurrent >= PositionEnd))
    			'The substring is present in the URL
    			
    			PositionCurrent = InStrRev(QueryString, Substring)
    			If (PositionCurrent > 0) Then
    				'If a match was found, remove it!
    	
    				'Find the start of the next querystring variable
    				'by finding the ampersand that would preceed it
    				PositionAmpersand = InStr(PositionCurrent, QueryString, "&")
    	
    				If (PositionAmpersand = 0) Then
    					'If there isn't another ampersand in the URL then it
    					'must be the last variable in the querystring so
    					'only grab the characters from the start of the string
    					'up until the character before the current position
    					'(so that any preceeding & or ? is chopped)
    					QueryString = Left(QueryString, PositionCurrent - 2)
    					PositionCurrent = Len(QueryString)
    				Else
    					'Otherwise grab characters from start of the string
    					'until the current position, and from after the
    					'position of the ampersand onwards
    					QueryString = Left(QueryString, PositionCurrent - 1) & Mid(QueryString, PositionAmpersand + 1)
    					PositionCurrent = PositionAmpersand
    				End If
    			End If
    		Wend
    
    		If QueryString = "?" Then
    			QueryString = ""
    		End If
    		
    		'Return the processed URL
    		QueryStringRemove = PageLocation & QueryString
    	Else
    		QueryStringRemove = URL
    	End If
    End Function
    
    
    'TEST CODE
    '---------
    URL = "http://www.testserver.com/testscript.asp"
    
    'Test adding a variable and removing it
    URL = QueryStringAdd(URL,"test","1")
    Response.Write URL & "<br />"
    URL = QueryStringRemove(URL,"test",False)
    Response.Write URL & "<br />"
    
    'Now add a couple of the same name with a different one in the
    'middle and remove them individually but in a different order
    URL = QueryStringAdd(URL,"test","2")
    URL = QueryStringAdd(URL,"dummy","dummyvalue")
    URL = QueryStringAdd(URL,"test","3")
    Response.Write URL & "<br />"
    URL = QueryStringRemove(URL,"test",False)
    Response.Write URL & "<br />"
    URL = QueryStringRemove(URL,"test",False)
    Response.Write URL & "<br />"
    URL = QueryStringRemove(URL,"dummy",False)
    Response.Write URL & "<br />"
    
    'Now do something similar but remove all
    'instances of "test" in a single call
    URL = QueryStringAdd(URL,"test","2")
    URL = QueryStringAdd(URL,"test","2")
    URL = QueryStringAdd(URL,"dummy","dummyvalue")
    URL = QueryStringAdd(URL,"test","2")
    URL = QueryStringAdd(URL,"test","2")
    Response.Write URL & "<br />"
    URL = QueryStringRemove(URL,"test",True)
    Response.Write URL & "<br />"
    %>
    Last edited by M@rco; Sep 15, 2003 at 06:20.
    MarcusJT
    - former ASP web developer / former SPF "ASP Guru"
    - *very* old blog with some useful ASP code

    - Please think, Google, and search these forums before posting!

  12. #62
    SitePoint Enthusiast
    Join Date
    Sep 2003
    Location
    Daytona Beach
    Posts
    27
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    Quote Originally Posted by aspapp
    that only works for mc and visa.. I know amex is a little more complicated.

    Actually thats not true. It works for Amex,JCB and Discover also they are all mod 10 algorithms.


    Also to the thread starter your email validation on the regular expression will fail on some newer domains as they get longer like .museum or .info. The code needs to be changed on the end to except variable data lenghts after the last "." should be {2,}

  13. #63
    SitePoint Enthusiast
    Join Date
    Sep 2003
    Location
    Daytona Beach
    Posts
    27
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    Quote Originally Posted by addstravel
    I am using SQL7.0.

    I have seen another way to do this ny just retrieving the records for that page. But I cannot use Stored Procedures because I require to dynamically change the order field. I understand this is not possible because you cannot assign a local var to this.

    What do you suggest?

    Cheers
    Thats not exactly true. As you can create a stored procedure with parameters of the query.
    Declare @Query nVarChar(8000)

    SEt @Query = 'select * from tbl where field1 = ''' + convert(varchar,@str) + '''
    exec sp_executesql @Query

    There is an article on http://4GuysFromRolla.com that has more detail on a scrollable list you that and combined the this with it on the select query will actually correct your issue

  14. #64
    SitePoint Enthusiast Soky's Avatar
    Join Date
    Sep 2003
    Location
    Southern Kentucky (SoKy)
    Posts
    61
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    This is great! Is there one like ot for ASP.NET/C#?

  15. #65
    SitePoint Enthusiast
    Join Date
    Sep 2003
    Location
    Daytona Beach
    Posts
    27
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    Quote Originally Posted by Soky
    This is great! Is there one like ot for ASP.NET/C#?
    What is great? And what would you like for C#? a scrollable list ??

  16. #66
    SitePoint Enthusiast
    Join Date
    Sep 2003
    Location
    Daytona Beach
    Posts
    27
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    Quote Originally Posted by fmavituna
    Some Functions from my personal ASP library;

    File Exist v1.2
    Code:
    '
    Function P13_FileExist(byval filename)
    	If filename <> "" Then
    		Dim p13fso
    		Set p13fso = Server.CreateObject("Scripting.FileSystemObject")
    		If p13fso.FileExists(Server.Mappath(filename)) Then p13_FileExist = True Else P13_FileExist = False
    	Else
    		P13_FileExist = False
    	End If
    End Function
    The above code creates memory leaks no matter how much MS says that VB cleans up after itself. You explicitly create an object pointer and never set it to nothing.

    Quote Originally Posted by fmavituna
    Random Text v1.2
    Code:
    Function P13_RandomPass(lenght,rp_chars,lcases,ucases,exchars,numbers)
    Dim rp_lchars, rp_uchars, rp_,rp_ranval, rp_RndInt, rp_exchars, rp_numbers
    If lenght = 0 Then lenght = 7
    
    	rp_lchars = "abcdefghijklmnopqrstuvwxyz"
    	rp_uchars = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    	rp_exchars = "`~!@#$%^&*()-_=+[{]}\\|;:"""'\,<.>/? "
    	rp_numbers = "0123456789"
    
    	If lcases = 1 Then rp_chars = rp_chars & rp_lchars
    	If ucases = 1 Then rp_chars = rp_chars & rp_uchars
    	If exchars = 1 Then rp_chars = rp_chars & rp_exchars
    	If numbers = 1 Then rp_chars = rp_chars & rp_numbers
    	
    	If rp_chars = "" Then rp_chars = "p13studio"
    
    	For i = 1 to lenght
    		Randomize Timer
    		rp_RndInt = Int(Rnd*Len(rp_chars)+1)
    		rp_ranval = rp_ranval & Mid(rp_chars,rp_RndInt,1)
    	Next
    
    	P13_RandomPass = rp_ranval
    End Function
    This function could be dont a bit faster using integers as your start and end points. and using the asc() like

    Int((upperbound - lowerbound + 1) * Rnd + lowerbound)

    Where 65 is capital 'A' and 97 is 'Z' for upper case do not remember what it is off hand for the lower. but the point is you are not midding into a string

  17. #67
    SitePoint Wizard bbolte's Avatar
    Join Date
    Nov 2001
    Location
    The Central Plains
    Posts
    3,301
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    Quote Originally Posted by afterburn
    What is great? And what would you like for C#? a scrollable list ??
    i think he means a "funky functions list" for asp.net and c#...

  18. #68
    SitePoint Enthusiast Soky's Avatar
    Join Date
    Sep 2003
    Location
    Southern Kentucky (SoKy)
    Posts
    61
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    Quote Originally Posted by bbolte
    i think he means a "funky functions list" for asp.net and c#...
    Yes sir, that's what I meant. I'm new around here and just getting used to the forums. I think you have a great community here and plan to visit often.
    David Francis Web Application Developer
    Air Force trained web designer specializing in ASP/SQL
    online applications for business and organizations. Long term
    creation,hosting, marketing & website management partner.

  19. #69
    SitePoint Enthusiast
    Join Date
    Sep 2003
    Location
    Daytona Beach
    Posts
    27
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    Well, I should tell you most of everything that has been covered is already addressed in .net. And It would take another book for of examples to show them.

    Most of the URL modification that were shown can be changed using an arraylist....

  20. #70
    SitePoint Zealot fmavituna's Avatar
    Join Date
    Apr 2003
    Location
    istanbul
    Posts
    139
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    Quote Originally Posted by afterburn
    The above code creates memory leaks no matter how much MS says that VB cleans up after itself. You explicitly create an object pointer and never set it to nothing.
    Yep, you right, this is very old one.


    Quote Originally Posted by afterburn
    This function could be dont a bit faster using integers as your start and end points. and using the asc() like

    Int((upperbound - lowerbound + 1) * Rnd + lowerbound)

    Where 65 is capital 'A' and 97 is 'Z' for upper case do not remember what it is off hand for the lower. but the point is you are not midding into a string
    And this is very good idea.

  21. #71
    SitePoint Zealot fmavituna's Avatar
    Join Date
    Apr 2003
    Location
    istanbul
    Posts
    139
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    Obfuscate E-mail Addresses;

    Good for spam harvesters
    Code:
    '***********************************************************
    '// USAGE
    '***********************************************************
    '// [1] Add fm_str2Arr, fm_decode, fm_obfuscate function into your page or include.
    '// [2] Print fm_obfuscate
    	'// ARGUMENTS
    	'// @email : String 
    	'// @method : Number  (default=3)
    		'// 1 : Decimal
    		'// 2 : Hexadecimal
    		'// 3 : Random
    	'// @Optional Text : E-mail Text
    '// SAMPLE (see more in demonstrations -at the end of the code-)
    '// Response.Write fm_obfuscate("email@address.com",2,"Drop me a mail")
    '***********************************************************
    
    
    '******************************************************************
    '// Convert a String to Array by Ferruh Mavituna
    '******************************************************************
    Function fm_str2Arr(byVal Str, byRef Arr)
    	Dim i, StrLen
    	StrLen = Len(Str)-1
    	
    	Redim Arr(StrLen)
    
    	For i = 0 to StrLen
    		Arr(i)=Left(Str,1)
    		If Len(Str)>0 Then Str=Right(Str,Len(Str)-1)
    	Next
    End Function
    
    
    '******************************************************************
    '// Decode Characters by Ferruh Mavituna
    '******************************************************************
    Function fm_decode(byVal Char, byVal method)
    	'// Randomize
    	'***********************************
    	If method=3 Then 
    		Randomize Timer
    		method = CInt(Rnd*1)+1
    	End If
    
    	'// Select Method
    	'***********************************
    	Select Case method
    		Case 1 '// Decimal Notation
    		'***********************************
    		fm_decode = Asc(Char)
    
    		Case 2 '// Hexadecimal Notation
    		'***********************************
    		fm_decode = "x" & Hex(Asc(Char))
    	End Select
    End Function
    
    
    Function fm_obfuscate(byVal email,byVal method, byval OptText)
    	Dim tmpStr, mailArr(), i, finalStr, mailtoArr(), tmpMailtoStr
    
    	'// Fix method
    	If NOT isNumeric(method) Then method = 3
    	If method>3 Then method = 3
    
    	'// Encode "mailto:"
    	fm_str2Arr "mailto:",mailtoArr
    	For i = 0 To Ubound(mailtoArr)
    		tmpMailtoStr = tmpMailtoStr & "&#" & fm_decode(mailtoArr(i),method) & ";"
    	Next	
    
    	'// Convert String to Array
    	'***********************************
    	fm_str2Arr email,mailArr
    	
    	'// Generate Text
    	'***********************************
    	For i = 0 To Ubound(mailArr)
    		finalStr = finalStr & "&#" & fm_decode(mailArr(i),method) & ";"
    	Next
    
    	'// Fix OptionText
    	'***********************************
    	If OptText="" Then 
    		OptText = finalStr
    	End If
    		finalStr = tmpMailtoStr & finalStr
    
    	'// Return
    	'***********************************
    	fm_obfuscate = "<a href=""" & finalStr & """>" & OptText & "</a><br />"
    End Function
    Detailed info and code in other languages;
    http://www.zapyon.de/spam-me-not/

  22. #72
    Phil fillup07's Avatar
    Join Date
    May 2002
    Location
    Jacksonville, FL
    Posts
    1,168
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    Just found this online and found that it's very useful.
    Code:
    ' Randomizes an Array's content's order
    Function JumbleArray(ByVal aArray)
       Dim iUpper, iLower, iLoop, iSwapPos, varTmp
       iUpper = UBound(aArray)
       iLower = LBound(aArray)
       Randomize Timer
       For iLoop = iLower to iUpper
    	 iSwapPos = Int(Rnd * (iUpper + 1))
    	 varTmp = aArray(iLoop)
    	 aArray(iLoop) = aArray(iSwapPos)
    	 aArray(iSwapPos) = varTmp
       Next
       JumbleArray = aArray
    End Function
    

  23. #73
    The doctor is in... silver trophy MarcusJT's Avatar
    Join Date
    Jan 2002
    Location
    London
    Posts
    3,509
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    That only works for a 1D array though... see here for my 2D array randomizer:
    http://www.sitepointforums.com/showt...?postid=462341
    MarcusJT
    - former ASP web developer / former SPF "ASP Guru"
    - *very* old blog with some useful ASP code

    - Please think, Google, and search these forums before posting!

  24. #74
    ☆★☆★ silver trophy vgarcia's Avatar
    Join Date
    Jan 2002
    Location
    in transition
    Posts
    21,236
    Mentioned
    1 Post(s)
    Tagged
    1 Thread(s)
    Quote Originally Posted by M@rco
    I seem to recall that PHP used to have a "feature" which did this by default, but is now usually left switched off because it turned out to have serious security vulnerabilities.
    Yep, register_globals. It was on by default until PHP 4.0.6. Most hosts still keep it set to on for compatibility with older scripts/software packages .

  25. #75
    SitePoint Wizard silver trophybronze trophy asp_funda's Avatar
    Join Date
    Jun 2003
    Location
    ether
    Posts
    4,479
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)
    Here is a cool function that I found on www.stardeveloper.com written by Rob Collyer.


    The function below will get values from forms &/or cookies &/or querystrings & will set variables with identical names & equal values. Can save a lot of trouble & coding when you are retrieving a good number for form fields or cookies or a nastily long querystring.

    Code:
     
    <%
    Function SetVars(StrType)
    If lcase(StrType) = "form" or lcase(strType) = "all" then
    For Each Field in Request.Form
    TheString = Field & "=Request.Form(""" _
    & Field & """)"
    EXECUTE(TheString)
    Next
    End If
    If lcase(StrType) = "querystring" or lcase(strType) = "all" then
    For Each Field in Request.Querystring
    TheString= Field & "=Request.Querystring(""" _
    & Field & """)"
    EXECUTE(TheString)
    Next
    End If
    If lcase(StrType) = "cookies" or lcase(strType) = "all" then
    For Each Field in Request.Cookies
    TheString= Field & "=Request.Cookies(""" _
    & Field & """)"
    EXECUTE(TheString)
    Next
    End If
    END Function
    %>
    Usage:-
    Call SetVars(StrType) Where 'StrType' will be "form" for retrieving values from a form, "querystring" for querystring, "cookies" for cookies or "all" for all of them, without the quotes though.

    I believe that something similar has been posted before too but here it is again.



    This function below written by myself will convert any IP Address(in the form A.B.C.D like 255.255.255.100) into an IPNumber(like 33996344). Useful if you are using the country database available at http://ip-to-country.directi.com or now http://ip-to-country.webhosting.info/.
    This function was written quite hastily by me since I was pressed for time & didn't find anything similar since the website offered only PHP function. So I had to write my own. Didn't get time to prune it but it works alright.

    Code:
     
    <%
     
    Private Function ipNumber(uIP)
    strO = Trim(uIP) 	'Store Original IP
    strO1 = strO 	 'Assign Original IP to temp var
    pos1 = InStr(strO1, ".")    ' position of 1st '.'
    'intA = CInt(Mid(strO1, 1, (pos1-1)))   '1st chunk
    strO2 = Mid(strO1, pos1+1, len(strO1))   '2nd String
    pos2 = InStr(strO2, ".")    ' position of 2nd '.'
    intB = CInt(Left(strO2, (pos2-1)))   '2nd chunk
    strO3 = Mid(strO2, pos2+1, len(strO2))   '3rd String
    pos3 = InStr(strO3, ".")    ' position of 3rd '.'
    intC = CInt(Left(strO3, (pos3-1)))   '3rd chunk
    intD = CInt(Mid(strO3, pos3+1, len(strO3)))  '4th chunk
    
    'Applying the formula --- A x (256*256*256) + B x (256*256) + C x 256 + D
    'for the IP A.B.C.D
    intConvert = (intA*(256*256*256)) + (intB*(256*256)) + (intC*256) + intD
    ipNumber = Trim(intConvert)
    End Function
    
    
    %>

    I am a little late to enter but I hope that someone finds these useful.
    Our lives teach us who we are.
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Me - Photo Blog - Personal Blog - Dev Blog
    iG:Syntax Hiliter -- Colourize your code in WordPress!!


Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •