Related
I am trying to migrate some code from Classic ASP/VBScript.
This code shown below generates a barcode. As it is known, some functions do not exist or are entirely different in .NET. So I figured I would thrown the old code, in the code-behind of my barcode.aspx page (as I call the barcode generation sequence like this:
<img src="/barcode.aspx?code="<%: getID(sheet_id)%>" border="0" height="80"/>
This is the Classic code:
<%
Option Explicit
Response.CodePage = 1252
Response.CharSet = "windows-1252"
Response.Contenttype = "image/bmp"
' code = bar code value
' height = height of barcode in pixels.
' width = width MULTIPLIER in pixels.
' mode = type of barcode (Currently supported barcode types: code39, code128b, UPC-A, EAN-13)
'
dim code, origcode, height, width, mode, caching, FontKey, FontCN10, FontCN12
caching = False ' turn this on to cache barcodes in '10101010' format. Might speed things up on busy servers, although this script doesn't take many resources to begin with. An EAN-13 or UPC barcode will take less than 100 bytes of memory space. Other types will take more or less depending on the length of the barcode created.
' DO NOT EDIT BELOW THIS LINE!
code = Request.QueryString("code")
height = 80 'request.querystring("height")
width = 2 'request.querystring("width")
mode = "code39" 'request.querystring("mode")
origcode = code
if not IsNumeric(height) or height = "" then height = 1 else height = numeric(height)
if not IsNumeric(width) or width = "" then width = 1 else width = numeric(width)
if caching AND application("cache" & origcode & mode & height & width) <> "" then
code = application("cache" & origcode & mode & height & width)
else
select case lcase(mode)
case "raw" ' do nothing. non-0 chars are automatically 1s
case "code39": code = code39(code)
case "code128b": code = code128b(code)
case "upc-a": code = codeean13("0" & code, "AAAAAA")
case "ean-13": code = codeean13(code, eanflag(left(code, 1)))
end select
if caching then
Application.Lock
Application("cache" & origcode & mode & height & width) = code
Application.UnLock
end if
end if
Function stb(String)
Dim I, B
For I=1 to len(String)
B = B & ChrB(Asc(Mid(String,I,1)))
Next
stb = B
End Function
function tstr(data, width)
dim tchar, total, tpos, i, j, x
tchar = 0
total = ""
tpos = 8
for i = 1 to len(data)
for j = 1 to width
tpos = tpos - 1
if mid(data, i, 1) <> "0" then tchar = tchar + 2^tpos
if tpos = 0 then
total = total & chr(tchar)
tpos = 8
tchar = 0
end if
next
next
if tpos <> 8 then
total = total & chr(tchar)
end if
x = len(total) mod 4
if x = 0 then x = 4
for i = x to 3
total = total & chr(0)
next
tstr = total
end function
function numeric(num)
dim numb, valid, i
numb = ""
valid = "0123456789"
for i = 1 to len(num)
if InStr(valid, mid(num, i, 1)) > 0 then numb = numb & mid(num, i, 1)
next
num = left(num, 30)
numeric = cint(num)
end function
function size(lngth)
lngth = cdbl(lngth)
if lngth > 255 then
if lngth > 65535 then lngth = 65535
size = chr(lngth mod 256) & chr(int(lngth/256))
else
size = chr(lngth) & chr(0)
end if
end function
function code39(code)
dim output, i, clet
output = ""
code = "*" & replace(code, "*", "") & "*"
for i = 1 to len(code)
clet = ""
select case ucase(mid(code, i, 1))
case "1": clet = "111010001010111"
case "2": clet = "101110001010111"
case "3": clet = "111011100010101"
case "4": clet = "101000111010111"
case "5": clet = "111010001110101"
case "6": clet = "101110001110101"
case "7": clet = "101000101110111"
case "8": clet = "111010001011101"
case "9": clet = "101110001011101"
case "0": clet = "101000111011101"
case "A": clet = "111010100010111"
case "B": clet = "101110100010111"
case "C": clet = "111011101000101"
case "D": clet = "101011100010111"
case "E": clet = "111010111000101"
case "F": clet = "101110111000101"
case "G": clet = "101010001110111"
case "H": clet = "111010100011101"
case "I": clet = "101110100011101"
case "J": clet = "101011100011101"
case "K": clet = "111010101000111"
case "L": clet = "101110101000111"
case "M": clet = "111011101010001"
case "N": clet = "101011101000111"
case "O": clet = "111010111010001"
case "P": clet = "101110111010001"
case "Q": clet = "101010111000111"
case "R": clet = "111010101110001"
case "S": clet = "101110101110001"
case "T": clet = "101011101110001"
case "U": clet = "111000101010111"
case "V": clet = "100011101010111"
case "W": clet = "111000111010101"
case "X": clet = "100010111010111"
case "Y": clet = "111000101110101"
case "Z": clet = "100011101110101"
case "-": clet = "100010101110111"
case ".": clet = "111000101011101"
case " ": clet = "100011101011101"
case "*": clet = "100010111011101"
case "$": clet = "100010001000101"
case "/": clet = "100010001010001"
case "+": clet = "100010100010001"
case "%": clet = "101000100010001"
end select
output = output & clet & "0"
next
code39 = left(output, len(output)-1)
end function
Function code128b(ByVal InputString)
Const MinValidAscii = 32
Const MaxValidAscii = 126
Dim CharValue(255)
Dim i
for i = 0 to 94
CharValue(i+32) = i
next
for i = 95 to 106
CharValue(i+100) = i
next
' Encode the input string
InputString = Trim(InputString)
Dim CheckDigitValue, CharPos, CharAscii, InvalidCharsFound
InvalidCharsFound = false
CheckDigitValue = CharValue(204)
For CharPos = 1 To Len(InputString)
CharAscii = Asc(Mid(InputString, CharPos, 1))
if (CharAscii < MinValidAscii) OR (CharAscii > MaxValidAscii) then
CharAscii = Asc("?")
InvalidCharsFound = true
end if
CheckDigitValue = CheckDigitValue + (CharValue(CharAscii) * CharPos)
Next
CheckDigitValue = (CheckDigitValue Mod 103)
Dim CheckDigitAscii
if CheckDigitValue < 95 then
CheckDigitAscii = CheckDigitValue + 32
else
CheckDigitAscii = CheckDigitValue + 100
end if
Dim OutputString
OutputString = Chr(204) & InputString & Chr(CheckDigitAscii) & Chr(206)
Dim BarcodePattern(255)
BarcodePattern(32) = "212222" ' <SPACE>
BarcodePattern(33) = "222122" ' !
BarcodePattern(34) = "222221" ' "
BarcodePattern(35) = "121223" ' #
BarcodePattern(36) = "121322" ' $
BarcodePattern(37) = "131222" ' %
BarcodePattern(38) = "122213" ' &
BarcodePattern(39) = "122312" ' '
BarcodePattern(40) = "132212" ' (
BarcodePattern(41) = "221213" ' )
BarcodePattern(42) = "221312" ' *
BarcodePattern(43) = "231212" ' +
BarcodePattern(44) = "112232" ' ,
BarcodePattern(45) = "122132" ' -
BarcodePattern(46) = "122231" ' .
BarcodePattern(47) = "113222" ' /
BarcodePattern(48) = "123122" ' 0
BarcodePattern(49) = "123221" ' 1
BarcodePattern(50) = "223211" ' 2
BarcodePattern(51) = "221132" ' 3
BarcodePattern(52) = "221231" ' 4
BarcodePattern(53) = "213212" ' 5
BarcodePattern(54) = "223112" ' 6
BarcodePattern(55) = "312131" ' 7
BarcodePattern(56) = "311222" ' 8
BarcodePattern(57) = "321122" ' 9
BarcodePattern(58) = "321221" ' :
BarcodePattern(59) = "312212" ' ;
BarcodePattern(60) = "322112" ' <
BarcodePattern(61) = "322211" ' =
BarcodePattern(62) = "212123" ' >
BarcodePattern(63) = "212321" ' ?
BarcodePattern(64) = "232121" ' #
BarcodePattern(65) = "111323" ' A
BarcodePattern(66) = "131123" ' B
BarcodePattern(67) = "131321" ' C
BarcodePattern(68) = "112313" ' D
BarcodePattern(69) = "132113" ' E
BarcodePattern(70) = "132311" ' F
BarcodePattern(71) = "211313" ' G
BarcodePattern(72) = "231113" ' H
BarcodePattern(73) = "231311" ' I
BarcodePattern(74) = "112133" ' J
BarcodePattern(75) = "112331" ' K
BarcodePattern(76) = "132131" ' L
BarcodePattern(77) = "113123" ' M
BarcodePattern(78) = "113321" ' N
BarcodePattern(79) = "133121" ' O
BarcodePattern(80) = "313121" ' P
BarcodePattern(81) = "211331" ' Q
BarcodePattern(82) = "231131" ' R
BarcodePattern(83) = "213113" ' S
BarcodePattern(84) = "213311" ' T
BarcodePattern(85) = "213131" ' U
BarcodePattern(86) = "311123" ' V
BarcodePattern(87) = "311321" ' W
BarcodePattern(88) = "331121" ' X
BarcodePattern(89) = "312113" ' Y
BarcodePattern(90) = "312311" ' Z
BarcodePattern(91) = "332111" ' [
BarcodePattern(92) = "314111" ' /
BarcodePattern(93) = "221411" ' ]
BarcodePattern(94) = "431111" ' ^
BarcodePattern(95) = "111224" ' _
BarcodePattern(96) = "111422" ' `
BarcodePattern(97) = "121124" ' a
BarcodePattern(98) = "121421" ' b
BarcodePattern(99) = "141122" ' c
BarcodePattern(100) = "141221" ' d
BarcodePattern(101) = "112214" ' e
BarcodePattern(102) = "112412" ' f
BarcodePattern(103) = "122114" ' g
BarcodePattern(104) = "122411" ' h
BarcodePattern(105) = "142112" ' i
BarcodePattern(106) = "142211" ' j
BarcodePattern(107) = "241211" ' k
BarcodePattern(108) = "221114" ' l
BarcodePattern(109) = "413111" ' m
BarcodePattern(110) = "241112" ' n
BarcodePattern(111) = "134111" ' o
BarcodePattern(112) = "111242" ' p
BarcodePattern(113) = "121142" ' q
BarcodePattern(114) = "121241" ' r
BarcodePattern(115) = "114212" ' s
BarcodePattern(116) = "124112" ' t
BarcodePattern(117) = "124211" ' u
BarcodePattern(118) = "411212" ' v
BarcodePattern(119) = "421112" ' w
BarcodePattern(120) = "421211" ' x
BarcodePattern(121) = "212141" ' y
BarcodePattern(122) = "214121" ' z
BarcodePattern(123) = "412121" ' {
BarcodePattern(124) = "111143" ' |
BarcodePattern(125) = "111341" ' }
BarcodePattern(126) = "131141" ' ~
BarcodePattern(195) = "114113"
BarcodePattern(196) = "114311"
BarcodePattern(197) = "411113"
BarcodePattern(198) = "411311"
BarcodePattern(199) = "113141"
BarcodePattern(200) = "114131"
BarcodePattern(201) = "311141"
BarcodePattern(202) = "411131"
BarcodePattern(203) = "211412"
BarcodePattern(204) = "211214"
BarcodePattern(205) = "211232"
BarcodePattern(206) = "2331112"
Dim OutputPattern, ThisPattern, thischar
OutputPattern = ""
for CharPos = 1 to Len(OutputString)
ThisPattern = BarcodePattern(Asc(Mid(OutputString, CharPos, 1)))
for i = 1 to len(ThisPattern)
if i mod 2 = 1 then thischar = "1" else thischar = "0"
OutputPattern = OutputPattern & replace(space(int(mid(ThisPattern, i, 1))), " ", thischar)
next
next
code128b = OutputPattern
End Function
Function CodeEAN13(code, encoding)
Dim leftA, leftB, rght, OutputPattern, i
if len(code) = 13 then
LeftA = Array("0001101", "0011001", "0010011", "0111101", "0100011", "0110001", "0101111", "0111011", "0110111", "0001011")
LeftB = Array("0100111", "0110011", "0011011", "0100001", "0011101", "0111001", "0000101", "0010001", "0001001", "0010111")
Rght = Array("1110010", "1100110", "1101100", "1000010", "1011100", "1001110", "1010000", "1000100", "1001000", "1110100")
OutputPattern = "101"
for i = 1 to 6
if mid(ucase(encoding), i, 1) = "A" then
OutputPattern = OutputPattern & LeftA(cint(mid(code, i+1, 1)))
else
OutputPattern = OutputPattern & LeftB(cint(mid(code, i+1, 1)))
end if
next
OutputPattern = OutputPattern & "01010"
for i = 1 to 6
OutputPattern = OutputPattern & Rght(cint(mid(code, i+7, 1)))
next
OutputPattern = OutputPattern & "101"
CodeEAN13 = OutputPattern
end if
End Function
Function eanflag(num)
select case num
case 0: eanflag = "AAAAAA"
case 1: eanflag = "AABABB"
case 2: eanflag = "AABBAB"
case 3: eanflag = "AABBBA"
case 4: eanflag = "ABAABB"
case 5: eanflag = "ABBAAB"
case 6: eanflag = "ABBBAA"
case 7: eanflag = "ABABAB"
case 8: eanflag = "ABABBA"
case 9: eanflag = "ABBABA"
end select
End Function
dim dataout, i
if code <> "" then
dataout = tstr(code, width)
response.binarywrite stb(chr(66) & chr(77) & size(62+(len(dataout)*height)) & chr(0) & chr(0) & chr(0) & chr(0) & chr(0) & chr(0) & chr(62) & chr(0) & chr(0) & chr(0) & chr(40) & chr(0) & chr(0) & chr(0) & size(len(code)*width) & chr(0) & chr(0) & size(height) & chr(0) & chr(0) & chr(1) & chr(0) & chr(1) & chr(0) & chr(0) & chr(0) & chr(0) & chr(0) & chr(0) & chr(0) & chr(0) & chr(0) & chr(37) & chr(14) & chr(0) & chr(0) & chr(37) & chr(14) & chr(0) & chr(0) & chr(0) & chr(0) & chr(0) & chr(0) & chr(0) & chr(0) & chr(0) & chr(0) & chr(255) & chr(255) & chr(255) & chr(0) & chr(0) & chr(0) & chr(0) & chr(0))
for i = 1 to height
response.binarywrite stb(dataout)
next
end if
%>
The stuff the are "problematic" (based on VS underlining) are:
For I = 1 To Len(text)
B = B & ChrB(Asc(Mid(text, I, 1)))
Next
and Array in CodeEAN13 function, which I completely commented out since I am using Code39
I put this piece of code on code-behind of barcode.aspx's page load:
Response.Charset = "windows-1252"
Response.ContentType = "image/bmp"
Dim code, origcode, height, width, mode, caching, FontKey, FontCN10, FontCN12
caching = False ' turn this on to cache barcodes in '10101010' format. Might speed things up on busy servers, although this script doesn't take many resources to begin with. An EAN-13 or UPC barcode will take less than 100 bytes of memory space. Other types will take more or less depending on the length of the barcode created.
' DO NOT EDIT BELOW THIS LINE!
code = Request.QueryString("code")
height = 80 'request.querystring("height")
width = 2 'request.querystring("width")
mode = "code39" 'request.querystring("mode")
origcode = code
If Not IsNumeric(height) Or height = "" Then height = 1 Else height = numeric(height)
If Not IsNumeric(width) Or width = "" Then width = 1 Else width = numeric(width)
If caching And Application("cache" & origcode & mode & height & width) <> "" Then
code = Application("cache" & origcode & mode & height & width)
Else
Select Case LCase(mode)
Case "raw" ' do nothing. non-0 chars are automatically 1s
Case "code39" : code = code39(code)
Case "code128b" : code = code128b(code)
'Case "upc-a" : code = codeean13("0" & code, "AAAAAA")
'Case "ean-13" : code = codeean13(code, eanflag(Left(code, 1)))
End Select
If caching Then
Application.Lock()
Application("cache" & origcode & mode & height & width) = code
Application.UnLock()
End If
End If
If code <> "" Then
dataout = tstr(code, width)
Response.BinaryWrite(stb(Chr(66) & Chr(77) & size(62 + (Len(dataout) * height)) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(62) & Chr(0) & Chr(0) & Chr(0) & Chr(40) & Chr(0) & Chr(0) & Chr(0) & size(Len(code) * width) & Chr(0) & Chr(0) & size(height) & Chr(0) & Chr(0) & Chr(1) & Chr(0) & Chr(1) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(37) & Chr(14) & Chr(0) & Chr(0) & Chr(37) & Chr(14) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(255) & Chr(255) & Chr(255) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(0)))
For i = 1 To height
Response.BinaryWrite(stb(dataout))
Next
End If
Also, I tried changing
Function stb(text)
Dim I, B
For I = 1 To Len(text)
B = B & ChrB(Asc(Mid(text, I, 1)))
Next
stb = B
End Function
to
Function stb(text)
Dim I, B
For I = 1 To Len(text)
B = B & Convert.ToChar(Asc(Mid(text, I, 1)))
Next
stb = B
End Function
Well, needless to say, it does not work :)
So, after several hours of sweating and beating myself, I have used another solution.I will post it here for anyone that might have similar problems.
What I did was basically using the Barcode Rendering Framework
As no clear documentation exists for this library, I will explain the procedure below:
Download the library from the link above.
Add a reference to your project, browsing to Zen.Barcode.Core.dll
Import zen.barcode in your code-behind
The rest is in my code :)
Dim sheet_id As String = Session("generated_id")
Dim height As Integer = 80
Dim width As Integer = 80
'Dim mode As String = "code39"
Dim bar As Code39BarcodeDraw = BarcodeDrawFactory.Code39WithoutChecksum
Dim img As Image = bar.Draw(sheet_id, height, width)
Dim bmp As Bitmap = img
Dim stream As New System.IO.MemoryStream
bmp.Save(stream, Imaging.ImageFormat.Bmp)
stream.Position = 0
Dim size As Integer = stream.Length
Dim data(stream.Length) As Byte
stream.Read(data, 0, stream.Length)
Response.BinaryWrite(data)
The call is being made on the landing page's body like so:
<img src="/barcode.aspx" border="0" height="80" width="250"/>
Im having a problem with an IF statement.
The purpose of this statement is that all 3 managers must approve an order before it can prossesed.
This is the statement :
Dim RstAllchk
Dim RstAllchk_numRows
Set RstAllchk = Server.CreateObject("ADODB.Recordset")
RstAllchk.ActiveConnection = MM_DBConn_STRING
RstAllchk.Source = "SELECT comitee.OrderNo, comitee.Bart, comitee.Carel, comitee.Charl FROM comitee WHERE (((comitee.OrderNo)='" + Replace(RstAllData__varOrderNum, "'", "''") + "'));"
RstAllchk.CursorType = 0
RstAllchk.CursorLocation = 2
RstAllchk.LockType = 1
RstAllchk.Open()
RstAllchk_numRows = 0
if (RstAllchk.Fields.Item("Bart").Value)= "Approved" then
if (RstAllchk.Fields.Item("Carel").Value)= "Approved" then
if (RstAllchk.Fields.Item("Charl").Value)= "Approved" then
set cdata1 = Server.CreateObject("ADODB.Command")
cdata1.ActiveConnection = MM_DBConn_STRING
cdata1.CommandText = " UPDATE TblOrderData SET Fldapproved = 'Approved' WHERE FldOrderID = '" & RstAllData__varOrderNum & "'"
cdata1.CommandType = 1
cdata1.CommandTimeout = 0
cdata1.Prepared = true
cdata1.Execute()
cdata1.ActiveConnection.Close
set cdata2 = Server.CreateObject("ADODB.Command")
cdata2.ActiveConnection = MM_DBConn_STRING
cdata2.CommandText = " UPDATE TblOrderDetail SET FldMainapproved = 'Approved' WHERE FldOrderNum = '" & RstAllData__varOrderNum & "'"
cdata2.CommandType = 1
cdata2.CommandTimeout = 0
cdata2.Prepared = true
cdata2.Execute()
cdata2.ActiveConnection.Close
`
Sometimes if only one of the managers confirmed the order, the order is still approved. I have been struggling with this for days. Hope any of you can give me some advice.
Thanks
Assuming VB.NET:
IF (RstAllchk.Fields.Item("Bart").Value = "Approved" AND _
RstAllchk.Fields.Item("Carel").Value = "Approved" AND _
RstAllchk.Fields.Item("Charl").Value = "Approved") THEN
In C#:
if (RstAllchk.Fields.Item("Bart").Value == "Approved" &&
RstAllchk.Fields.Item("Carel").Value == "Approved" &&
RstAllchk.Fields.Item("Charl").Value == "Approved")
With C# (&& is And , == is equal)
if ( RstAllchk.Fields.Item("Bart").Value == "Approved"
&& RstAllchk.Fields.Item("Carel").Value == "Approved"
&& RstAllchk.Fields.Item("Charl").Value == "Approved"
)
{
//treatment
}
You can merge all like
(if var1 == x && var2 == y && var3 == z) {
//Do what you want
}
I have a shopping cart that using 2d array Cart(3, 20) to store user shop in a session.
It storing data like this:
Cart(0,0) = Product_ID
Cart(1,0) = Product_Name
Cart(2,0) = Product_Price
Cart(3,0) = Product_Qty
I want to count Items based on product_id ( we have not repetitive product_id)
I found a function here:
Function UniqueEntryCount(SourceRange)
Dim MyDataset
Dim dic
Set dic=Server.CreateObject("Scripting.Dictionary")
MyDataset = SourceRange
For i = 1 To UBound(MyDataset, 2)
if not dic.Exists(MyDataset(0, i)) then dic.Add MyDataset(0, i), ""
Next
UniqueEntryCount = dic.Count
Set dic = Nothing
End Function
But one problem is remain, When my Cart is empty, it show me 1
How can solved it?
An unitialized fixed array (Dim a(i, j)) contains i * j empty elements; your
if not dic.Exists(MyDataset(0, i)) then dic.Add MyDataset(0, i), ""
will pick up and count the first empty item. Demonstrated in code:
Dim afCart(3, 4)
Dim dicPID : Set dicPID = countPID00(afCart)
Dim aKeys : aKeys = dicPID.Keys
Dim vKey : vKey = aKeys(0)
WScript.Echo "A", dicPID.Count, TypeName(vKey)
Set dicPID = countPID(afCart)
WScript.Echo "B", dicPID.Count
afCart(0, 0) = "ignored"
afCart(0, 1) = 4711
afCart(0, 2) = 4712
afCart(0, 3) = 4711
' afCart(0, 4) = "not initialized/Empty"
Set dicPID = countPID(afCart)
WScript.Echo "C"
For Each vKey In dicPID.Keys
WScript.Echo "", vKey, "=", dicPID(vKey)
Next
Function countPID00(afCart)
Dim dicRVal : Set dicRVal = CreateObject("Scripting.Dictionary")
Dim MyDataset : MyDataset = afCart ' waste of ressources
Dim iRow
For iRow = 1 To UBound(MyDataset, 2)
If Not dicRVal.Exists(MyDataset(0, iRow)) Then
dicRVal(MyDataset(0, iRow)) = "" ' loss of info; will pick up Empty item
End If
Next
Set countPID00 = dicRVal
End Function ' countPID00
Function countPID(afCart)
Dim dicRVal : Set dicRVal = CreateObject("Scripting.Dictionary")
Dim iRow
For iRow = 1 To UBound(afCart, 2)
If Not IsEmpty(afCart(0, iRow)) Then
dicRVal(afCart(0, iRow)) = dicRVal(afCart(0, iRow)) + 1
End If
Next
Set countPID = dicRVal
End Function ' countPID
output:
A 1 Empty
B 0
C
4711 = 2
4712 = 1
I want to calculate the difference between two dates and want to convert it like 2 years, 5 months or only 3 months, or 2 days according to the difference considering all months are 30 days...
For example;
From and including: Mar 12, 2009
To, but not including : Nov 26, 2011
The output must be : 2 years, 8 months, 14 days excluding the end date.
Another example;
Start: Jan 26, 2010
End: Feb 15, 2010
Output: 20 days from the start date to the end date, but not including the end date
I can calculate the difference as month, day or hour with Datediff but the question is how to convert it to years, months and dates. It's quite complicated actually as we don't know how many days there are between two months (30,31 maybe 28 days)
I use this Classic ASP code to convert the difference but there are lot's of disadvantages.
Function Convert_Date_to_Text(tarih1,tarih2,useDates)
if (tarih1<>"" AND tarih2<>"") then
if Tarih_Araligi_Belirle(tarih1,tarih2,"day")>0 then
Date1_Year = Year(tarih1)
Date1_Month = Month(tarih1)
Date1_Day = Day(tarih1)
Date2_Year = Year(tarih2)
Date2_Month = Month(tarih2)
Date2_Day = Day(tarih2)
If (Date1_Month = 12) and (Date1_Day = 31) and
(Date2_Month = 1) and (Date2_Day = 1) Then
NoOfyears = Date2_Year - Date1_Year - 1
NoOfmonths = 0
NoOfdays = 1
Else
NoOfyears = Date2_Year - Date1_Year
NoOfmonths = Date2_Month - Date1_Month
NoOfdays = Date2_Day - Date1_Day
End If
If NoOfyears = 1 Then
FormatString = "1 year "
Else If NoOfyears <= 0 then
FormatString = ""
Else
FormatString = CStr(NoOfyears) & " years "
End If:End If
If NoOfmonths = 1 Then
FormatString = FormatString & "1 month"
Else If NoOfmonths <= 0 then
FormatString = FormatString
Else
FormatString = FormatString & CStr(NoOfmonths) & " months "
End If:End If
if useDates=1 then
If NoOfdays = 1 Then
FormatString = FormatString & "1 day"
Else If NoOfdays <= 0 Then
FormatString = FormatString
Else
FormatString = FormatString & CStr(NoOfdays) & " days"
End If:End If
end if
end if
end if
Convert_Date_to_Text = FormatString
End Function
This web site calculates the difference perfectly. TimeAndDate.Com
Note: I'm using Classic ASP for several reasons (Company limitations). Sorry for this but I need an ASP function. It looks like TimeSpan doesn't exist in ASP :(
Kind Regards
If you can convert the input strings to DateTime variables, you can try something like this:
DateTime starTime = //something;
DateTime endTime = //something;
TimeSpan oneDay = new TimeSpan(1, 0, 0, 0); //creates a timespan of 1 day
TimeSpan deltaTime = (endTime - startTime) - oneDay;
I would asume asp has the DateTime and TimeSpan variable types.
Here's a function I have used in the past. If you test it, I think you'll find it accurate. Here's where I got it from.
Function YearsMonthsDays(Date1 As Date, Date2 As Date, Optional ShowAll As _
Boolean = False, Optional Grammar As Boolean = True)
' This function returns a string "X years, Y months, Z days" showing the time
' between two dates. This function may be used in any VBA or VB project
' Date1 and Date2 must either be dates, or strings that can be implicitly
' converted to dates. If these arguments have time portions, the time portions
' are ignored. If Date1 > Date2 (after ignoring time portions), the function
' returns an empty string
' ShowAll indicates whether all portions of the string "X years, Y months, Z days"
' are included in the output. If ShowAll = True, all portions of the string are
' always included. If ShowAll = False, then if the year portion is zero the year
' part of the string is omitted, and if the year portion and month portion are both
' zero, than both year and month portions are omitted. The day portion is always
' included, and if at least one year has passed then the month portion is always
' included
' Grammar indicates whether to test years/months/days for singular or plural
' By definition, a "full month" means that the day number in Date2 is >= the day
' number in Date1, or Date1 and Date2 occur on the last days of their respective
' months. A "full year" means that 12 "full months" have passed.
' In Excel, this function is an alternative to the little-known DATEDIF. DATEDIF
' usually works well, but can create strange results when a date is at month end.
' Thus, this formula:
' =DATEDIF(A1,B1,"y") & " years, " & DATEDIF(A1,B1,"ym") & " months, " &
' DATEDIF(A1,B1,"md") & " days"
' will return "0 years, 1 months, -2 days" for 31-Jan-2006 and 1-Mar-2006.
' This function will return "0 years, 1 month, 1 day"
Dim TestYear As Long, TestMonth As Long, TestDay As Long
Dim TargetDate As Date, Last1 As Date, Last2 As Date
' Strip time portions
Date1 = Int(Date1)
Date2 = Int(Date2)
' Test for invalid dates
If Date1 > Date2 Then
YearsMonthsDays = ""
Exit Function
End If
' Test for whether the calendar year is the same
If Year(Date2) > Year(Date1) Then
' Different calendar year.
' Test to see if calendar month is the same. If it is, we have to look at the
' day to see if a full year has passed
If Month(Date2) = Month(Date1) Then
If Day(Date2) >= Day(Date1) Then
TestYear = DateDiff("yyyy", Date1, Date2)
Else
TestYear = DateDiff("yyyy", Date1, Date2) - 1
End If
' In this case, a full year has definitely passed
ElseIf Month(Date2) > Month(Date1) Then
TestYear = DateDiff("yyyy", Date1, Date2)
' A full year has not passed
Else
TestYear = DateDiff("yyyy", Date1, Date2) - 1
End If
' Calendar year is the same, so a full year has not passed
Else
TestYear = 0
End If
' Test to see how many full months have passed, in excess of the number of full
' years
TestMonth = (DateDiff("m", DateSerial(Year(Date1), Month(Date1), 1), _
DateSerial(Year(Date2), Month(Date2), 1)) + IIf(Day(Date2) >= _
Day(Date1), 0, -1)) Mod 12
' See how many days have passed, in excess of the number of full months. If the day
' number for Date2 is >= that for Date1, it's simple
If Day(Date2) >= Day(Date1) Then
TestDay = Day(Date2) - Day(Date1)
' If not, we have to test for end of the month
Else
Last1 = DateSerial(Year(Date2), Month(Date2), 0)
Last2 = DateSerial(Year(Date2), Month(Date2) + 1, 0)
TargetDate = DateSerial(Year(Date2), Month(Date2) - 1, Day(Date1))
If Last2 = Date2 Then
If TestMonth = 11 Then
TestMonth = 0
TestYear = TestYear + 1
Else
TestMonth = TestMonth + 1
End If
Else
TestDay = DateDiff("d", IIf(TargetDate > Last1, Last1, TargetDate), Date2)
End If
End If
If ShowAll Or TestYear >= 1 Then
YearsMonthsDays = TestYear & IIf(TestYear = 1 And Grammar, " year, ", _
" years, ") & TestMonth & IIf(TestMonth = 1 And Grammar, " month, ", _
" months, ") & TestDay & IIf(TestDay = 1 And Grammar, " day", " days")
Else
If TestMonth >= 1 Then
YearsMonthsDays = TestMonth & IIf(TestMonth = 1 And Grammar, " month, ", _
" months, ") & TestDay & IIf(TestDay = 1 And Grammar, " day", " days")
Else
YearsMonthsDays = TestDay & IIf(TestDay = 1 And Grammar, " day", " days")
End If
End If
End Function
How about this? (no TimeSpan but not sure if classic asp compatible)
DateTime dateTime1 = new DateTime(2003,2,2);
DateTime dateTime2 = new DateTime(2001,1,1);
int daysDiff = dateTime1.Day - dateTime2.Day;
int monthsDiff = dateTime1.Month - dateTime2.Month;
int yearsDiff = dateTime1.Year - dateTime2.Year;
if (daysDiff < 0)
{
daysDiff += DateTime.DaysInMonth(dateTime1.Year, dateTime1.Month);
monthsDiff--;
}
if (monthsDiff < 0)
{
monthsDiff += 12;
yearsDiff--;
}
Console.WriteLine(daysDiff);
Console.WriteLine(monthsDiff);
Console.WriteLine(yearsDiff);
You can subtract DateTime objects to get a TimeSpan object:
DateTime startDate = GetStartDate();
DateTime endDate = GetEndDate();
TimeSpan duration = endDate - startDate;
This article includes a DateDiff class:
// ----------------------------------------------------------------------
public void DateDiffSample()
{
DateTime date1 = new DateTime( 2009, 11, 8, 7, 13, 59 );
Console.WriteLine( "Date1: {0}", date1 );
// > Date1: 08.11.2009 07:13:59
DateTime date2 = new DateTime( 2011, 3, 20, 19, 55, 28 );
Console.WriteLine( "Date2: {0}", date2 );
// > Date2: 20.03.2011 19:55:28
DateDiff dateDiff = new DateDiff( date1, date2 );
// differences
Console.WriteLine( "DateDiff.Years: {0}", dateDiff.Years );
// > DateDiff.Years: 1
Console.WriteLine( "DateDiff.Quarters: {0}", dateDiff.Quarters );
// > DateDiff.Quarters: 5
Console.WriteLine( "DateDiff.Months: {0}", dateDiff.Months );
// > DateDiff.Months: 16
Console.WriteLine( "DateDiff.Weeks: {0}", dateDiff.Weeks );
// > DateDiff.Weeks: 70
Console.WriteLine( "DateDiff.Days: {0}", dateDiff.Days );
// > DateDiff.Days: 497
Console.WriteLine( "DateDiff.Weekdays: {0}", dateDiff.Weekdays );
// > DateDiff.Weekdays: 71
Console.WriteLine( "DateDiff.Hours: {0}", dateDiff.Hours );
// > DateDiff.Hours: 11940
Console.WriteLine( "DateDiff.Minutes: {0}", dateDiff.Minutes );
// > DateDiff.Minutes: 716441
Console.WriteLine( "DateDiff.Seconds: {0}", dateDiff.Seconds );
// > DateDiff.Seconds: 42986489
// elapsed
Console.WriteLine( "DateDiff.ElapsedYears: {0}", dateDiff.ElapsedYears );
// > DateDiff.ElapsedYears: 1
Console.WriteLine( "DateDiff.ElapsedMonths: {0}", dateDiff.ElapsedMonths );
// > DateDiff.ElapsedMonths: 4
Console.WriteLine( "DateDiff.ElapsedDays: {0}", dateDiff.ElapsedDays );
// > DateDiff.ElapsedDays: 12
Console.WriteLine( "DateDiff.ElapsedHours: {0}", dateDiff.ElapsedHours );
// > DateDiff.ElapsedHours: 12
Console.WriteLine( "DateDiff.ElapsedMinutes: {0}", dateDiff.ElapsedMinutes );
// > DateDiff.ElapsedMinutes: 41
Console.WriteLine( "DateDiff.ElapsedSeconds: {0}", dateDiff.ElapsedSeconds );
// > DateDiff.ElapsedSeconds: 29
// description
Console.WriteLine( "DateDiff.GetDescription(1): {0}", dateDiff.GetDescription( 1 ) );
// > DateDiff.GetDescription(1): 1 Year
Console.WriteLine( "DateDiff.GetDescription(2): {0}", dateDiff.GetDescription( 2 ) );
// > DateDiff.GetDescription(2): 1 Year 4 Months
Console.WriteLine( "DateDiff.GetDescription(3): {0}", dateDiff.GetDescription( 3 ) );
// > DateDiff.GetDescription(3): 1 Year 4 Months 12 Days
Console.WriteLine( "DateDiff.GetDescription(4): {0}", dateDiff.GetDescription( 4 ) );
// > DateDiff.GetDescription(4): 1 Year 4 Months 12 Days 12 Hours
Console.WriteLine( "DateDiff.GetDescription(5): {0}", dateDiff.GetDescription( 5 ) );
// > DateDiff.GetDescription(5): 1 Year 4 Months 12 Days 12 Hours 41 Mins
Console.WriteLine( "DateDiff.GetDescription(6): {0}", dateDiff.GetDescription( 6 ) );
// > DateDiff.GetDescription(6): 1 Year 4 Months 12 Days 12 Hours 41 Mins 29 Secs
} // DateDiffSample
Dim intYears
Dim intMonths
Dim intDays
Dim strDate1
Dim strDate2
Dim strAnswer
strDate1 = "01/26/2010"
strDate2 = "02/15/2010"
intYears = DateDiff("yyyy",strDate1,strDate2)
intMonths = DateDiff("m",strDate1,strDate2)
intDays = DateDiff("d",strDate1,strDate2)
strAnswer = ""
if intYears > 0 then
strAnswer = strAnswer & CStr(intYears) & "years "
end if
if intMonths > 0 then
strAnswer = strAnswer & CStr(intMonths) & "months"
end if
if intDays > 0 then
strAnswer = strAnswer & CStr(intDays) & "days"
end if
Response.Write("The difference between these two dates is " & strAnswer)
Does anyone have a relative date/time from now to a natural/human for classic ASP function in VBScript? This is like Twitter.
Examples:
Less than 1 minute ago
About 5 minutes ago
About an hour ago
About 3 hours ago
Yesterday
Wednesday
etc.
This is the one I use. Pretty certain I just ripped it from Jeff's example that he used for this site.
Yes, yes I did: How can I calculate relative time in C#?
Function RelativeTime(dt)
Dim t_SECOND : t_SECOND = 1
Dim t_MINUTE : t_MINUTE = 60 * t_SECOND
Dim t_HOUR : t_HOUR = 60 * t_MINUTE
Dim t_DAY : t_DAY = 24 * t_HOUR
Dim t_MONTH : t_MONTH = 30 * t_DAY
Dim delta : delta = DateDiff("s", dt, Now)
Dim strTime : strTime = ""
If (delta < 1 * t_MINUTE) Then
If delta = 0 Then
strTime = "just now"
ElseIf delta = 1 Then
strTime = "one second ago"
Else
strTime = delta & " seconds ago"
End If
ElseIf (delta < 2 * t_MINUTE) Then
strTime = "a minute ago"
ElseIf (delta < 50 * t_MINUTE) Then
strTime = Max(Round(delta / t_MINUTE), 2) & " minutes ago"
ElseIf (delta < 90 * t_MINUTE) Then
strTime = "an hour ago"
ElseIf (delta < 24 * t_HOUR) Then
strTime = Round(delta / t_HOUR) & " hours ago"
ElseIf (delta < 48 * t_HOUR) Then
strTime = "yesterday"
ElseIf (delta < 30 * t_DAY) Then
strTime = Round(delta / t_DAY) & " days ago"
ElseIf (delta < 12 * t_MONTH) Then
Dim months
months = Round(delta / t_MONTH)
If months <= 1 Then
strTime = "one month ago"
Else
strTime = months & " months ago"
End If
Else
Dim years : years = Round((delta / t_DAY) / 365)
If years <= 1 Then
strTime = "one year ago"
Else
strTime = years & " years ago"
End If
End If
RelativeTime = strTime
End Function
taken from ajaxed
'here comes some global helpers...
public function sayDate(dat, mode, relativNotation)
if not isDate(dat) then
sayDate = "unknown"
exit function
end if
if relativNotation then
diff = dateDiff("s", dat, now())
if diff <= 10 and diff >= 0 then
sayDate = "Just now" : exit function
elseif diff < 60 and diff >= 0 then
sayDate = diff & " seconds ago" : exit function
elseif diff = 60 and diff >= 0 then
sayDate = diff & " minute ago" : exit function
elseif diff <= 1800 and diff >= 0 then
sayDate = int(diff / 60) & " minutes ago" : exit function
elseif diff < 86400 and diff >= 0 then
sayDate = plural(int(diff / 60 / 60), "hour", empty) & " ago"
else
if datevalue(dat) = date() then
sayDate = "Today"
elseif dateValue(dat) = dateAdd("d", 1, date()) then
sayDate = "Tomorrow"
elseif dateValue(dat) = dateAdd("d", -1, date()) then
sayDate = "Yesterday"
end if
end if
end if
if relativNotation and lCase(mode) = "datetime" and isEmpty(sayDate) then
diff = dateDiff("d", dat, now())
sayDate = plural(diff, "day", empty) & " ago"
exit function
end if
if isEmpty(sayDate) then
sayDate = day(dat) & ". " & monthname(month(dat), true)
if year(dat) <> year(now()) then sayDate = sayDate & " " & year(dat)
end if
if lCase(mode) <> "datetime" then exit function
if uBound(split(dat, " ")) <= 0 then exit function
'sayDate = sayDate & ", " & str.padLeft(hour(dat), 2, "0") & ":" & str.padLeft(minute(dat), 2, "0")
end function
public function plural(val, singularform, pluralform)
plural = singularform
if val <> 1 then plural = pluralform
if isEmpty(plural) then plural = singularform & "s"
plural = val & " " & plural
end function
I write my own function like this, could be found at http://asp.web.id/asp-classic-relative-date-function.html
it is used conversion asp date to unixtimestamp format and calculate the time margin. it is customizable you could also create relative date for upcoming date using this function.
DateAdd("n", -1, Now)
DateAdd("n", -5, Now)
DateAdd("h", -1, Now)
DateAdd("h", -3, Now)
DateAdd("d", -1, Date)
DateAdd("d", -1, Date)
Not sure about what you mean by Wednesday part.
Can you elaborate?