SitePoint Sponsor

User Tag List

Page 4 of 6 FirstFirst 123456 LastLast
Results 76 to 100 of 127
  1. #76
    Just Blow It bronze trophy
    DaveMaxwell's Avatar
    Join Date
    Nov 1999
    Location
    Mechanicsburg, PA
    Posts
    7,286
    Mentioned
    121 Post(s)
    Tagged
    1 Thread(s)
    I've posted this a number of times, so I'm going to just add this here....

    This code will go through your system and determine which email component(s) is/are installed on your system for your use.

    Code:
    <% @ Language="VBScript" %>
    <% Option Explicit %>
    <%
    Dim theComponent(18)
    Dim theComponentName(18)
    '## the components
    theComponent(0) = "ABMailer.Mailman"
    theComponent(1) = "Persits.MailSender"
    theComponent(2) = "SMTPsvg.Mailer"
    theComponent(3) = "SMTPsvg.Mailer"
    theComponent(4) = "CDONTS.NewMail"
    theComponent(5) = "CDONTS.NewMail"
    theComponent(6) = "CDO.Message"
    theComponent(7) = "dkQmail.Qmail"
    theComponent(8) = "Dundas.Mailer"
    theComponent(9) = "Dundas.Mailer"
    theComponent(10) = "Geocel.Mailer"
    theComponent(11) = "iismail.iismail.1"
    theComponent(12) = "Jmail.smtpmail"
    theComponent(13) = "MDUserCom.MDUser"
    theComponent(14) = "ASPMail.ASPMailCtrl.1"
    theComponent(15) = "ocxQmail.ocxQmailCtrl.1"
    theComponent(16) = "SoftArtisans.SMTPMail"
    theComponent(17) = "SmtpMail.SmtpMail.1"
    theComponent(18) = "VSEmail.SMTPSendMail"
    '## the name of the components
    theComponentName(0) = "ABMailer v2.2+"
    theComponentName(1) = "ASPEMail"
    theComponentName(2) = "ASPMail"
    theComponentName(3) = "ASPQMail"
    theComponentName(4) = "CDONTS (IIS 3/4/5)"
    theComponentName(5) = "Chili!Mail (Chili!Soft ASP)"
    theComponentName(6) = "CDOSYS (IIS 5/5.1/6)"
    theComponentName(7) = "dkQMail"
    theComponentName(8) = "Dundas Mail (QuickSend)"
    theComponentName(9) = "Dundas Mail (SendMail)"
    theComponentName(10) = "GeoCel"
    theComponentName(11) = "IISMail"
    theComponentName(12) = "JMail"
    theComponentName(13) = "MDaemon"
    theComponentName(14) = "OCXMail"
    theComponentName(15) = "OCXQMail"
    theComponentName(16) = "SA-Smtp Mail"
    theComponentName(17) = "SMTP"
    theComponentName(18) = "VSEmail"
    Function IsObjInstalled(strClassString)
     on error resume next
     ' initialize default values
     IsObjInstalled = False
     Err = 0
     ' testing code
     Dim xTestObj
     Set xTestObj = Server.CreateObject(strClassString)
     If 0 = Err Then IsObjInstalled = True
     ' cleanup
     Set xTestObj = Nothing
     Err = 0
     on error goto 0
    End Function
    Response.Write "<html>" & vbNewLine & _
      vbNewLine & _
      "<head>" & vbNewLine & _
      "  <title>E-mail Component Test</title>" & vbNewLine & _
      "</head>" & vbNewLine & _
      vbNewLine & _
      "<body bgColor=""white"" text=""midnightblue"" link=""darkblue"" aLink=""red"" vLink=""red"">" & vbNewLine & _
      "<font face=""Verdana, Arial, Helvetica"">" & vbNewLine & _
      "<table border=""0"" cellspacing=""0"" cellpadding=""0"" align=""center"">" & vbNewLine & _
      "  <tr valign=""top"">" & vbNewLine & _
      "	<td bgcolor=""black"">" & vbNewLine & _
      "	  <table border=""0"" cellspacing=""1"" cellpadding=""4"">" & vbNewLine & _
      "		<tr valign=""top"">" & vbNewLine & _
      "		  <td bgcolor=""midnightblue"" colspan=""2"" align=""center""><font size=""2"" color=""mintcream""><b>E-mail Component Test</b></font></td>" & vbNewLine & _
      "		</tr>" & vbNewLine & _
      "		<tr valign=""top"">" & vbNewLine & _
      "		  <td bgcolor=""midnightblue"" colspan=""2"" align=""center""><font size=""2"" color=""mintcream"">The following components are currently<br />available choices in the latest<br />release of Snitz Forums 2000</font></td>" & vbNewLine & _
      "		</tr>" & vbNewLine
    Dim i
    for i=0 to UBound(theComponent)
     Response.Write "		<tr>" & vbNewLine & _
       "		  <td bgColor=""#9FAFDF"" align=""right""><font size=""2""><strong>" & theComponentName(i) & ":&nbsp;</strong></font></td>" & vbNewLine & _
       "		  <td bgColor=""#9FAFDF"" align=""center""><font size=""2"">"
     if Not IsObjInstalled(theComponent(i)) then
      Response.Write("not installed")
     else
      Response.Write("<strong>installed!</strong>")
     end if
     Response.Write "</font></td>" & vbNewLine & _
       "		</tr>" & vbNewline
    next
    Response.Write "	  </table>" & vbNewLine & _
      "	</td>" & vbNewLine & _
      "  </tr>" & vbNewLine & _
      "</table>" & vbNewLine & _
      "</font>" & vbNewLine & _
      "</body>" & vbNewLine & _
      vbNewLine & _
      "</html>" & vbNewLine
    %>
    Dave Maxwell - Manage Your Site Team Leader
    My favorite YouTube Video! | Star Wars, Dr Suess Style
    Learn how to be ready for The Forums' Move to Discourse

  2. #77
    ☆★☆★ silver trophy vgarcia's Avatar
    Join Date
    Jan 2002
    Location
    in transition
    Posts
    21,235
    Mentioned
    1 Post(s)
    Tagged
    1 Thread(s)
    Quote Originally Posted by DaveMaxwell
    I've posted this a number of times, so I'm going to just add this here....
    ...snip...
    Dave, wouldn't those two arrays work better as a Scripting.Dictionary object, or at least as 1 two-dimensional array?

  3. #78
    Just Blow It bronze trophy
    DaveMaxwell's Avatar
    Join Date
    Nov 1999
    Location
    Mechanicsburg, PA
    Posts
    7,286
    Mentioned
    121 Post(s)
    Tagged
    1 Thread(s)
    It probably would. Just never took the time to clean up the code. I'll see if I can find some time in the near future to go back and relook at the code for a cleaner process.
    Dave Maxwell - Manage Your Site Team Leader
    My favorite YouTube Video! | Star Wars, Dr Suess Style
    Learn how to be ready for The Forums' Move to Discourse

  4. #79
    SitePoint Wizard silver trophybronze trophy asp_funda's Avatar
    Join Date
    Jun 2003
    Location
    ether
    Posts
    4,497
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)
    Hey, that's some piece of code Dave! thanks.
    Our lives teach us who we are.
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Me - Photo Blog - Personal Blog - Dev Blog
    iG:Syntax Hiliter -- Colourize your code in WordPress!!

  5. #80
    Original Gangster silver trophy Thing's Avatar
    Join Date
    Oct 2000
    Location
    Philadelphia, PA
    Posts
    4,708
    Mentioned
    2 Post(s)
    Tagged
    0 Thread(s)
    Here is a function I just made that makes the FIRST letter of every sentence a capital. This works in these three cases:

    1. No spaces after period (ie: first sentence.second sentence)
    2. One space after period (ie: first sentence. second sentence)
    3. Two spaces after period (ie: first sentence. second sentence)

    It ONLY works for periods. I'll work on getting all punctuation on it, and post the updated function when I'm done. Here it is:

    Code:
     
    Function PropCase(news)
     arr = Split(news, ".")
     for i=0 to Ubound(arr)
      If left(arr(i), 1) = " " then
       If left(arr(i), 2) = "  " then
    	arr(i) = mid(arr(i), 3)
       Else
    	arr(i) = mid(arr(i), 2)
       End if
      End if
      arr(i) = ucase(left(arr(i), 1)) & mid(arr(i), 2)
     Next
     For p=0 to Ubound(arr)
      newstxt =  newstxt & arr(p) & ".  "
     Next
     propcase = newstxt
    End Function

  6. #81
    Also available in Large Si's Avatar
    Join Date
    Sep 2002
    Location
    Walsall, UK
    Posts
    1,911
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    Good job williamsba - I'll be using that in my CMS's now!
    Si
    Are you a Photoshop Jedi Master? Prove it!

    Is funky house your bag? You'll love this!

    Voice
    , eyes, ears, body and hands.


  7. #82
    SitePoint Wizard silver trophybronze trophy asp_funda's Avatar
    Join Date
    Jun 2003
    Location
    ether
    Posts
    4,497
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)
    I think that I'd post this function here in this thread too. It was asked for by williamsba at http://www.sitepoint.com/forums/showthread.php?t=148422 & TheTank replied to it with his function at http://www.sitepoint.com/forums/show...66&postcount=3.

    So what I am posting here is just a mod of the original function by TheTank which was editied by williamsba.

    Here it is.
    Code:
    Function LinkURLs(tempTxt, tgt)
    'Prefix underscore(_) to tgt
    tgt = "_" & tgt
    'If tgt is blank, set it to self.
    If Trim(tgt)="_" Then
    tgt = "_self"
    End If
     
    Dim regEx
    Set regEx = New RegExp
    regEx.Global = True
    regEx.IgnoreCase = True
    temptxt = replace(temptxt, "'", "''")
    'Hyperlink Email Addresses
    regEx.Pattern = "([_.a-z0-9-]+@[_.a-z0-9-]+\.[a-z]{2,3})"
    tempTxt = regEx.Replace(tempTxt, "<a href=""mailto:$1"">$1</a>")
    'Hyperlink URL's
    regEx.Pattern = "((www\.|(http|https|ftp|news|file)+\:\/\/)[_.a-z0-9-]+\.[a-z0-9\/_:@=.+?,##%&~-]*[^.|\'|\# |!|\(|?|,| |>|<|;|\)])"
    tempTxt = regEx.Replace(tempTxt, "<a href=""$1"" target=" & tgt & ">$1</a>")
    'Make <a href="www = <a href="http://www
    tempTxt = Replace(tempTxt, "href=""www", "href=""http://www")
    LinkURLs = tempTxt
    End Function
    Now for those who don't know about this, the explanation:-
    This function parses the links in a block of text & make them HTML links. Like if you have something like www.example.com/mypage.html in a block of text, this function will make it like <a href="http://www.example.com/mypage.html" target="_self">www.example.com/mypage.html</a> so that its an actual HTML link that works, something like the one here at SPF. Also works for email links, so something like me@example.com will be converted into <a href="mailto:me@example.com" target="_self">me@example.com</a>.

    But unlike the original function by TheTank, the one above addresses the issue of setting target attribute of the link. The tgt parameter is optional but if you want to set the target as _blank or _top, you can pass the parameter as blank or top(without underscores). If nothing is passed for tgt parameter, it sets the target as _self.

    This function can be useful in CMSes & News or Blog scripts.
    Our lives teach us who we are.
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Me - Photo Blog - Personal Blog - Dev Blog
    iG:Syntax Hiliter -- Colourize your code in WordPress!!

  8. #83
    SitePoint Wizard silver trophybronze trophy asp_funda's Avatar
    Join Date
    Jun 2003
    Location
    ether
    Posts
    4,497
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)
    Here's a mod to the link parsing function above.

    Code:
    Function LinkURLs(tempTxt, tgt, frm)
    'Prefix underscore(_) to tgt if frm=0 or null
    If (CInt(frm)=0) OR (CInt(frm)="") Then
    tgt = "_" & tgt
    End If
    'If tgt is blank, set it to self.
    If (Trim(tgt)="_") OR (Trim(tgt)="") Then
    tgt = "_self"
    End If
     
    Dim regEx
    Set regEx = New RegExp
    regEx.Global = True
    regEx.IgnoreCase = True
    temptxt = replace(temptxt, "'", "''")
    'Hyperlink Email Addresses
    regEx.Pattern = "([_.a-z0-9-]+@[_.a-z0-9-]+\.[a-z]{2,3})"
    tempTxt = regEx.Replace(tempTxt, "<a href=""mailto:$1"">$1</a>")
    'Hyperlink URL's
    regEx.Pattern = "((www\.|(http|https|ftp|news|file)+\:\/\/)[_.a-z0-9-]+\.[a-z0-9\/_:@=.+?,##%&~-]*[^.|\'|\# |!|\(|?|,| |>|<|;|\)])"
    tempTxt = regEx.Replace(tempTxt, "<a href=""$1"" target=" & tgt & ">$1</a>")
    'Make <a href="www = <a href="http://www
    tempTxt = Replace(tempTxt, "href=""www", "href=""http://www")
    LinkURLs = tempTxt
    End Function
    Ok NOW, so this function above now also supports targetting frames. Just
    another optional parameter added by name of frm. If this parameter is set to
    any number but 0, it will not add an underscore(_) to the parameter tgt
    which specifies the target name. So if its omitted, then also it will add
    underscore(_).
    So, if you wanna target a frame, just set frm to any number, better be 1 of
    ease of things.
    Our lives teach us who we are.
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Me - Photo Blog - Personal Blog - Dev Blog
    iG:Syntax Hiliter -- Colourize your code in WordPress!!

  9. #84
    Just Blow It bronze trophy
    DaveMaxwell's Avatar
    Join Date
    Nov 1999
    Location
    Mechanicsburg, PA
    Posts
    7,286
    Mentioned
    121 Post(s)
    Tagged
    1 Thread(s)
    There was a post in this thread asking how to post
    the first 50 characters, so I wrote this thread to allow
    you to do just this, but it will prevent it from stopping
    in the middle of a word.

    Code:
    Function GetFirstN(FieldIn, NumChars)
     Dim HoldLength
     ' Eliminate excessive spaces from end
     FieldIn = Trim(FieldIn)
     ' If Less than the maximum, just return the field
     If Len(FieldIn) <= NumChars then
      GetFirstN = FieldIn : Exit Function
     End If
     
     If mid(FieldIn, NumChars, 1) = " " then
      GetFirstN = Left(FieldIn, NumChars)
     Else 
    	HoldLength = instr(NumChars + 1, FieldIn, " ")
      If HoldLength = 0 then HoldLength = instrev(FieldIn, " ", NumChars) ' in case no spaces are after 
      If HoldLength = 0 then
    	  ' no spaces found at all (doubtful but could happen), so take first numchars characters
       GetFirstN = Left(FieldIn, ",", NumChars)
      else
    	  ' take length based on the appropriate space.
       GetFirstN = Left(FieldIn, HoldLength)
    	End if
     End If
    End Function
    Dave Maxwell - Manage Your Site Team Leader
    My favorite YouTube Video! | Star Wars, Dr Suess Style
    Learn how to be ready for The Forums' Move to Discourse

  10. #85
    Phil fillup07's Avatar
    Join Date
    May 2002
    Location
    Jacksonville, FL
    Posts
    1,168
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    Can we sticky this thread?

  11. #86
    Original Gangster silver trophy Thing's Avatar
    Join Date
    Oct 2000
    Location
    Philadelphia, PA
    Posts
    4,708
    Mentioned
    2 Post(s)
    Tagged
    0 Thread(s)
    Guess it got unstickied. This is a good thread.

  12. #87
    SitePoint Wizard bbolte's Avatar
    Join Date
    Nov 2001
    Location
    The Central Plains
    Posts
    3,304
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    yeah. i thought it was also...

  13. #88
    SitePoint Wizard silver trophybronze trophy asp_funda's Avatar
    Join Date
    Jun 2003
    Location
    ether
    Posts
    4,497
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)
    Here are some functions that I use for my usual work. They are also listed on
    my website at http://www.igeek.info/show_tutorial.php?id=1.

    Function to send eMail using CDONTS.
    Code:
    Private Function mail(pTo, pFr, pCc, pBc, pSu, pMes, pBf, pMf, pIm)
    pTo = TRIM(LCASE(pTo))
    pFr = TRIM(LCASE(pFr))
    pCc = TRIM(LCASE(pCc))
    pBc = TRIM(LCASE(pBc))
    pBf = TRIM(LCASE(pBf))
    pMf = TRIM(LCASE(pMf))
    pIm = TRIM(LCASE(pIm))
    IF (pBf="") OR (pBf="text") THEN
    pBf = "CdoBodyFormatText”
    ELSE
    pBf = "CdoBodyFormatHTML”
    END IF
    IF (pMf="") OR (pMf="text") THEN
    pMf = "CdoMailFormatText"
    ELSE
    pMf = "CdoMailFormatMIME"
    END IF
    IF (pIm="") OR (pIm="1") THEN
    pIm = 1
    ELSEIF pIm="0" THEN
    pIm = 0
    ELSE
    pIm = 2
    END IF
    Set objMail = CreateObject("CDONTS.NewMail")
    WITH objMail
    .From = pFr
    .To = pTo
    IF NOT(pCc="") THEN
    .CC = pCc
    END IF
    IF NOT(pBc="") THEN
    .BCC = pBc
    END IF
    .Subject = pSu
    .BodyFormat = pBf
    .MailFormat = pMf
    .Importance = pIm
    .Body = pMes
    .Send
    END WITH
    Set objMail = NOTHING
    End Function
    Usage:-
    Code:
    strTo = "buddy@example.com" '** Receiver's eMail
    strFrom = "me@example.com" '** Sender's eMail
    strSubject = "Hey there" '** Subject of the eMail
    strCC = "buddy2@example.com" '** send carbon copy
    strBody = "<b>Hi Buddy</b><br>How are you?" '** HTML formatted Body of eMail
    strBFrt = "html" '** Body format of eMail set to HTML
    strMFrt = "mime" '** Mail format of eMail set to MIME
    strImp = "2" '** Importance set to High
    mail(strTo, strFrom, strCC, '', strSubject, strBody, strBFrt, strMFrt, strImp)
    '*** This sends the eMail. Note the empty parameter after strCC. That's for pBc, the Blind Carbon Copy.
    '*** We don't want to use pBc, so we've left it empty. Similarly, you can leave out any parameters.
    '*** But remember that pTo, pFr, pSu & pMes are important & required.

    Some stupid but useful functions
    Code:
    ' ***** This function is used to print something *****
    Private Function print(pVal)
    Response.Write(pVal)
    End Function
    ' ***** This function is used to redirect to a URL *****
    Private Function reDir(pURL)
    Response.Redirect(pURL)
    End Function
    ' ***** This function is used to get value from ServerVariables collection *****
    Private Function sVar(pVal)
    sVar = Request.ServerVariables(pVal)
    End Function
    Usage:-
    Code:
    '***** print something with the print() function *****
    print("Hello There")
    strVar = "How are you doing?"
    print(strVar)
    '***** redirect using the reDir() function *****
    reDir("http://example.com")
    strURL = "mypage.asp"
    reDir(strURL)
    '***** get user's IP address using sVar() function *****
    strIP = sVar("REMOTE_ADDR")
    Our lives teach us who we are.
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Me - Photo Blog - Personal Blog - Dev Blog
    iG:Syntax Hiliter -- Colourize your code in WordPress!!

  14. #89
    SitePoint Wizard silver trophybronze trophy asp_funda's Avatar
    Join Date
    Jun 2003
    Location
    ether
    Posts
    4,497
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)
    A variant of the mail() function above, the following function uses CDOSYS to send eMails.
    Code:
    Private Function mailCdo(pTo, pFr, pCc, pBc, pSu, pMes, pBf)
     pTo = TRIM(LCASE(pTo))
     pFr = TRIM(pFr)
     pCc = TRIM(LCASE(pCc))
     pBc = TRIM(LCASE(pBc))
     pBf = TRIM(LCASE(pBf))
     SET objMail = Server.CreateObject("CDO.Message")
    ' // If your code doesn't run, then uncomment the following non // lines
    ' SET objConfig = CreateObject("CDO.Configuration")
    ' // Configuration:
    ' objConfig.Fields(cdoSendUsingMethod) = cdoSendUsingPort
    ' objConfig.Fields(cdoSMTPServer) = "localhost"
    ' objConfig.Fields(cdoSMTPServerPort) = 25
    ' objConfig.Fields(cdoSMTPAuthenticate) = cdoBasic
    ' // Update configuration
    ' objConfig.Fields.Update
    ' SET objMail.Configuration = objConfig
     WITH objMail
      .From = pFr
      .To = pTo
      IF NOT(pCc="") THEN
       .CC = pCc
      END IF
      IF NOT(pBc="") THEN
       .BCC = pBc
      END IF
      .Subject = pSu
      IF pBf="html" THEN
       .HTMLBody = pMes
      ELSE
       .TextBody = pMes
      END IF
      .Send
     END WITH
     SET objMail = NOTHING
    ' // If you uncommented non // lines above, uncomment the following line as well
    ' SET objConfig = NOTHING
    End Function
    parameters:
    pTo > The destination eMail address
    pFr > The originating eMail address
    pCc > Carbon Copy
    pBc > Blind Carbon Copy
    pSu > eMail Subject
    pMes > eMail Body
    pBf > eMail Body format. 'html' for HTML formatted eMail or 'text' for TEXT eMail

    usage:
    Code:
    strTo = "ss@example.com"
    strFrom = "mm@example.com"
    strSub = "hello there!"
    strMessage = "how are you?<br>this is just a test"
    strBf = "html"
    CALL mailCdo(strTo, strFrom, '', '', strSub, strMessage, strBf)
    Our lives teach us who we are.
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Me - Photo Blog - Personal Blog - Dev Blog
    iG:Syntax Hiliter -- Colourize your code in WordPress!!

  15. #90
    SitePoint Enthusiast StolenGiraffe's Avatar
    Join Date
    Jul 2004
    Location
    Sweden
    Posts
    25
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    Login-handling - Not to be used when webbapplication handles sensitive data!!
    Use with a dictionary or an array, you wont need to have 1000 rows of code denying different chars....

    Code:
    function isBogous( strString )
      isBogous = false
      
      if inStr(strString, "'") <> 0 then isBogous = true ' Denys the '
      if inStr(strString, "=") <> 0 then isBogous = true ' Denys the =
      if inStr(strString, "?") <> 0 then isBogous = true ' Denys the ?
    
      if (strString & "") = "" then isBogous = true
    
    end function
    USE:
    if isBogous then Response.Write("NO WAY JOSE")

    if not isBogous then Response.Write("GOOD LAD")

    Code:
    function toShortDate( dtString ) ' YYYY-MM-DD, could easily be changed to suit your dateformats.
      
      toShortDate = Right("0000" & cStr(Year(d)), 4) & "-" & Right("00" & cStr(Month(d)), 2) & "-" & Right("00" & cStr(Day(d)), 2)
    
    end function
    USE:
    toShortDate ( now()) equals (in sweden anyway) 2001-01-01 (example date)

    if you have a server formatting the now() differently than the date you need to instert into the db this one does the trick or if you just want to make sure the correct date is inserted.
    There is no point in inventing the wheel twice.
    But to modify it to the better, that is a different story.

  16. #91
    SitePoint Zealot
    Join Date
    Jul 1999
    Location
    Virginia, USA
    Posts
    103
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    Here's a nice function that hashes using SHA256:

    Code:
    <%
    ' See the VB6 project that accompanies this sample for full code comments on how
    ' it works.
    '
    ' ASP VBScript code for generating a SHA256 'digest' or 'signature' of a string. The
    ' MD5 algorithm is one of the industry standard methods for generating digital
    ' signatures. It is generically known as a digest, digital signature, one-way
    ' encryption, hash or checksum algorithm. A common use for SHA256 is for password
    ' encryption as it is one-way in nature, that does not mean that your passwords
    ' are not free from a dictionary attack. 
    '
    ' If you are using the routine for passwords, you can make it a little more secure
    ' by concatenating some known random characters to the password before you generate
    ' the signature and on subsequent tests, so even if a hacker knows you are using
    ' SHA-256 for your passwords, the random characters will make it harder to dictionary
    ' attack.
    '
    ' NOTE: Due to the way in which the string is processed the routine assumes a
    ' single byte character set. VB passes unicode (2-byte) character strings, the
    ' ConvertToWordArray function uses on the first byte for each character. This
    ' has been done this way for ease of use, to make the routine truely portable
    ' you could accept a byte array instead, it would then be up to the calling
    ' routine to make sure that the byte array is generated from their string in
    ' a manner consistent with the string type.
    '
    ' This is 'free' software with the following restrictions:
    '
    ' You may not redistribute this code as a 'sample' or 'demo'. However, you are free
    ' to use the source code in your own code, but you may not claim that you created
    ' the sample code. It is expressly forbidden to sell or profit from this source code
    ' other than by the knowledge gained or the enhanced value added by your own code.
    '
    ' Use of this software is also done so at your own risk. The code is supplied as
    ' is without warranty or guarantee of any kind.
    '
    ' Should you wish to commission some derivative work based on this code provided
    ' here, or any consultancy work, please do not hesitate to contact us.
    '
    ' Web Site:  http://www.frez.co.uk
    ' E-mail:	sales@frez.co.uk
    Private m_lOnBits(30)
    Private m_l2Power(30)
    Private K(63)
    Private Const BITS_TO_A_BYTE = 8
    Private Const BYTES_TO_A_WORD = 4
    Private Const BITS_TO_A_WORD = 32
    m_lOnBits(0) = CLng(1)
    m_lOnBits(1) = CLng(3)
    m_lOnBits(2) = CLng(7)
    m_lOnBits(3) = CLng(15)
    m_lOnBits(4) = CLng(31)
    m_lOnBits(5) = CLng(63)
    m_lOnBits(6) = CLng(127)
    m_lOnBits(7) = CLng(255)
    m_lOnBits(8) = CLng(511)
    m_lOnBits(9) = CLng(1023)
    m_lOnBits(10) = CLng(2047)
    m_lOnBits(11) = CLng(4095)
    m_lOnBits(12) = CLng(8191)
    m_lOnBits(13) = CLng(16383)
    m_lOnBits(14) = CLng(32767)
    m_lOnBits(15) = CLng(65535)
    m_lOnBits(16) = CLng(131071)
    m_lOnBits(17) = CLng(262143)
    m_lOnBits(18) = CLng(524287)
    m_lOnBits(19) = CLng(1048575)
    m_lOnBits(20) = CLng(2097151)
    m_lOnBits(21) = CLng(4194303)
    m_lOnBits(22) = CLng(8388607)
    m_lOnBits(23) = CLng(16777215)
    m_lOnBits(24) = CLng(33554431)
    m_lOnBits(25) = CLng(67108863)
    m_lOnBits(26) = CLng(134217727)
    m_lOnBits(27) = CLng(268435455)
    m_lOnBits(28) = CLng(536870911)
    m_lOnBits(29) = CLng(1073741823)
    m_lOnBits(30) = CLng(2147483647)
    m_l2Power(0) = CLng(1)
    m_l2Power(1) = CLng(2)
    m_l2Power(2) = CLng(4)
    m_l2Power(3) = CLng(8)
    m_l2Power(4) = CLng(16)
    m_l2Power(5) = CLng(32)
    m_l2Power(6) = CLng(64)
    m_l2Power(7) = CLng(128)
    m_l2Power(8) = CLng(256)
    m_l2Power(9) = CLng(512)
    m_l2Power(10) = CLng(1024)
    m_l2Power(11) = CLng(2048)
    m_l2Power(12) = CLng(4096)
    m_l2Power(13) = CLng(8192)
    m_l2Power(14) = CLng(16384)
    m_l2Power(15) = CLng(32768)
    m_l2Power(16) = CLng(65536)
    m_l2Power(17) = CLng(131072)
    m_l2Power(18) = CLng(262144)
    m_l2Power(19) = CLng(524288)
    m_l2Power(20) = CLng(1048576)
    m_l2Power(21) = CLng(2097152)
    m_l2Power(22) = CLng(4194304)
    m_l2Power(23) = CLng(8388608)
    m_l2Power(24) = CLng(16777216)
    m_l2Power(25) = CLng(33554432)
    m_l2Power(26) = CLng(67108864)
    m_l2Power(27) = CLng(134217728)
    m_l2Power(28) = CLng(268435456)
    m_l2Power(29) = CLng(536870912)
    m_l2Power(30) = CLng(1073741824)
    	
    K(0) = &H428A2F98
    K(1) = &H71374491
    K(2) = &HB5C0FBCF
    K(3) = &HE9B5DBA5
    K(4) = &H3956C25B
    K(5) = &H59F111F1
    K(6) = &H923F82A4
    K(7) = &HAB1C5ED5
    K(8) = &HD807AA98
    K(9) = &H12835B01
    K(10) = &H243185BE
    K(11) = &H550C7DC3
    K(12) = &H72BE5D74
    K(13) = &H80DEB1FE
    K(14) = &H9BDC06A7
    K(15) = &HC19BF174
    K(16) = &HE49B69C1
    K(17) = &HEFBE4786
    K(18) = &HFC19DC6
    K(19) = &H240CA1CC
    K(20) = &H2DE92C6F
    K(21) = &H4A7484AA
    K(22) = &H5CB0A9DC
    K(23) = &H76F988DA
    K(24) = &H983E5152
    K(25) = &HA831C66D
    K(26) = &HB00327C8
    K(27) = &HBF597FC7
    K(28) = &HC6E00BF3
    K(29) = &HD5A79147
    K(30) = &H6CA6351
    K(31) = &H14292967
    K(32) = &H27B70A85
    K(33) = &H2E1B2138
    K(34) = &H4D2C6DFC
    K(35) = &H53380D13
    K(36) = &H650A7354
    K(37) = &H766A0ABB
    K(38) = &H81C2C92E
    K(39) = &H92722C85
    K(40) = &HA2BFE8A1
    K(41) = &HA81A664B
    K(42) = &HC24B8B70
    K(43) = &HC76C51A3
    K(44) = &HD192E819
    K(45) = &HD6990624
    K(46) = &HF40E3585
    K(47) = &H106AA070
    K(48) = &H19A4C116
    K(49) = &H1E376C08
    K(50) = &H2748774C
    K(51) = &H34B0BCB5
    K(52) = &H391C0CB3
    K(53) = &H4ED8AA4A
    K(54) = &H5B9CCA4F
    K(55) = &H682E6FF3
    K(56) = &H748F82EE
    K(57) = &H78A5636F
    K(58) = &H84C87814
    K(59) = &H8CC70208
    K(60) = &H90BEFFFA
    K(61) = &HA4506CEB
    K(62) = &HBEF9A3F7
    K(63) = &HC67178F2
    Private Function LShift(lValue, iShiftBits)
    	If iShiftBits = 0 Then
    		LShift = lValue
    		Exit Function
    	ElseIf iShiftBits = 31 Then
    		If lValue And 1 Then
    			LShift = &H80000000
    		Else
    			LShift = 0
    		End If
    		Exit Function
    	ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
    		Err.Raise 6
    	End If
    	
    	If (lValue And m_l2Power(31 - iShiftBits)) Then
    		LShift = ((lValue And m_lOnBits(31 - (iShiftBits + 1))) * m_l2Power(iShiftBits)) Or &H80000000
    	Else
    		LShift = ((lValue And m_lOnBits(31 - iShiftBits)) * m_l2Power(iShiftBits))
    	End If
    End Function
    Private Function RShift(lValue, iShiftBits)
    	If iShiftBits = 0 Then
    		RShift = lValue
    		Exit Function
    	ElseIf iShiftBits = 31 Then
    		If lValue And &H80000000 Then
    			RShift = 1
    		Else
    			RShift = 0
    		End If
    		Exit Function
    	ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
    		Err.Raise 6
    	End If
    	
    	RShift = (lValue And &H7FFFFFFE) \ m_l2Power(iShiftBits)
    	
    	If (lValue And &H80000000) Then
    		RShift = (RShift Or (&H40000000 \ m_l2Power(iShiftBits - 1)))
    	End If
    End Function
    Private Function AddUnsigned(lX, lY)
    	Dim lX4
    	Dim lY4
    	Dim lX8
    	Dim lY8
    	Dim lResult
     
    	lX8 = lX And &H80000000
    	lY8 = lY And &H80000000
    	lX4 = lX And &H40000000
    	lY4 = lY And &H40000000
     
    	lResult = (lX And &H3FFFFFFF) + (lY And &H3FFFFFFF)
     
    	If lX4 And lY4 Then
    		lResult = lResult Xor &H80000000 Xor lX8 Xor lY8
    	ElseIf lX4 Or lY4 Then
    		If lResult And &H40000000 Then
    			lResult = lResult Xor &HC0000000 Xor lX8 Xor lY8
    		Else
    			lResult = lResult Xor &H40000000 Xor lX8 Xor lY8
    		End If
    	Else
    		lResult = lResult Xor lX8 Xor lY8
    	End If
     
    	AddUnsigned = lResult
    End Function
    Private Function Ch(x, y, z)
    	Ch = ((x And y) Xor ((Not x) And z))
    End Function
    Private Function Maj(x, y, z)
    	Maj = ((x And y) Xor (x And z) Xor (y And z))
    End Function
    Private Function S(x, n)
    	S = (RShift(x, (n And m_lOnBits(4))) Or LShift(x, (32 - (n And m_lOnBits(4)))))
    End Function
    Private Function R(x, n)
    	R = RShift(x, cLng(n And m_lOnBits(4)))
    End Function
    Private Function Sigma0(x)
    	Sigma0 = (S(x, 2) Xor S(x, 13) Xor S(x, 22))
    End Function
    Private Function Sigma1(x)
    	Sigma1 = (S(x, 6) Xor S(x, 11) Xor S(x, 25))
    End Function
    Private Function Gamma0(x)
    	Gamma0 = (S(x, 7) Xor S(x, 18) Xor R(x, 3))
    End Function
    Private Function Gamma1(x)
    	Gamma1 = (S(x, 17) Xor S(x, 19) Xor R(x, 10))
    End Function
    Private Function ConvertToWordArray(sMessage)
    	Dim lMessageLength
    	Dim lNumberOfWords
    	Dim lWordArray()
    	Dim lBytePosition
    	Dim lByteCount
    	Dim lWordCount
    	Dim lByte
    	
    	Const MODULUS_BITS = 512
    	Const CONGRUENT_BITS = 448
    	
    	lMessageLength = Len(sMessage)
    	
    	lNumberOfWords = (((lMessageLength + ((MODULUS_BITS - CONGRUENT_BITS) \ BITS_TO_A_BYTE)) \ (MODULUS_BITS \ BITS_TO_A_BYTE)) + 1) * (MODULUS_BITS \ BITS_TO_A_WORD)
    	ReDim lWordArray(lNumberOfWords - 1)
    	
    	lBytePosition = 0
    	lByteCount = 0
    	Do Until lByteCount >= lMessageLength
    		lWordCount = lByteCount \ BYTES_TO_A_WORD
    		
    		lBytePosition = (3 - (lByteCount Mod BYTES_TO_A_WORD)) * BITS_TO_A_BYTE
    		
    		lByte = AscB(Mid(sMessage, lByteCount + 1, 1))
    		
    		lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(lByte, lBytePosition)
    		lByteCount = lByteCount + 1
    	Loop
    	lWordCount = lByteCount \ BYTES_TO_A_WORD
    	lBytePosition = (3 - (lByteCount Mod BYTES_TO_A_WORD)) * BITS_TO_A_BYTE
    	lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(&H80, lBytePosition)
    	lWordArray(lNumberOfWords - 1) = LShift(lMessageLength, 3)
    	lWordArray(lNumberOfWords - 2) = RShift(lMessageLength, 29)
    	
    	ConvertToWordArray = lWordArray
    End Function
    Public Function SHA256(sMessage)
    	Dim HASH(7)
    	Dim M
    	Dim W(63)
    	Dim a
    	Dim b
    	Dim c
    	Dim d
    	Dim e
    	Dim f
    	Dim g
    	Dim h
    	Dim i
    	Dim j
    	Dim T1
    	Dim T2
    	
    	HASH(0) = &H6A09E667
    	HASH(1) = &HBB67AE85
    	HASH(2) = &H3C6EF372
    	HASH(3) = &HA54FF53A
    	HASH(4) = &H510E527F
    	HASH(5) = &H9B05688C
    	HASH(6) = &H1F83D9AB
    	HASH(7) = &H5BE0CD19
    	
    	M = ConvertToWordArray(sMessage)
    	
    	For i = 0 To UBound(M) Step 16
    		a = HASH(0)
    		b = HASH(1)
    		c = HASH(2)
    		d = HASH(3)
    		e = HASH(4)
    		f = HASH(5)
    		g = HASH(6)
    		h = HASH(7)
    		
    		For j = 0 To 63
    			If j < 16 Then
    				W(j) = M(j + i)
    			Else
    				W(j) = AddUnsigned(AddUnsigned(AddUnsigned(Gamma1(W(j - 2)), W(j - 7)), Gamma0(W(j - 15))), W(j - 16))
    			End If
    				
    			T1 = AddUnsigned(AddUnsigned(AddUnsigned(AddUnsigned(h, Sigma1(e)), Ch(e, f, g)), K(j)), W(j))
    			T2 = AddUnsigned(Sigma0(a), Maj(a, b, c))
    			
    			h = g
    			g = f
    			f = e
    			e = AddUnsigned(d, T1)
    			d = c
    			c = b
    			b = a
    			a = AddUnsigned(T1, T2)
    		Next
    		
    		HASH(0) = AddUnsigned(a, HASH(0))
    		HASH(1) = AddUnsigned(b, HASH(1))
    		HASH(2) = AddUnsigned(c, HASH(2))
    		HASH(3) = AddUnsigned(d, HASH(3))
    		HASH(4) = AddUnsigned(e, HASH(4))
    		HASH(5) = AddUnsigned(f, HASH(5))
    		HASH(6) = AddUnsigned(g, HASH(6))
    		HASH(7) = AddUnsigned(h, HASH(7))
    	Next
    	
    	SHA256 = LCase(Right("00000000" & Hex(HASH(0)), 8) & Right("00000000" & Hex(HASH(1)), 8) & Right("00000000" & Hex(HASH(2)), 8) & Right("00000000" & Hex(HASH(3)), 8) & Right("00000000" & Hex(HASH(4)), 8) & Right("00000000" & Hex(HASH(5)), 8) & Right("00000000" & Hex(HASH(6)), 8) & Right("00000000" & Hex(HASH(7)), 8))
    End Function
    %>

  17. #92
    SitePoint Wizard silver trophybronze trophy asp_funda's Avatar
    Join Date
    Jun 2003
    Location
    ether
    Posts
    4,497
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)
    Is this function's hash any different from the SHA1
    hashes that we use?
    Our lives teach us who we are.
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Me - Photo Blog - Personal Blog - Dev Blog
    iG:Syntax Hiliter -- Colourize your code in WordPress!!

  18. #93
    SitePoint Zealot
    Join Date
    Jul 1999
    Location
    Virginia, USA
    Posts
    103
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    I'm not sure. I'm not much of a hash/encryption expert. What method do you
    use for SHA1? Coded function? Built-in VBScript function? I would sorta assume
    that the SHA256 would stand for 256 bit encryption, but I'm not sure. (see first
    two sentences If you go to their website, they have an MD5 hash function
    as well. On their website they have the SHA256 and MD5 functions in VB and
    VBScript. The MD5 function is in JavaScript as well.
    Last edited by starrsoft; Aug 31, 2004 at 05:45. Reason: Just realized that SP doesn't do auto VbCrLf, <br> or whatever...

  19. #94
    SitePoint Wizard silver trophybronze trophy asp_funda's Avatar
    Join Date
    Jun 2003
    Location
    ether
    Posts
    4,497
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)
    Well, I use a user-defined function like this for SHA1
    hashing. It isn't built in VBScript. And as far as I know,
    its 160bit hashing. So maybe the function you posted
    produces a stronger hash. I think I'll hash a string with
    both functions & compare them.
    Our lives teach us who we are.
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Me - Photo Blog - Personal Blog - Dev Blog
    iG:Syntax Hiliter -- Colourize your code in WordPress!!

  20. #95
    SitePoint Wizard bronze trophy
    Join Date
    Oct 2001
    Location
    Vancouver BC Canada
    Posts
    2,033
    Mentioned
    5 Post(s)
    Tagged
    0 Thread(s)

    Apply XSLT with arguments against XML

    Here's a simple function for your toolbox for applying XSL to XML and passing an array of arguments that can be used as parameters in the stylesheet. If you haven't needed this yet... You will. ;~)

    Code:
    <%
    
       Function transformXMLArguments(strXMLDoc, strXSLDoc, arrParams)
    
       	Set xml = Server.CreateObject("MSXML2.FreeThreadedDOMDocument.3.0")
       	xml.async = false
       	xml.load strXMLDoc
    
       	Set xsl = Server.CreateObject("MSXML2.FreeThreadedDOMDocument.3.0")
       	xsl.async = false
      	xsl.load strXSLDoc
    
       	Set template = Server.CreateObject("MSXML2.XSLTemplate")
       	template.stylesheet = xsl
       	set processor = template.createProcessor()
    
       	processor.input = xml
    	
    	For i = 0 to UBound(arrParams)
    		If arrParams(i) <> "" Then
    			processor.addParameter "param" & (i+1), arrParams(i)
    		End If
    	Next
    
       	processor.transform()
    
    	transformXMLArguments = (processor.output)
       
       	Set xml = nothing
       	Set xsl = nothing
    	Set template = nothing
        set processor = nothing
       End Function
       
    %>
    It would be used as follows if you are using parameters in your stylesheet:

    <%
    myarray = array("some text", 23, 34)
    response.write transformXMLArguments(Server.MapPath("../xml/sitemap.xml"), Server.MapPath(xslTemp), myarray)
    %>

    You can access your parameters in your stylesheet by instantiating them with the prefix param and their number in the array. I started with 1. so in your stylesheet for this example you'll have something like:
    <xsl:param name="param1" /> <!--this would be: "some text" -->
    <xsl:param name="param2" /> <!--this is: 23 -->
    <xsl:param name="param3" /> <!--this is: 34 -->

    Or you can use it without parameters like so:

    <%
    response.write transformXMLArguments(Server.MapPath("xml-file.xml"), Server.MapPath("xsl-file.xsl"), "")
    %>

    Have fun - Andrew
    Andrew Wasson | www.lunadesign.org
    Principal / Internet Development

  21. #96
    SitePoint Wizard silver trophybronze trophy asp_funda's Avatar
    Join Date
    Jun 2003
    Location
    ether
    Posts
    4,497
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Post Read a File into a variable

    Here's a function that I made long ago to read the contents of a file in a variable. This function accepts the file name as parameter & is a bit raw, but it serves my purpose, so hopefully it'll serve others as well.

    Code:
    Private Function readMyFile(pFileName)
    	SET FSO = Server.CreateObject("Scripting.FileSystemObject")
    	IF (TRIM(pFileName)="") THEN
    		EXIT FUNCTION
    	ELSE
    		IF FSO.FileExists(Server.MapPath(pFileName)) THEN
    			SET mFile = FSO.OpenTextFile(Server.MapPath(pFileName))
    			readMyFile = mFile.ReadAll
    		ELSE
    			readMyFile = "File Not Found"
    		END IF
    	END IF
    	SET mFile = NOTHING
    	SET FSO = NOTHING
    End Function
    Its usage is quite simple.
    Code:
    strFileName = "data/myFile.asp"
    strFileContent = readMyFile(strFileName)	'Data of file read up into the variable
    Our lives teach us who we are.
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Me - Photo Blog - Personal Blog - Dev Blog
    iG:Syntax Hiliter -- Colourize your code in WordPress!!

  22. #97
    SitePoint Member
    Join Date
    Nov 2004
    Location
    asd
    Posts
    11
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    Clean all the HTML tags to reviel "content"

    function ClearHTMLTags(strHTML, intWorkFlow)
    dim regEx, strTagLess
    strTagless = strHTML
    set regEx = New RegExp
    regEx.IgnoreCase = True
    regEx.Global = True
    if intWorkFlow <> 1 then
    regEx.Pattern = "<[^>]*>"
    strTagLess = regEx.Replace(strTagLess, " ")
    end if
    if intWorkFlow > 0 and intWorkFlow < 3 then
    regEx.Pattern = "[<]"
    strTagLess = regEx.Replace(strTagLess, "&lt;")
    regEx.Pattern = "[>]"
    strTagLess = regEx.Replace(strTagLess, "&gt;")
    end if
    set regEx = nothing
    ClearHTMLTags = replace(strTagLess,"&nbsp;"," ")
    end function

  23. #98
    SitePoint Member
    Join Date
    Nov 2004
    Location
    asd
    Posts
    11
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    Days in a month

    function getDaysInMonth(strMonth,strYear)
    dim strDays
    Select Case cint(strMonth)
    Case 1,3,5,7,8,10,12:
    strDays = 31
    Case 4,6,9,11:
    strDays = 30
    Case 2:
    if ((cint(strYear) mod 4 = 0 and _
    cint(strYear) mod 100 <> 0) _
    or ( cint(strYear) mod 400 = 0) ) then
    strDays = 29
    else
    strDays = 28
    end if
    End Select
    getDaysInMonth = strDays
    end function

  24. #99
    SitePoint Member
    Join Date
    Nov 2004
    Location
    asd
    Posts
    11
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    Day suffix

    function dayDateSuffix(intday)
    select case right(intday,1)
    case "1"
    dayDateSuffix="st"
    case "2"
    dayDateSuffix="nd"
    case "3"
    dayDateSuffix="rd"
    case else
    dayDateSuffix="th"
    end select
    if len(intday)=2 and intDay>9 and intDay<21 then
    dayDateSuffix="th"
    end if
    dayDateSuffix="<sup>"& dayDateSuffix & "</sup>"
    end function

  25. #100
    SitePoint Wizard silver trophybronze trophy asp_funda's Avatar
    Join Date
    Jun 2003
    Location
    ether
    Posts
    4,497
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)
    Its a better practice to supplement your functions by presenting an example of usage.
    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
  •