 links |
 rechts |
 zurück |
 vor |
 oben |
 unten |
DD-Software.Conversion.Misc
Add this page to your favorites
Save this document
|
|
|
DD382100.HTM DD-Software.Conversion.Misc Add this page to your favorites Save this document |
|
|
|
|
udfBcdToDec (hBB) |
;----------------------------------------------------------------------------------------
If ItemLocate("udfbcdtodec_",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfbcdtodec_
#DefineFunction udfBcdToDec_ (hBB)
; The BCD number is presented in a binary buffer.
; The String Version
sNumber = ""
iCount = BinaryEodGet(hBB)-2
For i=0 To iCount
iByte = BinaryPeek(hBB,i)
sNumber = StrCat(sNumber,iByte>>4) ; high nibble
sNumber = StrCat(sNumber,iByte&15) ; low nibble
Next
iByte = BinaryPeek(hBB,iCount+1)
sNumber = StrCat(sNumber,iByte>>4)
If ((iByte&15)==13) Then Return (0-sNumber)
Return (0+sNumber)
; This udf returns an integer value.
; Detlev Dalitz.20020131
#EndFunction
:skip_udfbcdtodec_
;----------------------------------------------------------------------------------------
If ItemLocate("udfbcdtodec",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfbcdtodec
#DefineFunction udfBcdToDec (hBB)
; The BCD number is presented in a binary buffer.
; The Number Version
iNumber = 0
iCount = BinaryEodGet(hBB)-2
For i=0 To iCount
iByte = BinaryPeek(hBB,i)
iNumber = (10*iNumber) + (iByte>>4) ; high nibble
iNumber = (10*iNumber) + (iByte&15) ; low nibble
Next
iByte = BinaryPeek(hBB,iCount+1)
inumber = (10*iNumber) + (iByte>>4)
If ((iByte&15)==13) Then Return (-iNumber)
Return (iNumber)
; This udf returns an integer value.
; Detlev Dalitz.20020131
#EndFunction
:skip_udfbcdtodec
;----------------------------------------------------------------------------------------
;--- test ---
:test1
; Poke decimal number -7 into buffer.
sNumber = "-7"
hBB = BinaryAlloc(1)
BinaryPoke(hBB,0,125)
Message("Demo udfBcdToDec (hBB) The String Version",StrCat(sNumber," = ",udfBcdToDec_(hBB)))
Message("Demo udfBcdToDec (hBB) The Number Version",StrCat(sNumber," = ",udfBcdToDec(hBB)))
BinaryFree(hBB)
:test2
; Poke decimal number -4321 into buffer.
sNumber = "-4321"
hBB = BinaryAlloc(3)
BinaryPoke(hBB,0,4)
BinaryPoke(hBB,1,50)
BinaryPoke(hBB,2,29)
Message("Demo udfBcdToDec (hBB) The String Version",StrCat(sNumber," = ",udfBcdToDec_(hBB)))
Message("Demo udfBcdToDec (hBB) The Number Version",StrCat(sNumber," = ",udfBcdToDec(hBB)))
BinaryFree(hBB)
:test3
; Poke decimal number +000050 into buffer.
sNumber = "+000050"
hBB = BinaryAlloc(4)
BinaryPoke(hBB,0,0)
BinaryPoke(hBB,1,0)
BinaryPoke(hBB,2,5)
BinaryPoke(hBB,3,12)
Message("Demo udfBcdToDec (hBB) The String Version",StrCat(sNumber," = ",udfBcdToDec_(hBB)))
Message("Demo udfBcdToDec (hBB) The Number Version",StrCat(sNumber," = ",udfBcdToDec(hBB)))
BinaryFree(hBB)
:test4
Display(1,"Demo udfBcdToDec (hBB)","Performance Test, please wait ...")
hBB = BinaryAlloc(3)
BinaryPoke(hBB,0,4)
BinaryPoke(hBB,1,50)
BinaryPoke(hBB,2,29)
loop = 100
Exclusive(@ON)
start = GetTickCount()
For i=1 To loop
iNumber = udfBcdToDec_(hBB)
Next
stop = GetTickCount()
StringTicks = stop-start
start = GetTickCount()
For i=1 To loop
iNumber = udfBcdToDec(hBB)
Next
stop = GetTickCount()
NumberTicks = stop-start
Exclusive(@OFF)
MaxTicks = Max(StringTicks,Numberticks)
StringPct = 100*StringTicks/MaxTicks
NumberPct = 100*NumberTicks/MaxTicks
MsgText = ""
MsgText = StrCat(MsgText,"StringTicks = ",@TAB,StringTicks,@TAB,StringPct," %%",@CRLF)
MsgText = StrCat(MsgText,"NumberTicks = ",@TAB,NumberTicks,@TAB,NumberPct," %%")
MsgTitle = "Demo udfBcdToDec (hBB) Performance Test"
Message(MsgTitle,MsgText)
BinaryFree(hBB)
Exit
;----------------------------------------------------------------------------------------
|
|
If you have questions about WinBatch, you are encouraged to use online WebBoard BBS at http://webboard.windowware.com
|
|
|
|
|
udfByteToHex (byte)
|
;------------------------------------------------------------------------------------------------------------------------------------------
; udfByteToHex_1 (Byte) ; 2002:08:31:08:02:28
; udfByteToHex_2 (Byte) ; 2002:08:31:08:02:28
; udfByteToHex_3 (Byte) ; 2002:08:31:08:02:28
; udfHexToNum (hexchar) ; 2002:08:31:08:02:28
; udfHexToByte (hexstr) ; 2002:08:31:08:02:28
; udfHexToDec (sHex) ; 2002:08:31:08:02:28
; udfHexToFloat (sHex) ; 2002:08:31:08:02:28
; udfDecToHex_1 (iDecimal) ; 2002:08:31:08:02:28
; udfDecToHex_2 (iDecimal) ; 2002:08:31:08:02:28
;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfByteToHex_1 (Byte)
HexChars = "0123456789ABCDEF"
h1 = StrSub(HexChars,1+(Byte>>4),1)
h2 = StrSub(HexChars,1+(Byte&15),1)
Return (StrCat(h1,h2))
; HexChars = "0123456789abcdef"
; Byte = 0..255
#EndFunction
#DefineFunction udfByteToHex_2 (Byte)
Return (StrCat(Num2Char((Byte>>4)+48+7*((Byte>>4)>9)),Num2Char((Byte&15)+48+7*((Byte&15)>9))))
; input Byte = 0..255
; returns uppercase HexChars = "0123456789ABCDEF"
#EndFunction
#DefineFunction udfByteToHex_3 (Byte)
Return (StrCat(Num2Char((Byte>>4)+48+39*((Byte>>4)>9)),Num2Char((Byte&15)+48+39*((Byte&15)>9))))
; input Byte = 0..255
; returns lowercase HexChars = "0123456789abcdef"
#EndFunction
#DefineFunction udfHexToNum (hexchar)
n = Char2Num(StrUpper(hexchar))-48
Return ((n-7*(n>9)))
#EndFunction
#DefineFunction udfHexToByte (hexstr)
hexstr = StrUpper(StrTrim(hexstr))
n1 = Char2Num(StrSub(hexstr,1,1))-48
n2 = Char2Num(StrSub(hexstr,2,1))-48
Return (((n1-7*(n1>9))<<4)+(n2-7*(n2>9)))
; note: must be StrLen(hexstr)=2
#EndFunction
#DefineFunction udfHexToDec (sHex)
sHexChars = "0123456789ABCDEF"
sHex = StrUpper(StrTrim(sHex))
iHexLen = StrLen(sHex)
iDec = 0
For iHex=1 To iHexLen
iDec = (iDec<<4)+StrIndex(sHexChars,StrSub(sHex,iHex,1),0,@FWDSCAN)-1
Next
Return (iDec)
; Note: Returned negative numbers are ok for use in WinBatch.
#EndFunction
#DefineFunction udfHexToFloat (sHex)
sHexChars = "0123456789ABCDEF"
sHex = StrUpper(StrTrim(sHex))
iHexLen = StrLen(sHex)
fDec = 0.0
For iHex=1 To iHexLen
fDec = (fDec*16)+StrIndex(sHexChars,StrSub(sHex,iHex,1),0,@FWDSCAN)-1
Next
Return (fDec)
; Note: Returned negative numbers are ok for use in WinBatch.
#EndFunction
#DefineFunction udfDecToHex_1 (iDecimal)
sHexChars = "0123456789ABCDEF"
sHex = ""
iZ = 1
For i=7 To 0 By -1
iN = (iDecimal>>(i*4))&15
If iN==0 && iZ==1 Then Continue
iZ = 0
sHex = StrCat(sHex,StrSub(sHexChars,iN+1,1))
Next
Return (sHex)
#EndFunction
#DefineFunction udfDecToHex_2 (iDecimal)
sHexChars = "0123456789ABCDEF"
sHex = ""
iZ = 1
For i=7 To 0 By -1
iN = (iDecimal>>(i*4))&15
If !iN Then If iZ Then Continue
iZ = 0
sHex = StrCat(sHex,StrSub(sHexChars,iN+1,1))
Next
Return (sHex)
#EndFunction
#DefineFunction udfDecToHex_3 (iDecimal, iPadLength, iCaseMode)
iPadLength = Min(8,Max(1,iPadLength))
If Max(0,Min(1,iCaseMode)) Then sHexChars = "0123456789ABCDEF"
Else sHexChars = "0123456789abcdef"
sHex = ""
iZ = 1
For i=7 To 0 By -1
iN = (iDecimal>>(i*4))&15
If !iN Then If iZ Then Continue
iZ = 0
sHex = StrCat(sHex,StrSub(sHexChars,iN+1,1))
Next
sHex = StrFixLeft(sHex,"0",iPadLength)
Return (sHex)
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------
;--- test ---
Message("Demo udfHexToNum (hexchar)" ,StrCat('What decimal number is "D" ?',@CRLF,udfHexToNum("D")))
Message("Demo udfByteToHex (byte)" ,StrCat('Who knows the magic of number 221?',@CRLF,udfByteToHex_2(221),' who else?'))
Message("Demo udfHexToByte (hexstr)" ,StrCat('What is the number of "DD"?',@CRLF,udfHexToByte('DD')))
Message("Demo udfHexToDec (hexstr)" ,StrCat("FF"," = ",Int(udfHexToDec("FF"))))
Message("Demo udfHexToDec (hexstr)" ,StrCat("F8000000"," = ",udfHexToDec("F8000000")))
Message("Demo udfHexToFloat (hexstr)",StrCat("F8000000"," = ",udfHexToFloat("F8000000")))
Message("Demo udfDecToHex (decimal)" ,StrCat("Who did first programming?",@CRLF,udfDecToHex_1(2778)))
:test_a1
hexstr = ""
Exclusive(@ON)
start=GetTickCount()
For byte=0 To 255
hexstr = StrCat(hexstr,udfByteToHex_1 (byte),",")
Next
stop=GetTickCount()
Exclusive(@OFF)
Ticks1=stop-start
Message("Demo udfByteToHex_1 (Byte)",hexstr)
:test_a2
hexstr = ""
Exclusive(@ON)
start=GetTickCount()
For byte=0 To 255
hexstr = StrCat(hexstr,udfByteToHex_2 (byte),",")
Next
stop=GetTickCount()
Exclusive(@OFF)
Ticks2=stop-start
Message("Demo udfByteToHex_2 (Byte)",hexstr)
:result_a
MaxTicks = Max(Ticks1,Ticks2)
msgtitle= "Demo udfByteToHex"
msgtext = StrCat("udfByteToHex_1",@TAB,"Ticks=",Ticks1,@TAB,100*Ticks1/MaxTicks,"%%",@CRLF)
msgtext = StrCat(msgtext,"udfByteToHex_2",@TAB,"Ticks=",Ticks2,@TAB,100*Ticks2/MaxTicks,"%%",@CRLF)
Message(msgtitle,msgtext)
:test_b1
; uses hexstr from test_a2
bytestr = ""
Exclusive(@ON)
start=GetTickCount()
For i=1 To 256
bytestr = StrCat(bytestr,udfHexToByte (ItemExtract(i,hexstr,",")),",")
Next
stop=GetTickCount()
Exclusive(@OFF)
Ticks1=stop-start
Message("Demo udfHexToByte (hexstr)",bytestr)
:test_b2
; uses hexstr from test_a2
bytestr = ""
Exclusive(@ON)
start=GetTickCount()
For i=1 To 256
bytestr = StrCat(bytestr,udfHexToDec (ItemExtract(i,hexstr,",")),",")
Next
stop=GetTickCount()
Exclusive(@OFF)
Ticks2=stop-start
Message("Demo udfHexToDec (hexstr)",bytestr)
:result_b
MaxTicks = Max(Ticks1,Ticks2)
msgtitle= "Demo udfHexToByte"
msgtext = StrCat("udfHexToByte",@TAB,"Ticks=",Ticks1,@TAB,100*Ticks1/MaxTicks,"%%",@CRLF)
msgtext = StrCat(msgtext,"udfHexToDec",@TAB,"Ticks=",Ticks2,@TAB,100*Ticks2/MaxTicks,"%%",@CRLF)
Message(msgtitle,msgtext)
:test_c1
Exclusive(@ON)
start=GetTickCount()
For i=1 To 20
sHex = udfDecToHex_1 (47618)
Next
stop=GetTickCount()
Exclusive(@OFF)
Ticks1=stop-start
Message("Demo udfDecToHex_1 (iDecimal)",sHex)
:test_c2
Exclusive(@ON)
start=GetTickCount()
For i=1 To 20
sHex = udfDecToHex_2 (47618)
Next
stop=GetTickCount()
Exclusive(@OFF)
Ticks2=stop-start
Message("Demo udfDecToHex_2 (iDecimal)",sHex)
:result_c
MaxTicks = Max(Ticks1,Ticks2)
msgtitle= "Demo udfDecToHex"
msgtext = StrCat("udfDecToHex_1",@TAB,"Ticks=",Ticks1,@TAB,100*Ticks1/MaxTicks,"%%",@CRLF)
msgtext = StrCat(msgtext,"udfDecToHex_2",@TAB,"Ticks=",Ticks2,@TAB,100*Ticks2/MaxTicks,"%%",@CRLF)
Message(msgtitle,msgtext)
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
|
|
If you have questions about WinBatch, you are encouraged to use online WebBoard BBS at http://webboard.windowware.com
|
|
|
|
|
udfColorRgbToHex (rgbitem)
|
If (ItemLocate("udfbytetohex",IntControl(77,103,0,0,0),@tab)>0) Then Goto skip_udfbytetohex
#DefineFunction udfByteToHex(Byte)
HexChars="0123456789abcdef"
h1=StrSub(HexChars,1+(Byte>>4),1)
h2=StrSub(HexChars,1+(Byte&15),1)
Return (StrCat(h1,h2))
;HexChars="0123456789ABCDEF"
#EndFunction
:skip_udfbytetohex
If (ItemLocate("udfhextodec",IntControl(77,103,0,0,0),@tab)>0) Then Goto skip_udfhextodec
#DefineFunction udfHexToDec(hexstr)
HexChars="0123456789abcdef"
hex=StrLower(StrTrim(hexstr))
hexlen=StrLen(hexstr)
dec=0.0
For x=1 To hexlen
dec=(dec*16.0)+StrIndex(HexChars,StrSub(hexstr,x,1),0,@fwdscan)-1
Next
Return (dec)
#EndFunction
:skip_udfhextodec
If (ItemLocate("udfcolorrgbtohex",IntControl(77,103,0,0,0),@tab)>0) Then Goto skip_udfcolorrgbtohex
#DefineFunction udfColorRgbToHex(rgbitem)
rgbitem = StrClean(rgbitem,"0123456789,%%","",@false,2)
r = ItemExtract(1,rgbitem,",")
g = ItemExtract(2,rgbitem,",")
b = ItemExtract(3,rgbitem,",")
rr = ItemExtract(1,r,"%%")
gg = ItemExtract(1,g,"%%")
bb = ItemExtract(1,b,"%%")
If (r==rr) Then r = Max(0,Min(255,r))
Else r = Max(0,Min(255,rr*255/100))
If (g==gg) Then g = Max(0,Min(255,g))
Else g = Max(0,Min(255,gg*255/100))
If (b==bb) Then b = Max(0,Min(255,b))
Else b = Max(0,Min(255,bb*255/100))
h1 = udfByteToHex(r)
h2 = udfByteToHex(g)
h3 = udfByteToHex(b)
Return (StrCat("#",h1,h2,h3))
; rgbitem is a string of rgb integer numbers in range 0..255 e.g. "171,205,239"
; rgbitem is a string of rgb percentage numbers in range 0%..100% e.g. "17%,20%,50%"
; DD.20010825,DD.20011211
#EndFunction
:skip_udfcolorrgbtohex
If (ItemLocate("udfcolorhextorgb",IntControl(77,103,0,0,0),@tab)>0) Then Goto skip_udfcolorhextorgb
#DefineFunction udfColorHexToRgb(hexitem, rgbprefixflag, threedigitsflag, percentflag)
rgbprefixflag = Max(@false,Min(@true,rgbprefixflag))
threedigitsflag = Max(@false,Min(@true,threedigitsflag))
percentflag = Max(@false,Min(@true,percentflag))
hexitem = StrLower(hexitem)
hexitem = StrClean(hexitem,"0123456789abcdef","",@false,2)
hexitem = StrFixleft(hexitem,"0",6)
r = Int(udfHexToDec(StrSub(hexitem,1,2)))
g = Int(udfHexToDec(StrSub(hexitem,3,2)))
b = Int(udfHexToDec(StrSub(hexitem,5,2)))
If percentflag
r = r*100/255
g = g*100/255
b = b*100/255
EndIf
If threedigitsflag
r = StrFixleft(r,"0",3)
g = StrFixleft(g,"0",3)
b = StrFixleft(b,"0",3)
EndIf
If percentflag
r = StrCat(r,"%%")
g = StrCat(g,"%%")
b = StrCat(b,"%%")
EndIf
rgbopen = ""
rgbclose = ""
If rgbprefixflag
rgbopen = "rgb("
rgbclose = ")"
EndIf
Return (StrCat(rgbopen,r,",",g,",",b,rgbclose))
; rgbprefixflag = 0 ==> numberstring "r,g,b"
; rgbprefixflag = 1 ==> with prefix and round brackets "rgb(r,g,b)"
; threedigitsflag = 0 ==> variable digits e.g. "r,gg,bbb"
; threedigitsflag = 1 ==> fixed length using three digit numbers "rrr,ggg,bbb"
; percentflag = 0 ==> color value as integer number in range 0..255
; percentflag = 1 ==> color value as percentage number with percent suffix
; DD.20010825,DD.20011211
#EndFunction
:skip_udfcolorhextorgb
;--- test ---
; note: double percent signs are used because of standard
; substitution feature in WinBatch programming language
rgbitem = "171,205,239"
Message(StrCat("Demo udfColorRgbToHex ( ",rgbitem," )"),udfColorRgbToHex(rgbitem))
rgbitem = "(171 , 205 , 239)"
Message(StrCat("Demo udfColorRgbToHex ( ",rgbitem," )"),udfColorRgbToHex(rgbitem))
rgbitem = "(10%% , 25%% , 50%%)"
Message(StrCat("Demo udfColorRgbToHex ( ",rgbitem," )"),udfColorRgbToHex(rgbitem))
rgbitem = "(010%%,025%%,050%%)"
Message(StrCat("Demo udfColorRgbToHex ( ",rgbitem," )"),udfColorRgbToHex(rgbitem))
hexitem = "#1B2D3F"
Message(StrCat("Demo udfColorHexToRgb ( ",hexitem," ,0,0,0)"),udfColorHexToRgb(hexitem,0,0,0))
Message(StrCat("Demo udfColorHexToRgb ( ",hexitem," ,0,0,1)"),udfColorHexToRgb(hexitem,0,0,1))
Message(StrCat("Demo udfColorHexToRgb ( ",hexitem," ,0,1,0)"),udfColorHexToRgb(hexitem,0,1,0))
Message(StrCat("Demo udfColorHexToRgb ( ",hexitem," ,0,1,1)"),udfColorHexToRgb(hexitem,0,1,1))
Message(StrCat("Demo udfColorHexToRgb ( ",hexitem," ,1,0,0)"),udfColorHexToRgb(hexitem,1,0,0))
Message(StrCat("Demo udfColorHexToRgb ( ",hexitem," ,1,0,1)"),udfColorHexToRgb(hexitem,1,0,1))
Message(StrCat("Demo udfColorHexToRgb ( ",hexitem," ,1,1,0)"),udfColorHexToRgb(hexitem,1,1,0))
Message(StrCat("Demo udfColorHexToRgb ( ",hexitem," ,1,1,1)"),udfColorHexToRgb(hexitem,1,1,1))
Exit
|
|
If you have questions about WinBatch, you are encouraged to use online WebBoard BBS at http://webboard.windowware.com
|
|
|
|
|
udfConvertToBase (num, base, width)
|
If ItemLocate("udfconverttobase",IntControl(77,103,0,0,0),@tab) Then Goto skip_udfconverttobase
#DefineFunction udfConvertToBase (num, base, width)
Terminate(VarType(num)<>1,"udfConvertToBase (num, base, width)","num must be integer")
Terminate(VarType(base)<>1,"udfConvertToBase (num, base, width)","base must be integer")
Terminate(VarType(width)<>1,"udfConvertToBase (num, base, width)","width must be integer")
Terminate((base<2)||(base>36),"udfConvertToBase (num, base, width)","base must be in range 2..36")
b = ""
While num
b = StrCat(StrSub("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ",1+(num mod base),1),b)
num = Int(num/base)
EndWhile
If (b=="") Then b = "0"
If width Then b = StrFixLeft(b,"0",width)
Return (b)
; Conf: WinBatch
; From: kdmoyers admin@guden.com
; Date: Thursday, December 27, 2001 12:50 PM
; Slightly modified by Detlev Dalitz.20020204
#EndFunction
:skip_udfconverttobase
If ItemLocate("udfconvertfrombase",IntControl(77,103,0,0,0),@tab) Then Goto skip_udfconvertfrombase
#DefineFunction udfConvertFromBase (str, base)
Terminate(VarType(str)<>2,"udfConvertFromBase (str, base)","str must be string")
Terminate(VarType(base)<>1,"udfConvertFromBase (str, base)","base must be integer")
Terminate((base<2)||(base>36),"udfConvertFromBase (str, base)","base must be in range 2..36")
b = 0
While (str>"")
x = StrIndex("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ",StrSub(str,1,1),1,0)
If ((x==0)||(x>base)) Then Return (-1)
b = (b*base)+(x-1)
str = StrSub(str,2,-1)
EndWhile
Return (b)
; Conf: WinBatch
; From: kdmoyers admin@guden.com
; Date: Thursday, December 27, 2001 12:50 PM
; Slightly modified by Detlev Dalitz.20020204
#EndFunction
:skip_udfconvertfrombase
;--- test ---
:test1
list = ""
OutStr = StrCat("Convert decimal number 100 to base b number ...",@crlf)
For b=2 To 36
item = udfConvertToBase(100,b,8)
list = ItemInsert(item,-1,list,@tab)
OutStr = StrCat(OutStr,"Base",@tab,b,@tab,item,@crlf)
Next
Message("Demo udfConvertToBase (num, base, width)",OutStr)
:test2
OutStr = StrCat("Convert number n from base b to decimal number ...",@crlf)
For b=2 To 36
item = ItemExtract(b-1,list,@tab)
OutStr = StrCat(OutStr,item,@tab,"Base",@tab,b,@tab,udfConvertFromBase(item,b),@crlf)
Next
Message("Demo udfConvertFromBase (str, base)",OutStr)
Exit
|
|
If you have questions about WinBatch, you are encouraged to use online WebBoard BBS at http://webboard.windowware.com
|
|
|
|
|
udfFileTimeCodeToYmdHms (iTimeCode)
|
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udffiletimecodetoymdhms",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udffiletimecodetoymdhms
#DefineFunction udfFileTimeCodeToYmdHms (iTimeCode)
iSecs = (iTimeCode&31)*2 ; start 0 uses 5
iMinutes = (iTimeCode>>5)&63 ; start 5 uses 6
iHours = (iTimeCode>>11)&31 ; start 11 uses 5
iDays = (iTimeCode>>16)&31 ; start 16 uses 5
iMonths = (iTimeCode>>21)&15 ; start 21 uses 4
iYear = (iTimeCode>>25)+1980 ; start 25 uses 6 1980 to 2043
sSecs = StrFixLeft(iSecs,0,2)
sMinutes = StrFixLeft(iMinutes,0,2)
sHours = StrFixLeft(iHours,0,2)
sDays = StrFixLeft(iDays,0,2)
sMonths = StrFixLeft(iMonths,0,2)
Return (StrCat(iYear,":",sMonths,":",sDays,":",sHours,":",sMinutes,":",sSecs))
;..........................................................................................................................................
; This Function "udfFileTimeCodeToYmdHms" returns a YmdHms DateTime string on a given FileTimeCode number.
;
; Conf: WinBatch Script Exchange
; From: Marty marty@winbatch.com
; Date: Saturday, April 21, 2001 07:54 PM
;..........................................................................................................................................
#EndFunction
:skip_udffiletimecodetoymdhms
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfymdhmstofiletimecode",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfymdhmstofiletimecode
#DefineFunction udfYmdHmsToFileTimeCode (sYmdHms)
iYear = ItemExtract(1,sYmdHms,":")
iMonths = ItemExtract(2,sYmdHms,":")
iDays = ItemExtract(3,sYmdHms,":")
iHours = ItemExtract(4,sYmdHms,":")
iMinutes = ItemExtract(5,sYmdHms,":")
iSecs = ItemExtract(6,sYmdHms,":")
Terminate(iYear<1980,"udfYmdHmsToFileTimeCode","Year out of range 1980..2043 (underflow)")
Terminate(iYear>2043,"udfYmdHmsToFileTimeCode","Year out of range 1980..2043 (overflow)")
iCode = 0
iCode = iCode+(iSecs/2)
iCode = iCode|(iMinutes<<5)
iCode = iCode|(iHours<<11)
iCode = iCode|(iDays<<16)
iCode = iCode|(iMonths<<21)
iCode = iCode|((iYear-1980)<<25)
Return (iCode)
;..........................................................................................................................................
; This Function "udfYmdHmsToFileTimeCode" returns a FileTimeCode number on a given YmdHms DateTime string..
;
; Conf: WinBatch Script Exchange
; From: Marty marty@winbatch.com
; Date: Saturday, April 21, 2001 07:54 PM
;..........................................................................................................................................
#EndFunction
:skip_udfymdhmstofiletimecode
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
; Note:
; Differences between this filetime and that filetime can rely on ...
; 1. NTFS file systems can have more accurate file times than DOS systems (Granularity: DOS: 2 secs, NTFS: 1 sec).
; 2. FAT and FAT32 partitions have a file time resolutions of 2 seconds.
; 3. WinBatch uses 1 second resolution on NTFS systems.
; 4. No matter what the source, the resolution of FileTimeCode is 2 seconds, as it is based on a DOS timestamp.
; 5. You don't need FileTimeCode, as FileYmdHms values are directly comparable with standard comparison operators.
; 6. When you get a filetime in FileTimeCode format the time is truncated to an even second.
; 7. When you get a filetime of any kind off a FAT or FAT32 volume, it is *always* an even number of seconds.
; 8. A FileYmdHms() off a NTFS volume will give you 1 second resolution.
; A FileTimeCode off a NTFS volume will lose the odd second if any.
; So...basically 50% of the time the numbers will disagree.
; 9. Conversion script in separate message.
; 10. No bug. Thats just the way it is.
;------------------------------------------------------------------------------------------------------------------------------------------
;--- test ---
sFilename = StrCat(DirHome(),"WinBatch.exe")
iTimeCode = FileTimeCode(sFilename)
sYmdHms = FileYmdHms(sFilename)
sTestYmdHms = udfFileTimeCodeToYmdHms(iTimeCode)
iTestTimeCode = udfYmdHmsToFileTimeCode(sYmdHms)
sMsgTitle = "Demo: udfFileTimeCodeToYmdHms (iTimeCode) / udfYmdHmsToFileTimeCode (sYmdHms)"
sMsgText = ""
sMsgText = StrCat(sMsgText,'Filename', @TAB,@TAB,@TAB,@TAB,@TAB,'= ',sFilename,@CRLF,@CRLF)
sMsgText = StrCat(sMsgText,'FileTimeCode (Filename)',@TAB,@TAB,@TAB,'= ',iTimeCode,@CRLF)
sMsgText = StrCat(sMsgText,'FileYmdHms (Filename)', @TAB,@TAB,@TAB,'= ',sYmdHms,@CRLF,@CRLF)
sMsgText = StrCat(sMsgText,'udfFileTimeCodeToYmdHms (',iTimeCode,')',@TAB,@TAB,'= ',sTestYmdHms,@CRLF)
sMsgText = StrCat(sMsgText,'udfYmdHmsToFileTimeCode ("',sYmdHms,'")',@TAB,'= ',iTestTimeCode)
Message(sMsgTitle,sMsgText)
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
*EOF*
|
|
If you have questions about WinBatch, you are encouraged to use online WebBoard BBS at http://webboard.windowware.com
|
|
|
|
|
udfIPtoDec (ipstr) |
If itemlocate("udfiptodec", IntControl(77,103,0,0,0), @tab) then goto skip_udfiptodec
#DefineFunction udfIPtoDec (ipstr)
ipdec = 0.0
For i=1 to 4
ipdec = (256.0 * ipdec) + ItemExtract(i,ipstr,".")
Next
Return (ipdec)
;parameter ipstr must be a valid ip number string of format "n.n.n.n" with n=0..255
;DD.20011014
#EndFunction
:skip_udfiptodec
;--- test ---
ipstr1 = "10.12.11.1"
ipstr2 = "127.0.0.1"
ipstr3 = "255.255.255.255"
for i=1 to 3
ipdec = udfIPtoDec(ipstr%i%)
message("Demo udfIPtoDec", StrCat("IP = ",ipstr%i%,@crlf,"dec =",ipdec))
next
Exit
|
|
If you have questions about WinBatch, you are encouraged to use online WebBoard BBS at http://webboard.windowware.com
|
|
|
|
|
Number to Words Conversion Functions |
;==============================================================================================================================================================
; udfNumberToWords (Amount, FirstCharUp, Sign, Fraction, Delimiter, Currency) ; Returns string for mortgage or financial purposes
; udfNumberToShortWords (Number, Delimiter)
;==============================================================================================================================================================
; Detlev Dalitz.20010325.20010621.20010717
;==============================================================================================================================================================
;--------------------------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfsaynoyes",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfsaynoyes
#DefineFunction udfSayNoYes(bool) ; returns string "No" or "Yes" ; for test purposes
NoYesArray = Arrayize("Nein,Ja",",")
;NoYesArray = Arrayize("No,Yes",",")
Return (NoYesArray[bool])
#EndFunction
:skip_udfsaynoyes
;--------------------------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfnumbertoshortwords",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfnumbertoshortwords
#DefineFunction udfNumberToShortWords (Number, Delimiter)
If (number=="") Then Return ("")
If !IsNumber(number) Then Return ("")
NumberIsNegative = (Number<0)
NumberArr = Arrayize("zero|one|two|three|four|five|six|seven|eight|nine","|")
DecimalPoint = "."
DecimalText = "point"
Minus = "negative"
num1 = ItemExtract(1,Number,DecimalPoint)
num2 = ItemExtract(2,Number,DecimalPoint)
len1 = StrLen(num1)
len2 = StrLen(num2)
NumberStr = ""
If NumberIsNegative Then NumberStr = ItemInsert(Minus,1,NumberStr,Delimiter)
For i=1+NumberIsNegative To len1
NumberStr = ItemInsert(NumberArr[StrSub(num1,i,1)],-1,NumberStr,Delimiter)
Next
If (len2 > 0)
NumberStr = ItemInsert(DecimalText,-1,NumberStr,Delimiter)
For i=1 To len2
NumberStr = ItemInsert(NumberArr[StrSub(num2,i,1)],-1,NumberStr,Delimiter)
Next
EndIf
NumberStr = ItemInsert(StrCat(Delimiter,Delimiter),0,NumberStr,Delimiter)
NumberStr = ItemInsert(StrCat(Delimiter,Delimiter),-1,NumberStr,Delimiter)
Return (numberstr)
; For using german language replace statements above
; NumberArr = Arrayize("null|eins|zwei|drei|vier|fuenf|sechs|sieben|acht|neun","|") ; german
; DecimalPoint = ","
; DecimalText = "komma"
; Minus = "minus"
#EndFunction
:skip_udfnumbertoshortwords
;--------------------------------------------------------------------------------------------------------------------------------------------------------------
If (ItemLocate("udfntowrecursion",IntControl(77,103,0,0,0),@TAB)>0) Then Goto skip_udfntowrecursion
#DefineFunction udfNtoWRecursion(R, M, WW, EW, DW, Delimiter)
If (R==0) Then Return (WW[0])
t=""
If (R>=1000) Then t=StrCat(udfNtoWRecursion(R/1000,M+1,WW,EW,DW,Delimiter),StrCat(WW[2+M],Delimiter))
R=R mod 1000
h=R/100
d=(R mod 100)/10
e=R mod 10
If (h>0)
t=StrCat(t,EW[h],Delimiter)
t=StrCat(t,WW[1],Delimiter)
EndIf
If ((d<=1)&&(e>0))
t=StrCat(t,EW[(d*10)+e])
If ((d==0)&&(e==1)&&(M==0)) Then t=StrCat(t,"s")
t=StrCat(t,Delimiter)
Else
If (e>0) Then t=StrCat(t,EW[e],Delimiter);
If ((d*e)>0) Then t=StrCat(t,WW[4],Delimiter);
If (d>0) Then t=StrCat(t,DW[d],Delimiter);
EndIf
Return (t)
#EndFunction
:skip_udfntowrecursion
;--------------------------------------------------------------------------------------------------------------------------------------------------------------
If (ItemLocate("udfnumbertowords",IntControl(77,103,0,0,0),@TAB)>0) Then Goto skip_udfnumbertowords
#DefineFunction udfNumberToWords (Amount, FirstCharUp, Sign, Fraction, Delimiter, Currency)
; returns string for mortgage or financial purposes
; FirstCharUp=0=no ; FirstCharUp=1=yes
; Sign=0=no ; Sign=1=yes if negative
; Fraction=0=no ; Fraction=1=yes auto-zerosuppress
; Delimiter=String e.g. " " or "" or "_"
; Currency=String e.g. "DM" or "USD" or "US-Dollar or "Euro"
;
WW = ArrDimension(5)
Arr = Arrayize("null,hundert,tausend,millionen,und",",")
For i=0 To 4
WW[i] = Arr[i]
Next
Drop(Arr)
EW = ArrDimension(20)
Arr = Arrayize(",ein,zwei,drei,vier,fuenf,sechs,sieben,acht,neun,zehn,elf,zwoelf,dreizehn,vierzehn,fuenfzehn,sechzehn,siebzehn,achtzehn,neunzehn",",")
For i=0 To 19
EW[i] = Arr[i]
Next
Drop(Arr)
DW = ArrDimension(10)
Arr = Arrayize(",zehn,zwanzig,dreissig,vierzig,fuenfzig,sechzig,siebzig,achtzig,neunzig",",")
For i=0 To 9
DW[i] = Arr[i]
Next
Drop(Arr)
CurrencyExist = (Currency<>"")
AmountIsNegative = (Amount<0)
Amount = Fabs(Amount)
AmountFloor = Int(Floor(Amount))
Dividend = Amount - AmountFloor
Dividend = ItemExtract(2,Dividend,".")
Divisor = 100
NumberStr = udfNtoWRecursion(AmountFloor, 0, WW, EW, DW, Delimiter)
NumberStrLen = StrLen(NumberStr)
If (StrSub(NumberStr,NumberStrLen,1)==Delimiter)
NumberStr = StrSub(NumberStr,1,NumberStrLen-1) ; remove last Delimiter
EndIf
If (FirstCharUp||Sign||Fraction||CurrencyExist)
Select 1
Case FirstCharUp
NumberStr = StrCat(StrUpper(StrSub(NumberStr,1,1)), StrSub(NumberStr,2,-1))
Continue
Case Sign
If AmountIsNegative Then NumberStr = StrCat("minus*",NumberStr)
Continue
Case CurrencyExist
NumberStr = StrCat (NumberStr,"*",Currency)
Continue
Case Fraction
If (Dividend>0) Then NumberStr = StrCat(NumberStr,"*",Dividend,"/",Divisor)
Continue
EndSelect
NumberStr = StrCat("***",NumberStr,"***")
EndIf
Return (NumberStr)
#EndFunction
:skip_udfnumbertowords
;--------------------------------------------------------------------------------------------------------------------------------------------------------------
; --- test ---
oldDecimals = Decimals(2)
While 1
OutStr = ""
; generate Testnumber
BetragAlt = 0
While @TRUE
Betrag = 1.0 * Random(999) * Random(999)* Random(999) * (Random(2) - 1) / 100
If (Betrag>=1E9) Then Continue
If (BetragAlt==Betrag) Then Continue
BetragAlt = Betrag
Break
EndWhile
OutStr = StrCat(OutStr,"Betrag = ",Betrag,@CRLF,@CRLF,@CRLF)
:test1
OutStr = StrCat(OutStr,"NumberToShortWords (Number, Delimiter)",@CRLF)
zeile = udfNumberToShortWords(Betrag,"*")
OutStr = StrCat(OutStr,@CRLF,zeile,@CRLF,@CRLF,@CRLF)
:test2
OutStr = StrCat(OutStr,"udfNumberToWords (Amount, FirstCharUp, Sign, Fraction, Delimiter, Currency)",@CRLF,@CRLF)
FirstCharUp=1
Sign=1
Fraction=1
Delimiter="|"
Currency="DM"
zeile = udfNumberToWords(Betrag,FirstCharUp,Sign,Fraction,Delimiter,Currency)
OutStr = StrCat(OutStr,'FirstCharUp=',udfSayNoYes(FirstCharUp),', Sign=',udfSayNoYes(Sign),', Fraction=',udfSayNoYes(Fraction))
OutStr = StrCat(OutStr,', Delimiter="',Delimiter,'", Currency="',Currency,'"',@CRLF,zeile,@CRLF,@CRLF)
FirstCharUp=@TRUE
Sign=0
Fraction=@TRUE
Delimiter=" "
Currency="DM"
zeile = udfNumberToWords(Betrag,FirstCharUp,Sign,Fraction,Delimiter,Currency)
OutStr = StrCat(OutStr,'FirstCharUp=',udfSayNoYes(FirstCharUp),', Sign=',udfSayNoYes(Sign),', Fraction=',udfSayNoYes(Fraction))
OutStr = StrCat(OutStr,', Delimiter="',Delimiter,'", Currency="',Currency,'"',@CRLF,zeile,@CRLF,@CRLF)
FirstCharUp=@TRUE
Sign=@TRUE
Fraction=@FALSE
Delimiter=""
Currency="US-Dollar"
zeile = udfNumberToWords(Betrag,FirstCharUp,Sign,Fraction,Delimiter,Currency)
OutStr = StrCat(OutStr,'FirstCharUp=',udfSayNoYes(FirstCharUp),', Sign=',udfSayNoYes(Sign),', Fraction=',udfSayNoYes(Fraction))
OutStr = StrCat(OutStr,', Delimiter="',Delimiter,'", Currency="',Currency,'"',@CRLF,zeile,@CRLF,@CRLF)
FirstCharUp=@FALSE
Sign=@TRUE
Fraction=@TRUE
Delimiter=""
Currency="Euro"
zeile = udfNumberToWords(Betrag,FirstCharUp,Sign,Fraction,Delimiter,Currency)
OutStr = StrCat(OutStr,'FirstCharUp=',udfSayNoYes(FirstCharUp),', Sign=',udfSayNoYes(Sign),', Fraction=',udfSayNoYes(Fraction))
OutStr = StrCat(OutStr,', Delimiter="',Delimiter,'", Currency="',Currency,'"',@CRLF,zeile,@CRLF,@CRLF)
FirstCharUp=@FALSE
Sign=@FALSE
Fraction=@FALSE
Delimiter=""
Currency=""
zeile = udfNumberToWords(Betrag,FirstCharUp,Sign,Fraction,Delimiter,Currency)
OutStr = StrCat(OutStr,'FirstCharUp=',udfSayNoYes(FirstCharUp),', Sign=',udfSayNoYes(Sign),', Fraction=',udfSayNoYes(Fraction))
OutStr = StrCat(OutStr,', Delimiter="',Delimiter,'", Currency="',Currency,'"',@CRLF,zeile,@CRLF,@CRLF)
Pause("Zahlen in Worte",OutStr)
EndWhile
:CANCEL
Decimals(oldDecimals)
Exit
;--------------------------------------------------------------------------------------------------------------------------------------------------------------
|
|
If you have questions about WinBatch, you are encouraged to use online WebBoard BBS at http://webboard.windowware.com
|
|
|
|
|
udfRoundBy (Number, Round) |
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfroundby",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfroundby
#DefineFunction udfRoundBy (Number, Round)
Return (Round*Int((0.0+Number)/Round))
; DD.20010724
#EndFunction
:skip_udfroundby
;------------------------------------------------------------------------------------------------------------------------------------------
;--- test ---
sOut = ""
sOut = StrCat(sOut,"1494 rounded by 10 ",@TAB," = ",udfRoundBy(1494,10),@LF)
sOut = StrCat(sOut,"1494 rounded by 100 ",@TAB," = ",udfRoundBy(1494,100),@LF)
sOut = StrCat(sOut,"1494 rounded by 1000 ",@TAB," = ",udfRoundBy(1494,1000),@LF)
sOut = StrCat(sOut,"1511 rounded by 10 ",@TAB," = ",udfRoundBy(1511,10),@LF)
sOut = StrCat(sOut,"1511 rounded by 100 ",@TAB," = ",udfRoundBy(1511,100),@LF)
sOut = StrCat(sOut,"1511 rounded by 1000 ",@TAB," = ",udfRoundBy(1511,1000),@LF)
sOut = StrCat(sOut,"2479 rounded by 1000 ",@TAB," = ",udfRoundBy(2479,1000),@LF)
sOut = StrCat(sOut,"2749 rounded by 1000 ",@TAB," = ",udfRoundBy(2749,1000),@LF)
sOut = StrCat(sOut,"234 rounded by 7 ",@TAB," = ",udfRoundBy(234,7),@LF)
sOut = StrCat(sOut,"235 rounded by 7 ",@TAB," = ",udfRoundBy(235,7),@LF)
Message("Demo udfRoundBy (number, round)",sOut)
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
*EOF*
|
|
If you have questions about WinBatch, you are encouraged to use online WebBoard BBS at http://webboard.windowware.com
|
|
|
|
|
udfStrROT13 (sString) |
;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfStrROT13_4 (sString)
sROT13 = ""
iStrLen = StrLen(sString)
For ii=1 To iStrLen
sChar = StrSub(sString,ii,1)
iC = Char2Num(sChar)
iB = 64^iC & 223
If iB && iB<27 Then sROT13 = StrCat(sROT13,Num2Char((iC&96|(iB+12)mod 26)+1))
Else sROT13 = StrCat(sROT13,sChar)
Next
Return (sROT13)
;..........................................................................................................................................
; This udf accepts a string and returns the ROT-13 encoded/decoded string.
; For example `ABC 123 xyz` becomes `NOP 123 klm` and vice-versa.
; Algorithm adapted from C source, origin of <fine@cis.ohio-state.edu> Thomas A. Fine, Ohio State University,
; Department of Computer and Information Science, 2036 Neil Avenue Mall, Columbus, Ohio 43210, USA.
;
; Detlev Dalitz.20031021.
;..........................................................................................................................................
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfStrROT13_3 (sString)
sLower = "abcdefghijklmnopqrstuvwxyz"
sUpper = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
sROTLower = "nopqrstuvwxyzabcdefghijklm"
sROTUpper = "NOPQRSTUVWXYZABCDEFGHIJKLM"
iStrLen = StrLen(sString)
sROT13 = ""
For i=1 To iStrLen
sChar = StrSub(sString,i,1)
iPos = StrScan(sLower,sChar,1,@FWDSCAN)
If iPos
sROT13 = StrCat(sROT13,StrSub(sROTLower,iPos,1))
Else
iPos = StrScan(sUpper,sChar,1,@FWDSCAN)
If iPos
sROT13 = StrCat(sROT13,StrSub(sROTUpper,iPos,1))
Else
sROT13 = StrCat(sROT13,sChar)
EndIf
EndIf
Next
Return (sROT13)
;..........................................................................................................................................
; This udf accepts a string and returns the ROT-13 encoded/decoded string.
; For example `ABC 123 xyz` becomes `NOP 123 klm` and vice-versa.
; Algorithm adapted from "http://www.ericphelps.com/scripting/"
; Modified by Detlev Dalitz.20020625.20020808.20030207
;..........................................................................................................................................
; See also: ROT13 translation with "udfStrTranslate (sString, sTableIn, sTableOut, sPad)"
;..........................................................................................................................................
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfStrROT13_2 (sString)
sLower = "abcdefghijklmnopqrstuvwxyz"
sUpper = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
iStrLen = StrLen(sString)
sROT13 = ""
For i=1 To iStrLen
sChar = StrSub(sString,i,1)
iPos = StrScan(sLower,sChar,1,@FWDSCAN)
If iPos
iPos = iPos+13
If (iPos>26) Then iPos = iPos-26
sROT13 = StrCat(sROT13,StrSub(sLower,iPos,1))
Else
iPos = StrScan(sUpper,sChar,1,@FWDSCAN)
If iPos
iPos = iPos+13
If (iPos>26) Then iPos = iPos-26
sROT13 = StrCat(sROT13,StrSub(sUpper,iPos,1))
Else
sROT13 = StrCat(sROT13,sChar)
EndIf
EndIf
Next
Return (sROT13)
;..........................................................................................................................................
; This udf accepts a string and returns the ROT-13 encoded/decoded string.
; For example `ABC 123 xyz` becomes `NOP 123 klm` and vice-versa.
; Algorithm adapted from "http://www.ericphelps.com/scripting/"
; Modified by Detlev Dalitz.20020625.20020808.20030207
;..........................................................................................................................................
; See also: ROT13 translation with "udfStrTranslate (sString, sTableIn, sTableOut, sPad)"
;..........................................................................................................................................
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfStrROT13_1 (sString)
sLower = "abcdefghijklmnopqrstuvwxyzabcdefghijklm"
sUpper = "ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLM"
iStrLen = StrLen(sString)
sROT13 = ""
For i=1 To iStrLen
sChar = StrSub(sString,i,1)
iPos = StrScan(sLower,sChar,1,@FWDSCAN)
If iPos
sROT13 = StrCat(sROT13,StrSub(sLower,iPos+13,1))
Else
iPos = StrScan(sUpper,sChar,1,@FWDSCAN)
If iPos
sROT13 = StrCat(sROT13,StrSub(sUpper,iPos+13,1))
Else
sROT13 = StrCat(sROT13,sChar)
EndIf
EndIf
Next
Return (sROT13)
;..........................................................................................................................................
; This udf accepts a string and returns the ROT-13 encoded/decoded string.
; For example `ABC 123 xyz` becomes `NOP 123 klm` and vice-versa.
; Algorithm adapted from "http://www.ericphelps.com/scripting/"
; Modified by Detlev Dalitz.20020625.20020808
;..........................................................................................................................................
; See also: ROT13 translation with "udfStrTranslate (sString, sTableIn, sTableOut, sPad)"
;..........................................................................................................................................
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------
; --- test ---
sString = "# ABC -- WinBatch rotates *You* -- XYZ !"
iTest=4
iLoop=10
For t=1 To iTest
Exclusive(@ON)
iStart=GetTickCount()
For i=1 To iLoop
sRot = udfStrRot13_%t%(sString) ; "# NOP -- JvaOngpu ebgngrf *Lbh* -- KLM !"
sRotRot = udfStrRot13_%t%(sRot) ; "# ABC -- WinBatch rotates *You* -- XYZ !"
Next
iStop=GetTickCount()
Exclusive(@OFF)
iTicks%t%=iStop-iStart
Next
:Result
iMax=0
For t=1 To iTest
iMax = Max(iMax,iTicks%t%)
Next
For t=1 To iTest
iPct%t% = 100*iTicks%t%/iMax
Next
sMsgTitle="Demo Performance Test udfStrROT13 (sString)"
sMsgText=""
For t=1 To iTest
sMsgText = StrCat(sMsgText,"Test ",t,@TAB,iTicks%t%,@TAB,iPct%t%,"%%",@LF)
Next
Message(sMsgTitle,sMsgText)
ClipPut(sMsgText)
; in WinBatch Studio Debug Mode
; Test 1 55555 78%
; Test 2 70576 100%
; Test 3 55715 78%
; Test 4 31114 44%
; in WinBatch Studio Run Mode
; Test 1 5635 81%
; Test 2 6950 100%
; Test 3 5620 80%
; Test 4 3855 55%
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
;*EOF*
|
|
If you have questions about WinBatch, you are encouraged to use online WebBoard BBS at http://webboard.windowware.com
|
|
|
|
|
udflib SwapIntelToNetware Functions |
;==========================================================================================================================================
; Swap Netware To Intel resp. Intel to Netware datastructures Detlev Dalitz.20010713.20020915
;==========================================================================================================================================
; udfNWdoubleHtoN (Byte4) ; 2002:09:15:17:16:03
; udfNWdoubleNtoH (Byte4) ; 2002:09:15:17:16:03
; udfNWwordHtoN (Byte2) ; 2002:09:15:17:16:03
; udfNWwordNtoH (Byte2) ; 2002:09:15:17:16:03
;------------------------------------------------------------------------------------------------------------------------------------------
; udfDecToHex (iDecimal) ; 2002:09:15:17:16:03
; udfHexToDec (sHex) ; 2002:09:15:17:16:03
;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfNWdoubleHtoN (Byte4)
; Netware swap double word host to network
bb=BinaryAlloc(8)
BinaryPoke4(bb,0,Byte4)
BinaryPoke4(bb,4,Byte4)
BinaryCopy(bb,0,bb,2,2)
BinaryCopy(bb,6,bb,4,2)
BinaryCopy(bb,3,bb,5,2)
dhton=BinaryPeek4(bb,1)
BinaryFree(bb)
Return (dhton)
#EndFunction
#DefineFunction udfNWdoubleNtoH (Byte4)
; Netware swap double word network to host
bb=BinaryAlloc(8)
BinaryPoke4(bb,0,Byte4)
BinaryPoke4(bb,4,Byte4)
BinaryCopy(bb,0,bb,2,2)
BinaryCopy(bb,6,bb,4,2)
BinaryCopy(bb,3,bb,5,2)
dntoh=BinaryPeek4(bb,1)
BinaryFree(bb)
Return (dntoh)
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfNWwordHtoN (Byte2)
; Netware swap word host to network
bb=BinaryAlloc(4)
BinaryPoke2(bb,0,Byte2)
BinaryPoke2(bb,2,Byte2)
whton=BinaryPeek2(bb,1)
BinaryFree(bb)
Return (whton)
#EndFunction
#DefineFunction udfNWwordNtoH (Byte2)
; Netware swap word network to host
bb=BinaryAlloc(4)
BinaryPoke2(bb,0,Byte2)
BinaryPoke2(bb,2,Byte2)
wntoh=BinaryPeek2(bb,1)
BinaryFree(bb)
Return (wntoh)
#EndFunction
;==========================================================================================================================================
#DefineFunction udfDecToHex (iDecimal)
sHex = ""
iZ = 1
For i=7 To 0 By -1
iN = (iDecimal>>(i*4))&15
If !iN Then If iZ Then Continue
iZ = 0
sHex = StrCat(sHex,StrSub("0123456789ABCDEF",iN+1,1))
Next
Return (sHex)
#EndFunction
#DefineFunction udfHexToDec (sHex)
sHexChars = "0123456789ABCDEF"
sHex = StrUpper(StrTrim(sHex))
iHexLen = StrLen(sHex)
iDec = 0
For iHex=1 To iHexLen
iDec = (iDec<<4)+StrIndex(sHexChars,StrSub(sHex,iHex,1),0,@FWDSCAN)-1
Next
Return (iDec)
; Note: Returned negative numbers are ok for use in WinBatch.
#EndFunction
;==========================================================================================================================================
; --- test ---
intel2 = "0D0A"
byte2 = udfHexToDec(intel2)
byte2 = udfNWwordNtoH(Byte2)
netware2 = udfDecToHex(byte2)
intel4 = "11223344"
byte4 = udfHexToDec(intel4)
byte4 = udfNWdoubleNtoH(Byte4)
netware4 = udfDecToHex(byte4)
Exit
;==========================================================================================================================================
*EOF*
|
|
If you have questions about WinBatch, you are encouraged to use online WebBoard BBS at http://webboard.windowware.com
|
|
|
|
|
udfStrEncode64 (sString)
|
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstrencode64",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfstrencode64
#DefineFunction udfStrEncode64 (sString)
iLen = StrLen(sString)
If !iLen Then Return ("")
sCodes64 = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz+/"
sResult = ""
a = 0
b = 0
For i=1 To iLen
x = Char2Num(StrSub(sString,i,1))
b = b * 256 + x
a = a + 8
While (a > 5)
a = a - 6
x = b / (1 << a)
b = b mod (1 << a)
sResult = StrCat(sResult,StrSub(sCodes64,x+1,1))
EndWhile
Next
If a > 0
x = b << (6 - a)
sResult = StrCat(sResult,StrSub(sCodes64,x+1,1))
EndIf
Return (sResult)
;..........................................................................................................................................
; This Function "udfStrEncode64" returns the encoded string.
; Adapted from a Pascal Source written by Yurii Zhukow.
;
; Detlev Dalitz.20030203
;..........................................................................................................................................
#EndFunction
:skip_udfstrencode64
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstrdecode64",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfstrdecode64
#DefineFunction udfStrDecode64 (sString)
iLen = StrLen(sString)
If !iLen Then Return ("")
sCodes64 = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz+/"
sResult = ""
a = 0
b = 0
For i=1 To iLen
x = StrIndex(sCodes64,StrSub(sString,i,1),1,@FWDSCAN) - 1
If (x < 0) Then Break
b = b * 64 + x
a = a + 6
If (a < 8) Then Continue
a = a - 8
x = b >> a
b = b mod (1 << a)
x = x mod 256
sResult = StrCat(sResult,Num2Char(x))
Next
Return (sResult)
;..........................................................................................................................................
; This Function "udfStrDecode64" returns the decoded string.
; Adapted from a Pascal Source written by Yurii Zhukow.
;
; Detlev Dalitz.20030203
;..........................................................................................................................................
#EndFunction
:skip_udfstrdecode64
;------------------------------------------------------------------------------------------------------------------------------------------
; --- test ---
sString = "Encode64 Decode64 Test"
sResult = udfStrEncode64(sString) ; "HMvZRsHbDZGWH6LZRsHbDZGWL6LpT0"
sString = sResult
sResult = udfStrDecode64(sString) ; "Encode64 Decode64 Test"
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
*EOF*
|
|
If you have questions about WinBatch, you are encouraged to use online WebBoard BBS at http://webboard.windowware.com
|
|
|
|
|
udfIPToHex (sIPString)
|
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfiptohex_2",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfiptohex_2
#DefineFunction udfIPToHex_2 (sIP)
iHigh = ItemCount(sIP,".")
hBB = BinaryAlloc(iHigh)
iHigh = iHigh - 1
For i=0 To iHigh
BinaryPoke(hBB,i,ItemExtract(i+1,sIP,"."))
Next
sHex = BinaryPeekHex(hBB,0,4)
BinaryFree(hBB)
Return (sHex)
;..........................................................................................................................................
; This Function "udfIPToHex" returns a string, that contains the
; uppercase hexadecimal representation of an ip number string.
;
; Example:
; sIP = "192.168.15.31" ; Must be a valid IP number string.
; returns:
; sHex = "C0A80F1F"
;
; Detlev Dalitz.20030630
;..........................................................................................................................................
#EndFunction
:skip_udfiptohex_2
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udhextoip_2",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udhextoip_2
#DefineFunction udfHexToIP_2 (sHex)
sIP = ""
iHigh = (1+StrLen(sHex))/2
hBB = BinaryAlloc(iHigh)
BinaryPokeHex(hBB,0,sHex)
iHigh = iHigh - 1
For i=0 To iHigh
sIP = ItemInsert(BinaryPeek(hBB,i),-1,sIP,".")
Next
BinaryFree(hBB)
Return (sIP)
;..........................................................................................................................................
; This Function "udfHexToIP" returns a string, that contains the
; IP number representation of a hexadecimal string.
;
; Example:
; sHex = "c0a80f1f" ; Must be a valid hexstring that can be translated into ip numberstring.
; returns:
; sIP = "192.168.15.31"
;
; Detlev Dalitz.20030630
;..........................................................................................................................................
#EndFunction
:skip_udhextoip_2
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfiptohex",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfiptohex
#DefineFunction udfIPToHex (sIP)
sHex = ""
iCount = ItemCount(sIP,".")
For i=1 To iCount
iByte = 0+ItemExtract(i,sIP,".")
;sHex = StrCat(sHex,Num2Char((iByte>>4)+48+39*((iByte>>4)>9)),Num2Char((iByte&15)+48+39*((iByte&15)>9))) ; lowercase
sHex = StrCat(sHex,Num2Char((iByte>>4)+48+7*((iByte>>4)>9)),Num2Char((iByte&15)+48+7*((iByte&15)>9))) ; uppercase
Next
Return (sHex)
;..........................................................................................................................................
; This Function "udfIPToHex" returns a string, that contains the
; uppercase hexadecimal representation of an ip number string.
;
; Example:
; sIP = "192.168.15.31" ; Must be a valid IP number string.
; returns:
; sHex = "C0A80F1F"
;
; Detlev Dalitz.20030630
;..........................................................................................................................................
#EndFunction
:skip_udfiptohex
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udhextoip",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udhextoip
#DefineFunction udfHexToIP (sHex)
sIP = ""
sHex = StrUpper(StrTrim(sHex))
iLen = StrLen(sHex)
For i=1 To iLen By 2
iN1 = Char2Num(StrSub(sHex,i,1))-48
iN2 = Char2Num(StrSub(sHex,i+1,1))-48
iByte = ((iN1-7*(iN1>9))<<4) + (iN2-7*(iN2>9))
sIP = ItemInsert(iByte,-1,sIP,".")
Next
Return (sIP)
;..........................................................................................................................................
; This Function "udfHexToIP" returns a string, that contains the
; IP number representation of a hexadecimal string.
;
; Example:
; sHex = "c0a80f1f" ; Must be a valid hexstring that can be translated into ip numberstring.
; returns:
; sIP = "192.168.15.31"
;
; Detlev Dalitz.20030630
;..........................................................................................................................................
#EndFunction
:skip_udhextoip
;------------------------------------------------------------------------------------------------------------------------------------------
; --- test ---
sIP = "192.168.15.31"
sHex1 = udfIPToHex(sIP)
sHex2 = udfIPToHex_2(sIP)
sIP1 = udfHexToIP(sHex1)
sIP2 = udfHexToIP_2(sHex2)
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
|
|
If you have questions about WinBatch, you are encouraged to use online WebBoard BBS at http://webboard.windowware.com
|
|
|
|
|
udfSayNoYes (iBool) |
;------------------------------------------------------------------------------------------------------------------------------------------
; Examples about evaluating a boolean value for displaying.
;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfSayFalseTrue(iBool)
Return (ItemExtract(1+iBool,"FALSE,TRUE",","))
#EndFunction
#DefineFunction udfSayNoYes(iBool)
Return (ItemExtract(1+iBool,"No,Yes",","))
#EndFunction
#DefineFunction udfSayNeinJa(iBool)
Return (ItemExtract(1+iBool,"Nein,Ja",","))
#EndFunction
#DefineFunction udfSayFalseTrue(iBool)
aBool = Arrayize("FALSE,TRUE",",")
Return (aBool[iBool])
#EndFunction
#DefineFunction udfSayNoYes(iBooll)
aBool = Arrayize("No,Yes",",")
Return (aBool[iBool])
#EndFunction
#DefineFunction udfSayNeinJa(iBool)
aBool = Arrayize("Nein,Ja",",")
Return (aBool[iBool])
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------
*EOF*
|
|
If you have questions about WinBatch, you are encouraged to use online WebBoard BBS at http://webboard.windowware.com
|
|
|
|
|
udfSwapCommaPoint (fsNumber) |
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfswapcommapoint",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfswapcommapoint
#DefineFunction udfSwapCommaPoint (sNumber)
Return (StrReplace(StrReplace(StrReplace(StrClean(sNumber,"0123456789.,E+-","",@FALSE,2),".",":"),",","."),":",","))
#EndFunction
:skip_udfswapcommapoint
;------------------------------------------------------------------------------------------------------------------------------------------
;--- test ---
DecimalCommaNumber = "1.234.711,22"
DecimalPointNumber = "1,234,711.22"
Message("Demo udfSwapCommaPoint (sNumber)",StrCat("from",@CRLF,"decimal comma ",DecimalCommaNumber,@CRLF,"to",@CRLF,"decimal point ",udfSwapCommaPoint(DecimalCommaNumber)))
Message("Demo udfSwapCommaPoint (sNumber)",StrCat("from",@CRLF,"decimal point ",DecimalPointNumber,@CRLF,"to",@CRLF,"decimal comma ",udfSwapCommaPoint(DecimalPointNumber)))
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
*EOF*
|
|
If you have questions about WinBatch, you are encouraged to use online WebBoard BBS at http://webboard.windowware.com
|
|
|
|
DD382100.HTM DD-Software.Conversion.Misc Add this page to your favorites Save this document |