SitePoint Sponsor |
|
User Tag List
Results 76 to 100 of 127
Thread: Funky Functions in ASP
-
Jan 8, 2004, 07:30 #76
- Join Date
- Nov 1999
- Location
- Mechanicsburg, PA
- Posts
- 7,294
- Mentioned
- 123 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) & ": </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
-
Jan 8, 2004, 08:39 #77
Originally Posted by DaveMaxwell
-
Jan 8, 2004, 09:07 #78
- Join Date
- Nov 1999
- Location
- Mechanicsburg, PA
- Posts
- 7,294
- Mentioned
- 123 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
-
Jan 8, 2004, 13:05 #79
- 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!!
-
Jan 20, 2004, 06:50 #80
- 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
"Does this napkin smell like chloroform?"
...now with SnapFoo!
My Blog | My Twitter | My Company | SitePoint Podcast
*** Matt Mullenweg on the SitePoint Podcast ***
-
Jan 20, 2004, 06:55 #81
-
Jan 23, 2004, 16:30 #82
- 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
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!!
-
Jan 24, 2004, 12:50 #83
- 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
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!!
-
Feb 27, 2004, 07:00 #84
- Join Date
- Nov 1999
- Location
- Mechanicsburg, PA
- Posts
- 7,294
- Mentioned
- 123 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
-
Jun 26, 2004, 13:36 #85
- Join Date
- May 2002
- Location
- Jacksonville, FL
- Posts
- 1,168
- Mentioned
- 0 Post(s)
- Tagged
- 0 Thread(s)
Can we sticky this thread?
-
Jun 26, 2004, 14:14 #86
- 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.
"Does this napkin smell like chloroform?"
...now with SnapFoo!
My Blog | My Twitter | My Company | SitePoint Podcast
*** Matt Mullenweg on the SitePoint Podcast ***
-
Jun 26, 2004, 14:21 #87
- 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...
-
Jul 7, 2004, 14:59 #88
- 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
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
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!!
-
Aug 2, 2004, 14:10 #89
- 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
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!!
-
Aug 6, 2004, 05:58 #90
- 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
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
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.
-
Aug 30, 2004, 13:14 #91
- 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 %>
-
Aug 31, 2004, 02:41 #92
- 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!!
-
Aug 31, 2004, 05:42 #93
- 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 sentencesIf 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...
-
Aug 31, 2004, 11:56 #94
- 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!!
-
Oct 13, 2004, 23:39 #95
- Join Date
- Oct 2001
- Location
- Vancouver BC Canada
- Posts
- 2,037
- 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 %>
<%
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 - AndrewAndrew Wasson | www.lunadesign.org
Principal / Internet Development
-
Nov 1, 2004, 13:03 #96
- Join Date
- Jun 2003
- Location
- ether
- Posts
- 4,497
- Mentioned
- 1 Post(s)
- Tagged
- 0 Thread(s)
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
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!!
-
Nov 9, 2004, 05:31 #97
- 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, "<")
regEx.Pattern = "[>]"
strTagLess = regEx.Replace(strTagLess, ">")
end if
set regEx = nothing
ClearHTMLTags = replace(strTagLess," "," ")
end function
-
Nov 9, 2004, 05:32 #98
- 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
-
Nov 9, 2004, 05:33 #99
- 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
-
Nov 9, 2004, 09:40 #100
- 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