Page Date
2004-05-18
DD-Software
Kapitel zurück / previous Chapter
Main Index
 
Seite zurück / previous page
Backward
Seite vor / next page
Forward
 
Seitenanfang/TopOfPage
Top
Seitenende/EndOfPage
Bottom
MyWbtHelp current version

WinBatch Scripting - Conversion Functions




Seitenanfang/TopOfPage Seitenende/EndOfPage Seitenende/EndOfPage Seitenanfang/TopOfPage

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
;----------------------------------------------------------------------------------------


Seitenanfang/TopOfPage Seitenende/EndOfPage Seitenende/EndOfPage Seitenanfang/TopOfPage

udfByteToHex (byte)
udfHexToByte (hexstr)
udfHexToDec (hexstr)
udfHexToFloat (hexstr)
udfDecToHex (dec)

;------------------------------------------------------------------------------------------------------------------------------------------
; 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
;------------------------------------------------------------------------------------------------------------------------------------------


Seitenanfang/TopOfPage Seitenende/EndOfPage Seitenende/EndOfPage Seitenanfang/TopOfPage

udfColorRgbToHex (rgbitem)
udfColorHexToRgb (hexitem, rgbprefixflag, threedigitsflag, percentflag)

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


Seitenanfang/TopOfPage Seitenende/EndOfPage Seitenende/EndOfPage Seitenanfang/TopOfPage

udfConvertToBase (num, base, width)
udfConvertFromBase (str, base)

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


Seitenanfang/TopOfPage Seitenende/EndOfPage Seitenende/EndOfPage Seitenanfang/TopOfPage

udfFileTimeCodeToYmdHms (iTimeCode)
udfYmdHmsToFileTimeCode (sYmdHms)

;------------------------------------------------------------------------------------------------------------------------------------------
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*


Seitenanfang/TopOfPage Seitenende/EndOfPage Seitenende/EndOfPage Seitenanfang/TopOfPage

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


Seitenanfang/TopOfPage Seitenende/EndOfPage Seitenende/EndOfPage Seitenanfang/TopOfPage

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
;--------------------------------------------------------------------------------------------------------------------------------------------------------------


Seitenanfang/TopOfPage Seitenende/EndOfPage Seitenende/EndOfPage Seitenanfang/TopOfPage

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*


Seitenanfang/TopOfPage Seitenende/EndOfPage Seitenende/EndOfPage Seitenanfang/TopOfPage

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*




Seitenanfang/TopOfPage Seitenende/EndOfPage Seitenende/EndOfPage Seitenanfang/TopOfPage

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*


Seitenanfang/TopOfPage Seitenende/EndOfPage Seitenende/EndOfPage Seitenanfang/TopOfPage

udfStrEncode64 (sString)
udfStrDecode64 (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*


Seitenanfang/TopOfPage Seitenende/EndOfPage Seitenende/EndOfPage Seitenanfang/TopOfPage

udfIPToHex (sIPString)
udfHexToIP (sHexString)

;------------------------------------------------------------------------------------------------------------------------------------------
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
;------------------------------------------------------------------------------------------------------------------------------------------


Seitenanfang/TopOfPage Seitenende/EndOfPage Seitenende/EndOfPage Seitenanfang/TopOfPage

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*


Seitenanfang/TopOfPage Seitenende/EndOfPage Seitenende/EndOfPage Seitenanfang/TopOfPage

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*



Page Date
2004-05-18
DD-Software
Kapitel zurück / previous Chapter
Main Index
 
Seite zurück / previous page
Backward
Seite vor / next page
Forward
 
Seitenanfang/TopOfPage
Top
Seitenende/EndOfPage
Bottom
MyWbtHelp current version