2004-05-18
DD-Software
 Main Index |
 Backward |
 Forward |
 Top |
 Bottom |
| Page Date 2004-05-18 DD-Software |
|
|
|
MyWbtHelp current version |
|
|
udfStrOverlay (sOverlay, sTarget, iStart, iLength, sPadChar) |
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstroverlay",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfstroverlay
#DefineFunction udfStrOverlay (sOverlay, sTarget, iStart, iLength, sPadChar)
If !StrLen(sOverlay) Then Return (sTarget)
iTargetLength = StrLen(sTarget)
If !iTargetLength Then Return ("")
If (sPadChar=="") Then sPadChar = " "
iLength = Max(0,iLength)
iStart = Max(0,iStart)
a = StrSub(sTarget,1,iStart-1)
b = StrSub(sTarget,iStart+iLength,-1)
Return (StrSub(StrCat(a,StrFix(sOverlay,sPadChar,iLength),b),1,iTargetLength))
;..........................................................................................................................................
; Returns string sTarget with the string sOverlay overlayed at position iStart.
; Prior to the operation, sOverlay is truncated to iLength
; or padded to iLength with the sPadChar character, which defaults to a blank.
;
; Detlev Dalitz.20020209
;..........................................................................................................................................
#EndFunction
:skip_udfstroverlay
;------------------------------------------------------------------------------------------------------------------------------------------
;--- test ---
sMsgTitle = "Demo udfStrOverlay (sOverlay, sTarget, iStart, iLength, sPadChar)"
:test1
t1 = "dark,edge of night,9,5,*" ; change at end of sTarget ; "edge of dark*"
t2 = "dark,edge of night,1,4,*" ; change at iStart of sTarget ; "dark of night"
t3 = "dark,edge of night,0,5,*" ; no change ; "edge of night"
t4 = "dark,edge of night,20,5,*" ; no change ; "edge of night"
t5 = "dark,edge of night,-3,5,*" ; no change ; "edge of night"
t6 = "dark,edge of night,3,0," ; no change ; "edge of night"
t7 = "dark,edge of night,3,2," ; change ; "edda of night"
t8 = ",edge of night,3,2," ; no change ; "edge of night"
For i=1 To 8
sOverlay = ItemExtract(1,t%i%,",")
sTarget = ItemExtract(2,t%i%,",")
iStart = ItemExtract(3,t%i%,",")
iLength = ItemExtract(4,t%i%,",")
sPadChar = ItemExtract(5,t%i%,",")
sNew = udfStrOverlay(sOverlay,sTarget,iStart,iLength,sPadChar)
sMsgText = ""
sMsgText = StrCat(sMsgText,'sOverlay' ,@TAB,@TAB,'"',sOverlay,'"',@CRLF)
sMsgText = StrCat(sMsgText,'sTarget' ,@TAB,@TAB,'"',sTarget ,'"',@CRLF)
sMsgText = StrCat(sMsgText,'iStart' ,@TAB,@TAB,'"',iStart ,'"',@CRLF)
sMsgText = StrCat(sMsgText,'iLength' ,@TAB,@TAB,'"',iLength ,'"',@CRLF)
sMsgText = StrCat(sMsgText,'sPadChar' ,@TAB,@TAB,'"',sPadChar,'"',@CRLF)
sMsgText = StrCat(sMsgText,'sNew' ,@TAB,@TAB,'"',sNew ,'"',@CRLF)
Pause(sMsgTitle,sMsgText)
Next
:test2
BoxOpen("Demo udfStrOverlay (sOverlay, sTarget, iStart, iLength, sPadChar)","")
iTargetLength = 10
sTarget = StrFill("-",iTargetLength)
For i=1 To iTargetLength
sOut = udfStrOverlay("*",sTarget,i,1,"")
sOut = StrCat("[",sOut,"]")
BoxText(sOut)
TimeDelay(0.1/iTargetLength)
Next
For i=iTargetLength To 1 By -1
sOut = udfStrOverlay("*",sTarget,i,1,"")
sOut = StrCat("[",sOut,"]")
BoxText(sOut)
TimeDelay(0.1/iTargetLength)
Next
BoxShut()
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
;*EOF*
|
|
|
udfStrCnt (sourcestr, searchstr, matchcase) |
;==========================================================================================================================================
; How to count substrings in a string?
;==========================================================================================================================================
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstrcnt_1",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfstrcnt_1
#DefineFunction udfStrCnt_1 (sourcestr, searchstr, matchcase)
n=0
pos=0
If Min(1,Max(0,matchcase))
While 1
pos=StrIndex(sourcestr,searchstr,pos+1,@FWDSCAN)
If (pos>0) Then n=n+1
Else Return (n)
EndWhile
Else
While 1
pos=StrIndexNC(sourcestr,searchstr,pos+1,@FWDSCAN)
If (pos>0) Then n=n+1
Else Return (n)
EndWhile
EndIf
;..........................................................................................................................................
; Detlev Dalitz.20020209
;..........................................................................................................................................
#EndFunction
:skip_udfstrcnt_1
;------------------------------------------------------------------------------------------------------------------------------------------
;--- test ---
msgtitle = "Demo udfStrCnt (str, searchstr, matchcase)"
str = "TO test or NOT to test"
searchstr = "O"
n = udfStrCnt_1(str,searchstr,@TRUE)
msgtext = ""
msgtext = StrCat(msgtext,@CRLF,'udfStrCnt("',str,'" ,"',searchstr,'" ,@true)')
msgtext = StrCat(msgtext,@CRLF,n,' occurences of "',searchstr,'"')
Message(msgtitle,msgtext)
; ==> '2 occurences of "O"'
searchstr = "O"
n = udfStrCnt_1(str,searchstr,@FALSE)
msgtext = StrCat(msgtext,@CRLF)
msgtext = StrCat(msgtext,@CRLF,'udfStrCnt("',str,'" ,"',searchstr,'" ,@false)')
msgtext = StrCat(msgtext,@CRLF,n,' occurences of "',searchstr,'"')
Message(msgtitle,msgtext)
; ==> '4 occurences of "O"'
searchstr = "TEST"
n = udfStrCnt_1(str,searchstr,@FALSE)
msgtext = StrCat(msgtext,@CRLF)
msgtext = StrCat(msgtext,@CRLF,'udfStrCnt("',str,'" ,"',searchstr,'" ,@false)')
msgtext = StrCat(msgtext,@CRLF,n,' occurences of "',searchstr,'"')
Message(msgtitle,msgtext)
; ==> '2 occurences of "TEST"'
;==========================================================================================================================================
;==========================================================================================================================================
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstrcnt_2",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfstrcnt_2
#DefineFunction udfStrCnt_2 (sourcestr, searchstr, matchcase)
If (0==Min(1,Max(0,matchcase)))
sourcestr = StrLower(sourcestr)
searchstr = StrLower(searchstr)
EndIf
Return ((StrLen(sourcestr) - StrLen(StrReplace(sourcestr,searchstr,""))) / StrLen(searchstr))
;..........................................................................................................................................
; Adapted from WinBatch TechBase
; Article ID: W14502
; Filename: Number of Instances of Char in a String.txt
; File Created: 2000:03:30:11:28:01
; Page Dated: 2000:03:30:11:43:44
;
; Slightly modified by Detlev Dalitz.20020521
;..........................................................................................................................................
#EndFunction
:skip_udfstrcnt_2
;------------------------------------------------------------------------------------------------------------------------------------------
; --- test ---
str = "abcannaDnnnannannnDndnnd"
count = udfStrCnt_2(str,"dn",0)
Message("Demo udfStrCnt_2 Count",count)
; ==> 3
count = udfStrCnt_2(str,"dn",1)
Message("Demo udfStrCnt_2 Count",count)
;==> 1
;==========================================================================================================================================
;==========================================================================================================================================
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstrcnt_3",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfstrcnt_3
#DefineFunction udfStrCnt_3 (sourcestr, searchstr, matchcase)
n=0
pos=0
While 1
If (matchcase==1) Then pos=StrIndex(sourcestr,searchstr,pos+1,@FWDSCAN)
If (matchcase==0) Then pos=StrIndexNC(sourcestr,searchstr,pos+1,@FWDSCAN)
If (pos<>0) Then n=n+1
Else Break
EndWhile
Return (n)
;..........................................................................................................................................
; Published by Guido sedar@yahoo.com, Tuesday, June 26, 2001 09:05 AM, WinBatch Forum
; This function counts the occurrences of a sub-string in a string.
;
; Parameters:
; str: the string to be searched for a sub-string.
; substr: the string to look for within the main string.
; matchcase: 1=Case sensitive, 0=Ignore case
; Returns the Number of occurrences of sub-string found.
;..........................................................................................................................................
#EndFunction
:skip_udfstrcnt_3
;------------------------------------------------------------------------------------------------------------------------------------------
;--- test ---
count1 = udfStrCnt_3("green","e",0)
; ==> 2
count2 = udfStrCnt_3("green","E",1)
; ==> 0
count3 = udfStrCnt_3("green","E",0)
; ==> 2
;==========================================================================================================================================
;==========================================================================================================================================
;------------------------------------------------------------------------------------------------------------------------------------------
:Performancetest
sMsgTitle = "Demo Performance Test"
sTestString = "TO test or NOT to test"
iTestLoop = 1
iMaxTests = 3
iTest=1
Display(1,sMsgTitle,"Running Test %iTest%, please wait ...")
Exclusive(@ON)
iStart = GetTickCount()
For i=1 To iTestLoop
Result = udfStrCnt_1(sTestString,"TEST",0)
Result = udfStrCnt_1(sTestString,"TEST",1)
Result = udfStrCnt_1(sTestString,"O",0)
Result = udfStrCnt_1(sTestString,"O",1)
Next
iStop = GetTickCount()
Exclusive(@OFF)
iTicks%iTest% = iStop-iStart
iTest=2
Display(1,sMsgTitle,"Running Test %iTest%, please wait ...")
Exclusive(@ON)
iStart = GetTickCount()
For i=1 To iTestLoop
Result = udfStrCnt_2(sTestString,"TEST",0)
Result = udfStrCnt_2(sTestString,"TEST",1)
Result = udfStrCnt_2(sTestString,"O",0)
Result = udfStrCnt_2(sTestString,"O",1)
Next
iStop = GetTickCount()
Exclusive(@OFF)
iTicks%iTest% = iStop-iStart
iTest=3
Display(1,sMsgTitle,"Running Test %iTest%, please wait ...")
Exclusive(@ON)
iStart = GetTickCount()
For i=1 To iTestLoop
Result = udfStrCnt_3(sTestString,"TEST",0)
Result = udfStrCnt_3(sTestString,"TEST",1)
Result = udfStrCnt_3(sTestString,"O",0)
Result = udfStrCnt_3(sTestString,"O",1)
Next
iStop = GetTickCount()
Exclusive(@OFF)
iTicks%iTest% = iStop-iStart
iMaxTicks = 0
For iTest=1 To iMaxTests
iMaxTicks = Max(iMaxTicks,iTicks%iTest%)
Next
For iTest=1 To iMaxTests
iPct%iTest% = 100*iTicks%iTest%/iMaxTicks
Next
sMsgText = ""
For iTest=1 To iMaxTests
sMsgText = StrCat(sMsgText,"Test ",iTest,@TAB,"Ticks = ",@TAB,iTicks%iTest%,@TAB,iPct%iTest%," %%",@CRLF)
Next
ClipPut(sMsgText)
Message(sMsgTitle,sMsgText)
; WB Studio Debug
; Test 1 Ticks = 48143 91 %
; Test 2 Ticks = 14571 27 % <== The Winner.
; Test 3 Ticks = 52609 100 %
; WB Studio Run
; Test 1 Ticks = 4923 83 %
; Test 2 Ticks = 2657 45 % <== The Winner.
; Test 3 Ticks = 5877 100 %
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
|
|
|
udfStrCompose (str, composelist, delimiter) |
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstrcompose",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfstrcompose
#DefineFunction udfStrCompose (sString, sComposeList, sDelimiter)
If (sComposeList == "") Then Return (sString)
sErrMsg = "*** udfStrCompose: Bad parameter sComposeList ***"
iCount = ItemCount(sComposeList,sDelimiter)
If (iCount mod 2) Then Return (sErrMsg)
sComposeStr = ""
iCount = iCount/2
For ii=1 To iCount
vItem1 = ItemExtract(ii+ii-1,sComposeList,sDelimiter)
vItem2 = ItemExtract(ii+ii ,sComposeList,sDelimiter)
If !IsInt(vItem2) Then Return (sErrMsg)
If IsInt(vItem1)
iLen = Max(1+vItem2-vItem1,1)
sComposeStr = StrCat(sComposeStr,StrFix(StrSub(sString,vItem1,iLen)," ",iLen))
Else
For id=1 To 3
sDelim = StrSub(""",',`",id,1)
vItem = ItemExtract(2,vItem1,sDelim)
If (StrCat(sDelim,vItem,sDelim) == vItem1)
vItem1 = vItem
Break
EndIf
Next
vItem = vItem1
For in=2 To vItem2
vItem = StrCat(vItem,vItem1)
Next
sComposeStr = StrCat(sComposeStr,vItem)
EndIf
Next
Return (sComposeStr)
;..........................................................................................................................................
; Returns a string which is composed as defined in sComposeList.
; Example:
;
; csDelim = ","
; clist = ""
; clist = Iteminsert(StrCat( ": " ,csDelim, "1" ),-1,clist,csDelim) ; append ': ' times 1
; clist = Iteminsert(StrCat( "#35" ,csDelim, "1" ),-1,clist,csDelim) ; append '#35' times 1
; clist = Iteminsert(StrCat( "'4711'" ,csDelim, "2" ),-1,clist,csDelim) ; append '4711' times 2
; clist = Iteminsert(StrCat( "2" ,csDelim, "5" ),-1,clist,csDelim) ; append column 2 thru 5
; clist = Iteminsert(StrCat( " " ,csDelim, "5" ),-1,clist,csDelim) ; append blank times 5
; clist = Iteminsert(StrCat( "2" ,csDelim, "3" ),-1,clist,csDelim) ; append column 2 thru 3
; clist = Iteminsert(StrCat( "." ,csDelim, "1" ),-1,clist,csDelim) ; append '.' times 1
; clist = Iteminsert(StrCat( "4" ,csDelim, "5" ),-1,clist,csDelim) ; append column 4 thru 5
; clist = Iteminsert(StrCat( "%%" ,csDelim, "1" ),-1,clist,csDelim) ; append symbol percent times 1
; clist = Iteminsert(StrCat( "%@crlf%" ,csDelim, "2" ),-1,clist,csDelim) ; append @crlf times 2
; clist = Iteminsert(StrCat( ";""" ,csDelim, "1" ),-1,clist,csDelim) ; append ';"' times 1
; clist = Iteminsert(StrCat( "%@tab%" ,csDelim, "1" ),-1,clist,csDelim) ; append @tab times 1
; clist = Iteminsert(StrCat( "- . " ,csDelim, "20" ),-1,clist,csDelim) ; append '- . ' times 20
; clist = Iteminsert(StrCat( """" ,csDelim," 1" ),-1,clist,csDelim) ; append '"' times 1
; clist = Iteminsert(StrCat( "%@crlf%" ,csDelim, "1" ),-1,clist,csDelim) ; append @crlf times 1
;
; Composing the tag string looks somewhat cryptic, but don't worry, be happy.
; - Use always sets of two elements: 'from,thru' or 'text,multiplier'.
; - Use tupel (n,m) for extracting chars from sString out of columns n to m.
; - Use tupel (abc,n) to fill new text "abc" n-times into the composed string,
; as an alternative: use tupel ('a b c',n) to fill in new text "a b c" n-times.
;..........................................................................................................................................
; Detlev Dalitz.20010716
;..........................................................................................................................................
#EndFunction
:skip_udfstrcompose
;------------------------------------------------------------------------------------------------------------------------------------------
; --- test ---
:test1
sString = "All messages in all conferences have been marked as read."
sComposeList = "43,46,' --> ',2,5,12, ,2,33,36, ,2,44,44,2,3, ,2,38,41, ,2,38,38,55,56, ,1,<,1,-,5"
sComposeStr = udfStrCompose(sString,sComposeList,",")
sMsgTitle = "Demo udfStrCompose (sString, sComposeList, sDelimiter)"
sMsgText = StrCat('sString = "',sString,'"',@CRLF)
sMsgText = StrCat(sMsgText,'sComposeList = "',sComposeList,'"',@CRLF)
sMsgText = StrCat(sMsgText,'sComposeStr = "',sComposeStr,'"')
Message(sMsgTitle,sMsgText)
; ==> "mark --> --> messages have all been bad <-----"
:test2
sString = "Demo with bad formatted sComposeList."
; sComposeList is not ok: 3 and a half tupel, odd number of items
sComposeList = "1,5,33,34,10,13,."
; sComposeList is ok: 4 tupel, even number of items
; sComposeList = "1,5,33,34,10,13,.,1"
sComposeStr = udfStrCompose(sString,sComposeList,",")
sMsgTitle = "Demo udfStrCompose (sString, sComposeList, sDelimiter)"
sMsgText = StrCat('sString = "',sString,'"',@CRLF)
sMsgText = StrCat(sMsgText,'sComposeList = "',sComposeList,'"',@CRLF)
sMsgText = StrCat(sMsgText,'sComposeStr = "',sComposeStr,'"')
Message(sMsgTitle,sMsgText)
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
|
|
|
udfStrQuote (sStr, sLeft, sRight)
|
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstrquote",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfstrquote
#DefineFunction udfStrQuote (sString, sLeft, sRight)
; If (sString == "") then return (sString)
If (""==sLeft)
If (""==sRight)
sQuote = """'`"
sClean = StrClean(sString,sQuote,"",@FALSE,2)
If (""==StrClean(sQuote,sClean,"",@FALSE,1))
sQuote = '"'
sString = StrReplace(sString,sQuote,StrCat(sQuote,sQuote))
Else
sClean = StrClean(sQuote,sClean,"",@FALSE,1)
sQuote = StrSub(sClean,1,1)
EndIf
sLeft = sQuote
sRight = sQuote
EndIf
EndIf
Return (StrCat(sLeft,sString,sRight))
;------------------------------------------------------------------------------------------------------------------------------------------
; With sLeft="" and sRight=""
; the function chooses a winbatch quote delimiter automagically
; and doubles the quotation char in sString if necessary.
;
; With sLeft="""" and sRight=""""
; the function allows quotation without doubling of quotation char in sString.
;
; With sLeft="(* " and sRight=" *)"
; the function encloses sString in pairs of pascal comments.
;
; DD.20010722.20020628
;------------------------------------------------------------------------------------------------------------------------------------------
#EndFunction
:skip_udfstrquote
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstrunquote",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfstrunquote
#DefineFunction udfStrUnQuote (sString, iMode)
If (sString=="") Then Return (sString)
If (iMode<0)||(iMode>5) Then Return (sString)
iLen = StrLen(sString)
c1 = StrSub(sString,1,1)
c2 = StrSub(sString,iLen,1)
cc = StrCat(c1,c2)
qq = """""''``"
bb = "(){}[]<>"
Select iMode
Case 0
dd = qq
Break
Case 1
dd = bb
Break
Case 2
dd = StrCat(qq,bb)
Break
Case 3
dd = StrCat(c1,c1)
Break
Case 4
dd = StrCat(bb,c1,c1)
Break
Case 5
dd = cc
Break
EndSelect
ib = @FALSE
ii = 1
While !(ib||(ii>StrLen(dd)/2))
ib = (""==StrClean(cc,StrSub(dd,ii+ii-1,2),"",@FALSE,1))
ii = ii + 1
EndWhile
If ib Then sString = StrSub(sString,2,iLen-2)
Return (sString)
;..........................................................................................................................................
; This udf removes quote delimiters, brackets or any first/last chars.
;
; iMode=0 ... Removes quotes only.
; iMode=1 ... Removes brackets only.
; iMode=2 ... Removes quotes and brackets.
; iMode=3 ... Removes first/last chars if equal and quotes.
; iMode=4 ... Removes first/last chars if equal and brackets.
; iMode=5 ... Removes any first/last chars.
;..........................................................................................................................................
; Detlev Dalitz.20010722
;..........................................................................................................................................
#EndFunction
;
:skip_udfstrunquote
;------------------------------------------------------------------------------------------------------------------------------------------
;--- test 1 ---
test1 = `udfStrQuote (str, '', '')`
test2 = `udfStrQuote (str, '"', '"')`
test3 = `udfStrQuote (str, '(', ')')`
test4 = `udfStrQuote (str, '/* ',' */')`
test5 = `udfStrQuote (str, '==> ','')`
For it=1 To 5
test = test%it%
str = "."" ab'c ""."
outstr = ""
For i=1 To 4
k = i+i
j = k-1
str%j% = str
str%k% = %test%
str = str%k%
line = StrCat(str%j%,@TAB,@TAB,"-->",@TAB,str%k%)
outstr = StrCat(outstr,line,@CR)
If (StrSub(str,1,1)=="""") Then str=StrReplace(str,"""""","""") ; Simulate quote substitution.
Next
outstr=StrCat(test,@CR,@CR,outstr)
Pause("",outstr)
Next
;--- test 2 ---
mode=2
test=StrCat("udfStrUnQuote (str, ",mode,")")
str="""'`[{<#test#>}]`'"""
steps=10
For i=1 To steps
str2=udfStrUnQuote(str,mode)
outstr=StrCat(str,@TAB,"-->",@TAB,str2)
outstr=StrCat(test,@CR,"step ",steps,"/",i,@CR,@CR,outstr)
Pause("",outstr)
str=str2
Next
;--- test 3 ---
mode=4
test=StrCat("udfStrUnQuote (str, ",mode,")")
str="""'`[{<#test#>}]`'"""
steps=10
For i=1 To steps
str2=udfStrUnQuote(str,mode)
outstr=StrCat(str,@TAB,"-->",@TAB,str2)
outstr=StrCat(test,@CR,"step ",steps,"/",i,@CR,@CR,outstr)
Pause("",outstr)
str=str2
Next
;--- test 4 ---
mode=5
test=StrCat("udfStrUnQuote (str, ",mode,")")
str="""'`[{<#test#>}]`'"""
steps=10
For i=1 To steps
str2=udfStrUnQuote(str,mode)
outstr=StrCat(str,@TAB,"-->",@TAB,str2)
outstr=StrCat(test,@CR,"step ",steps,"/",i,@CR,@CR,outstr)
Pause("",outstr)
str=str2
Next
:CANCEL
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
;*EOF*
|
|
|
udfStrWildCompare (sPattern, sString, iMatchCase) |
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstrwildcompare",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfstrwildcompare
#DefineFunction udfStrWildCompare (sPattern, sString, iMatchCase)
If (sPattern=="") Then Return (@TRUE) ; Empty wildcard = TRUE.
If (sPattern=="*") Then Return (@TRUE) ; An asterisk "*" matches anything.
If !iMatchCase
sPattern = StrLower(sPattern)
sString = StrLower(sString)
EndIf
While @TRUE
If (sPattern=="") Then Return (sString=="") ; If end of wildcard is also.
sPatChar = StrSub(sPattern,1,1) ; Character of wildcard.
If (sPatChar=="*") ; Is it an asterisk "*"?
sPattern = StrSub(sPattern,2,-1) ; Bump wildcard to next position.
While @TRUE ; See if we can match the rest.
; Recursive udf call.
If (udfStrWildCompare(sPattern,sString,iMatchCase)) Then Return (@TRUE)
If (sString=="") Then Return (@FALSE)
sString = StrSub(sString,2,-1)
EndWhile
EndIf
If (sPatChar=="?") ; A question mark "?" matches any alpha or numeric character.
If (sString=="") Then Return (@FALSE)
sString = StrSub(sString,2,-1)
sPattern = StrSub(sPattern,2,-1)
Continue
EndIf
If (sPatChar=="#") ; A "#" matches any numeric character.
sStrChar = StrSub(sString,1,1)
If (sStrChar>"9") Then Return (@FALSE)
If (sStrChar<"0") Then Return (@FALSE)
sString = StrSub(sString,2,-1)
sPattern = StrSub(sPattern,2,-1)
Continue
EndIf
If (StrSub(sString,1,1)!=sPatChar) Then Return (@FALSE)
sString = StrSub(sString,2,-1)
sPattern = StrSub(sPattern,2,-1)
EndWhile
;..........................................................................................................................................
; This function compares a text string to a wildcard string,
; returning @TRUE if the match is successful.
;
; This matching routine uses the following wildcards:
; * ... Zero or more of any characters at this position.
; ? ... One of any character at this position.
; # ... One numeric character at this position.
;
; iMatchCase = 0 ... Ignore uppercase.
; iMatchCase = 1 ... Respect uppercase.
;..........................................................................................................................................
; Published by Alan Kreutzer
; WinBatch TechDatabase, UserDefinedFunctionLibrary, Wildcard UDF
; Slightly modified by Detlev Dalitz.20020531.20030705.
;..........................................................................................................................................
#EndFunction
:skip_udfstrwildcompare
;------------------------------------------------------------------------------------------------------------------------------------------
;--- test ---
iWildComp1 = udfStrWildCompare("???##/#*","das13/2456",0) ; ==> 1 (@TRUE)
iWildComp2 = udfStrWildCompare("???##/#*","xyz99/8976",0) ; ==> 1 (@TRUE)
iWildComp3 = udfStrWildCompare("???##/#*","dasdas456",0) ; ==> 0 (@FALSE)
iWildComp4 = udfStrWildCompare("dd##/#*" ,"dd45/6",1) ; ==> 1 (@TRUE)
iWildComp5 = udfStrWildCompare("DD##/#*" ,"dd45/6",1) ; ==> 0 (@FALSE)
iWildComp6 = udfStrWildCompare("DD##/#*" ,"dd45/6",0) ; ==> 1 (@TRUE)
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
;*EOF*
|
|
|
udfStrCount (str, start, stop, searchstr, matchcase) |
;==========================================================================================================================================
; How to count substrings in a substring?
;==========================================================================================================================================
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstrcount_1",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfstrcount_1
#DefineFunction udfStrCount_1 (str, start, stop, searchstr, matchcase)
n=StrLen(str)
If (n>0)
start=Min(Max(1,start),n)
stop=Max(Min(n,stop),1)
n=((stop-start)>=0)
If n
n=0
p=0
str=StrSub(str,start,stop-start+1)
If !matchcase
str=StrLower(str)
searchstr=StrLower(searchstr)
EndIf
While 1
p=StrIndex(str,searchstr,p+1,@FWDSCAN)
If p Then n=n+1
Else Break
EndWhile
EndIf
EndIf
Return (n)
; Detlev Dalitz.20020209
#EndFunction
:skip_udfstrcount_1
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstrcount_2",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfstrcount_2
#DefineFunction udfStrCount_2 (str, start, stop, searchstr, matchcase)
n=StrLen(str)
If (n>0)
start=Min(Max(1,start),n)
stop=Max(Min(n,stop),1)
n=((stop-start)>=0)
If n
n=0
p=0
str=StrSub(str,start,stop-start+1)
If matchcase
While 1
p=StrIndex(str,searchstr,p+1,@FWDSCAN)
If p Then n=n+1
Else Return (n)
EndWhile
Else
While 1
p=StrIndexNC(str,searchstr,p+1,@FWDSCAN)
If p Then n=n+1
Else Return (n)
EndWhile
EndIf
EndIf
EndIf
Return (n)
; Detlev Dalitz.20020209
#EndFunction
:skip_udfstrcount_2
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstrcount_3",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfstrcount_3
#DefineFunction udfStrCount_3 (str, start, stop, searchstr, matchcase)
n=StrLen(str)
If (n>0)
start=Min(Max(1,start),n)
stop=Max(Min(n,stop),1)
n=((stop-start)>=0)
If n
str=StrSub(str,start,stop-start+1)
If !matchcase
str=StrLower(str)
searchstr=StrLower(searchstr)
EndIf
bb=BinaryAlloc(StrLen(str))
BinaryPokeStr(bb,0,str)
n=BinaryStrCnt(bb,0,BinaryEodGet(bb)-1,searchstr)
BinaryFree(bb)
EndIf
EndIf
Return (n)
; Detlev Dalitz.20020209
#EndFunction
:skip_udfstrcount_3
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstrcount_4",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfstrcount_4
#DefineFunction udfStrCount_4 (str, start, stop, searchstr, matchcase)
n=StrLen(str)
If (n>0)
start=Min(Max(1,start),n)-1
stop=Max(Min(n,stop),1)-1
n=((stop-start)>=0)
If n
If !matchcase
str=StrLower(str)
searchstr=StrLower(searchstr)
EndIf
bb=BinaryAlloc(StrLen(str))
BinaryPokeStr(bb,0,str)
n=BinaryStrCnt(bb,start,stop,searchstr)
BinaryFree(bb)
EndIf
EndIf
Return (n)
; Detlev Dalitz.20020209
#EndFunction
:skip_udfstrcount_4
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstrcount_5",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfstrcount_5
#DefineFunction udfStrCount_5 (str, start, stop, searchstr, matchcase)
str = StrSub(str,start,stop-start+1)
If str=="" Then Return 0
If searchstr=="" Then Return 0
If !matchcase
str = StrLower(str)
searchstr = StrLower(searchstr)
EndIf
Return ((StrLen(str) - StrLen(StrReplace(str,searchstr,""))) / StrLen(searchstr))
#EndFunction
:skip_udfstrcount_5
;------------------------------------------------------------------------------------------------------------------------------------------
;--- test ---
:test1
Maxtests = 5
str = "TO test or NOT to test"
For t=1 To Maxtests
msgtitle = "Demo udfStrCount_%t% (str, start, stop, searchstr, matchcase)"
start = 4
stop = 10
searchstr = " "
n = udfStrCount_%t% (str,start,stop,searchstr,@FALSE)
msgtext = ""
msgtext = StrCat(msgtext,@CRLF,"udfStrCount(""",str,""",",start,",",stop,",""",searchstr,""",@false",")")
msgtext = StrCat(msgtext,@CRLF,n," occurences of """,searchstr,"""")
Message(msgtitle,msgtext)
; ==> '1 occurences of " "'
start = 1
stop = 40
searchstr = "to te"
n = udfStrCount_%t% (str,start,stop,searchstr,@FALSE)
msgtext = StrCat(msgtext,@CRLF)
msgtext = StrCat(msgtext,@CRLF,"udfStrCount(""",str,""",",start,",",stop,",""",searchstr,""",@false",")")
msgtext = StrCat(msgtext,@CRLF,n," occurences of """,searchstr,"""")
Message(msgtitle,msgtext)
; ==> '2 occurences of "to te"'
searchstr = "to te"
n = udfStrCount_%t% (str,start,stop,searchstr,@TRUE)
msgtext = StrCat(msgtext,@CRLF)
msgtext = StrCat(msgtext,@CRLF,"udfStrCount(""",str,""",",start,",",stop,",""",searchstr,""",@true",")")
msgtext = StrCat(msgtext,@CRLF,n," occurences of """,searchstr,"""")
Message(msgtitle,msgtext)
; ==> '1 occurences of "to te"'
searchstr = "o"
start = 60
stop = -40
n = udfStrCount_%t% (str,start,stop,searchstr,@TRUE)
msgtext = StrCat(msgtext,@CRLF)
msgtext = StrCat(msgtext,@CRLF,"udfStrCount(""",str,""",",start,",",stop,",""",searchstr,""",@true",")")
msgtext = StrCat(msgtext,@CRLF,n," occurences of """,searchstr,"""")
Message(msgtitle,msgtext)
; ==> '0 occurences of "o"'
Next
;------------------------------------------------------------------------------------------------------------------------------------------
:Performancetest
msgtitle = "Demo udfStrCount Performance Test"
TestStr = "TO test or NOT to test TO test or NOT to test TO test or NOT to test TO test or NOT to test"
SearchStr = "to te"
Start = 10
Stop = 30
MatchCase = @FALSE
TestLoop = 200
Maxtests = 5
For t=1 To Maxtests
Display(1,msgtitle,"Running Test %t%, please wait ...")
Exclusive(@ON)
start = GetTickCount()
For i=1 To TestLoop
str = udfStrCount_%t% (TestStr,Start,Stop,SearchStr,MatchCase)
Next
stop = GetTickCount()
Exclusive(@OFF)
Ticks%t% = stop-start
Next
MaxTicks = 0
For t=1 To MaxTests
MaxTicks = Max(MaxTicks,Ticks%t%)
Next
For t=1 To MaxTests
Pct%t% = 100*Ticks%t%/MaxTicks
Next
msgtext = ""
For t=1 To MaxTests
msgtext = StrCat(msgtext,"Test ",t,@TAB,"Ticks = ",@TAB,Ticks%t%,@TAB,Pct%t%," %%",@CRLF)
Next
ClipPut(msgtext)
Message(msgtitle,msgtext)
; WB Studio Debug
; Test 1 Ticks = 22573 96 %
; Test 2 Ticks = 23438 100 %
; Test 3 Ticks = 23372 99 %
; Test 4 Ticks = 21931 93 %
; Test 5 Ticks = 6203 26 % <== The Winner.
; WB Studio Run
; Test 1 Ticks = 2315 59 %
; Test 2 Ticks = 2952 76 %
; Test 3 Ticks = 3877 100 %
; Test 4 Ticks = 3455 89 %
; Test 5 Ticks = 1409 36 % <== The Winner.
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
;*EOF*
|
|
|
udfStrInsert (sInsert, sTarget, iStart, iLength, sPadChar) |
;----------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstrinsert",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfstrinsert
#DefineFunction udfStrInsert (sInsert, sTarget, iStart, iLength, sPadChar)
If !StrLen(sInsert) Then Return (sTarget)
iTargetLength = StrLen(sTarget)
If !iTargetLength Then Return ("")
If (sPadChar=="") Then sPadChar = " "
iStart = Max(0,iStart)
iLength = Max(0,iLength)
Select 1
Case (iStart>iTargetLength)
sOut = StrCat(sTarget,StrFix(sInsert,sPadChar,iLength))
Break
Case (iStart<1)
sOut = StrCat(StrFix(sInsert,sPadChar,iLength),sTarget)
Break
Case 1
sOut = StrCat(StrSub(sTarget,1,iStart-1),StrFix(sInsert,sPadChar,iLength),StrSub(sTarget,iStart,-1))
Break
EndSelect
Return (sOut)
;..........................................................................................................................................
; Returns the result of inserting string sInsert into string sTarget at position iStart.
; Prior to the insertion, sInsert is truncated to iLength
; or padded to iLength with the sPadChar character, which defaults to a blank.
;..........................................................................................................................................
; Detlev Dalitz.20020616.20020725
;..........................................................................................................................................
#EndFunction
:skip_udfstrinsert
;----------------------------------------------------------------------------------------------------------------------
;--- test ---
sMsgTitle = "Demo udfStrInsert (sInsert, sTarget, iStart, iLength, sPadChar)"
:test1
t1 = "inserting,the result of string,12,10," ; "the result inserting of string"
t2 = "inserting,the result of string,12,12,*" ; "the result inserting***of string"
t3 = "inserting,the result of string,0,6,*" ; "insertthe result of string"
t4 = "inserting,the result of string,40,6,*" ; "the result of stringinsert"
t5 = "inserting,the result of string,-3,6,*" ; "insertthe result of string"
t6 = "inserting,the result of string,5,0," ; "the result of string"
t7 = "inserting,the result of string,15,2," ; "the result of instring"
t8 = ",the result of string,15,2," ; "the result of string"
For i=1 To 8
sOverlay = ItemExtract(1,t%i%,",")
sTarget = ItemExtract(2,t%i%,",")
iStart = ItemExtract(3,t%i%,",")
iLength = ItemExtract(4,t%i%,",")
sPadChar = ItemExtract(5,t%i%,",")
sNew = udfStrInsert(sOverlay,sTarget,iStart,iLength,sPadChar)
sMsgText = ""
sMsgText = StrCat(sMsgText,'sInsert' ,@TAB,@TAB,'"',sOverlay,'"',@CRLF)
sMsgText = StrCat(sMsgText,'sTarget' ,@TAB,@TAB,'"',sTarget ,'"',@CRLF)
sMsgText = StrCat(sMsgText,'iStart' ,@TAB,@TAB,'"',iStart ,'"',@CRLF)
sMsgText = StrCat(sMsgText,'iLength' ,@TAB,@TAB,'"',iLength ,'"',@CRLF)
sMsgText = StrCat(sMsgText,'sPadChar',@TAB,@TAB,'"',sPadChar,'"',@CRLF)
sMsgText = StrCat(sMsgText,'sNew' ,@TAB,@TAB,'"',sNew ,'"',@CRLF)
Message(sMsgTitle,sMsgText)
Next
:test2
BoxOpen("Demo udfStrInsert (sInsert, sTarget, iStart, iLength, sPadChar)","")
iTargetLength = 10
sTarget = StrFill(" ",iTargetLength)
For i=1 To iTargetLength
sOut = udfStrInsert("*",sTarget,i,1,"")
sOut = StrCat("[",StrSub(sOut,1,iTargetLength),"]")
BoxText(sOut)
TimeDelay(0.1/iTargetLength)
Next
For i=iTargetLength To 1 By -1
sOut = udfStrInsert("*",sTarget,i,1,"")
sOut = StrCat("[",StrSub(sOut,1,iTargetLength),"]")
BoxText(sOut)
TimeDelay(0.1/iTargetLength)
Next
BoxShut()
Exit
;----------------------------------------------------------------------------------------------------------------------
;*EOF*
|
|
|
udfStrCenter (str, len, pad) |
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstrcenter",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfstrcenter
#DefineFunction udfStrCenter (sString, iLength, sPad)
sString = StrSub(sString,1,iLength)
Return (StrFix(StrFixLeft(sString,sPad,(StrLen(sString)+iLength)/2),sPad,iLength))
;..........................................................................................................................................
; This function "udfStrCenter" returns a string of iLength width
; with the input string centered and padded with pad character.
;
; Detlev Dalitz.20010729.20030209
;..........................................................................................................................................
#EndFunction
:skip_udfstrcenter
;------------------------------------------------------------------------------------------------------------------------------------------
; --- test ---
test1 = udfStrCenter('title' , 12, "" ) ; ==> ' title '
test2 = udfStrCenter('title' , 12, '*') ; ==> '***title****'
test3 = udfStrCenter('title ', 12, "" ) ; ==> ' title '
test4 = udfStrCenter('title ', 12, '*') ; ==> '**title **'
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
;*EOF*
|
|
|
udfIsUpperCase (sChar)
|
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfisuppercase",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfisuppercase
#DefineFunction udfIsUpperCase (sChar)
Return (sChar==StrUpper(sChar))
#EndFunction
:skip_udfisuppercase
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfislowercase",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfislowercase
#DefineFunction udfIsLowerCase (sChar)
Return (sChar==StrLower(sChar))
#EndFunction
:skip_udfislowercase
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfsaycase",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfsaycase
#DefineFunction udfSayCase (iBool)
Return (ItemExtract(1+iBool,"lowercase,uppercase",","))
#EndFunction
:skip_udfsaycase
;------------------------------------------------------------------------------------------------------------------------------------------
;--- test ---
sUpperChar = "D"
sLowerChar = "d"
UTitle = "Demo udfIsUpperCase"
LTitle = "Demo udfIsLowerCase"
Message(UTitle, StrCat(sUpperChar," is ",udfSayCase( udfIsUpperCase(sUpperChar))))
Message(UTitle, StrCat(sLowerChar," is ",udfSayCase( udfIsUpperCase(sLowerChar))))
Message(LTitle, StrCat(sUpperChar," is ",udfSayCase(!udfIsLowerCase(sUpperChar))))
Message(LTitle, StrCat(sLowerChar," is ",udfSayCase(!udfIsLowerCase(sLowerChar))))
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
;*EOF*
|
|
|
udfIsAbbrev (sStr1, sStr2, iLen) |
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfisabbrev",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfisabbrev
#DefineFunction udfIsAbbrev (sString1, sString2, iLength)
iLength = Max(0,iLength) ; Negative number is forced to zero.
If (iLength == 0) Then Return (StrSub(sString1,1,StrLen(sString2)) == sString2)
If (iLength > StrLen (sString2)) Then Return (@FALSE)
Return (StrSub(sString1,1,iLength) == StrSub(sString2,1,iLength))
;..........................................................................................................................................
; This function "udfIsAbbrev" returns @TRUE if sString2 is an abbreviation of sString1 otherwise @FALSE.
; If iLength==0 then the udf returns @TRUE if sString2 is equal to the first characters in sString1, otherwise @FALSE.
; If iLength is specified, sString2 must be at least length characters long or @FALSE will be returned.
;..........................................................................................................................................
; Detlev Dalitz.20010729
;..........................................................................................................................................
#EndFunction
:skip_udfisabbrev
;------------------------------------------------------------------------------------------------------------------------------------------
; --- test ---
iIsAbbrev1 = '"WinBatch" ,"WinBat" ,-4' ; 1 = @TRUE, negative number is forced to zero.
iIsAbbrev2 = '"WinBatch" ,"WinBat" ,0 ' ; 1 = @TRUE
iIsAbbrev3 = '"WinBatch" ,"WinBot" ,0 ' ; 0 = @FALSE
iIsAbbrev4 = '"WinBatch" ,"WinBot" ,4 ' ; 1 = @TRUE
iIsAbbrev5 = '"WinBatch" ,"Wi" ,3 ' ; 0 = @FALSE
iIsAbbrev6 = '"WinBatch" ,"" ,0 ' ; 1 = @TRUE
iIsAbbrev7 = '"WinBatch" ,"" ,1 ' ; 0 = @FALSE
sResult = ""
For i=1 To 7
test = iIsAbbrev%i%
sResult%i% = udfIsAbbrev(%test%)
sResult = StrCat(sResult,sResult%i%)
Next
If (sResult == "1101010") Then Message("","Test ok.")
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
;*EOF*
|
|
|
udfStrCmpVersion (sString1, sString2, sDelim, iMatchCase) |
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstrcmpversion",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfstrcmpversion
#DefineFunction udfStrCmpVersion (sString1, sString2, sDelim, iMatchCase)
sPad = "0"
iMatchCase = Min(1,Max(0,iMatchCase))
iCount1 = ItemCount(sString1,sDelim)
iCount2 = ItemCount(sString2,sDelim)
iCountMax = Max(iCount1,iCount2)
iItemLen = 1 + Max((StrLen(sString1)/iCount1),(StrLen(sString2)/iCount2))
sStringCmp1 = ""
sStringCmp2 = ""
For iCount=1 To iCountMax
sStringCmp1 = StrFixLeft(ItemExtract(iCount,sString1,sDelim),sPad,iItemLen)
sStringCmp2 = StrFixLeft(ItemExtract(iCount,sString2,sDelim),sPad,iItemLen)
If iMatchCase
iResult = StrCmp(sStringCmp1,sStringCmp2)
Else
iResult = StriCmp(sStringCmp1,sStringCmp2)
EndIf
If iResult Then Break
Next
Return (iResult)
;..........................................................................................................................................
; This function "udfStrCmpVersion" compares two "version strings".
;
; A "version string" is a string composed by sequences of numbers and/or characters,
; which are delimited, for example, by a single period character, e.g. "1.11.1111" or "2002.abc".
; The given strings are evaluated from left to right.
;
; This udf returns an integer value -1, 0, or 1,
; depending on whether sString1 is less than, equal to, or greater than sString2.
;..........................................................................................................................................
; Detlev Dalitz.20020125.20020817
;..........................................................................................................................................
#EndFunction
:skip_udfstrcmpversion
;------------------------------------------------------------------------------------------------------------------------------------------
; --- test ---
; Test 1: Version1 is less than version2.
sString11 = "9.900.09"
sString12 = "10.40.0101"
; Test 2: Version1 is greater than version2.
sString21 = "10.900"
sString22 = "10.40.0101"
; Test 3: Version1 is equal to version2.
sString31 = "10.900"
sString32 = "10.000900"
; Test 4:
; Version1 is greater than version2 if matchcase is 1 (@TRUE).
; Version1 is equal to version2 if matchcase is 0 (@FALSE).
sString41 = "2002A"
sString42 = "2002a"
; Test 5:
; Version1 is greater than version2.
sString51 = "5.6.0.6626"
sString52 = "5.6.0.1111"
sDelim = "."
iMatchCase = 1
;iMatchCase = 0
sRelationList = "less than,equal to,greater than"
For i=1 To 5
sString1 = sString%i%1
sString2 = sString%i%2
sRelation = ItemExtract(2 + udfStrCmpVersion(sString1,sString2,sDelim,iMatchCase),sRelationList,",")
sMsgText = ""
sMsgText = StrCat(sMsgText,'Test ',i,@CRLF)
sMsgText = StrCat(sMsgText,'Version1 = "',sString1,'"',@CRLF)
sMsgText = StrCat(sMsgText,'Version2 = "',sString2,'"',@CRLF)
sMsgText = StrCat(sMsgText,'Version1 is ',sRelation,' Version2',@CRLF)
Message("Demo udfStrCmpVersion (sString1, sString2, iMatchCase)",sMsgText)
Next
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
;*EOF*
|
|
|
udfStrTrimLeft (sString)
|
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstrtrimleft",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfstrtrimleft
#DefineFunction udfStrTrimLeft (sString)
If (sString=="") Then Return (sString)
Return (StrSub(sString,StrIndex(sString,StrTrim(sString),0,@FWDSCAN),-1))
; Detlev Dalitz.20020130
#EndFunction
:skip_udfstrtrimleft
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstrtrimright",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfstrtrimright
#DefineFunction udfStrTrimRight (sString)
If (sString=="") Then Return (sString)
sTemp = StrTrim(sString)
Return (StrSub(sString,1,StrIndex(sString,sTemp,0,@FWDSCAN)+StrLen(sTemp)-1))
; Detlev Dalitz.20020130
#EndFunction
:skip_udfstrtrimright
;------------------------------------------------------------------------------------------------------------------------------------------
;--- test ---
sStringIn = " 1 2 3 test %TAB% "
sStringOut = udfStrTrimLeft (sStringIn)
sMsgTitle = "Demo udfStrTrimLeft (str)"
sMsgText = StrCat('StringIn',@TAB,'= "',sStringIn,'"',@CRLF,'StringOut',@TAB,'= "',sStringOut,'"')
Message(sMsgTitle,sMsgText)
sStringOut = udfStrTrimRight (sStringIn)
sMsgTitle = "Demo udfStrTrimRight (str)"
sMsgText = StrCat('StringIn',@TAB,'= "',sStringIn,'"',@CRLF,'StringOut',@TAB,'= "',sStringOut,'"')
Message(sMsgTitle,sMsgText)
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
|
|
|
udfStrTrimHead (sString)
|
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstrtrimhead",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfstrtrimhead
#DefineFunction udfStrTrimHead (sString)
sLen=StrLen(sString)
For iPos=1 To sLen
sChar=StrSub(sString,iPos,1)
If sChar==" " Then Continue
If sChar==@TAB Then Continue
Break
Next
Return (StrSub(sString,iPos,-1))
#EndFunction
:skip_udfstrtrimhead
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstrtrimtail",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfstrtrimtail
#DefineFunction udfStrTrimTail (sString)
sLen=StrLen(sString)
For iPos=sLen To 1 By -1
sChar=StrSub(sString,iPos,1)
If sChar==" " Then Continue
If sChar==@TAB Then Continue
Break
Next
Return (StrSub(sString,1,iPos))
#EndFunction
:skip_udfstrtrimtail
;------------------------------------------------------------------------------------------------------------------------------------------
;--- test ---
sStringIn = " 1 2 3 test %@TAB% "
sStringOut = udfStrTrimHead (sStringIn)
sMsgTitle = "Demo udfStrTrimHead (sString)"
sMsgText = StrCat('StringIn',@TAB,'= "',sStringIn,'"',@CRLF,'StringOut',@TAB,'= "',sStringOut,'"')
Message(sMsgTitle,sMsgText)
sStringOut = udfStrTrimTail (sStringIn)
sMsgTitle = "Demo udfStrTrimTail (sString)"
sMsgText = StrCat('StringIn',@TAB,'= "',sStringIn,'"',@CRLF,'StringOut',@TAB,'= "',sStringOut,'"')
Message(sMsgTitle,sMsgText)
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
;*EOF*
|
|
|
udfPathUndecorate (sPathStr) |
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfpathundecorate",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfpathundecorate
#DefineFunction udfPathUndecorate (sPathStr)
iMAX_PATH = 260
hBB = BinaryAlloc(iMAX_PATH)
BinaryPokeStr(hBB,0,sPathStr)
DllCall(StrCat(DirWindows(1),"SHLWAPI.DLL"),long:"PathUndecorateA",lpbinary:hBB)
sPathStr = BinaryPeekStr(hBB,0,iMAX_PATH)
BinaryFree(hBB)
Return (sPathStr)
;..........................................................................................................................................
; This function "udfPathUndecorate" removes the decoration from a path string.
; A decoration consists of a pair of square brackets with one or more digits in between,
; inserted immediately after the base name and before the file name extension.
;
; The following table illustrates how strings are modified by PathUndecorate.
; Initial String Undecorated String
; C:\Path\File[5].txt C:\Path\File.txt
; C:\Path\File[12] C:\Path\File
; C:\Path\File.txt C:\Path\File.txt
; C:\Path\[3].txt C:\Path\[3].txt
;
; Requires minimum Version 5.00 of SHLWAPI.DLL
;
;..........................................................................................................................................
; Detlev Dalitz.20010827
;..........................................................................................................................................
#EndFunction
:skip_udfpathundecorate
;------------------------------------------------------------------------------------------------------------------------------------------
;--- test ---
sPathStr1 = "C:\Path\File[5].txt" ; ==> "C:\Path\File.txt"
sPathStr2 = "C:\Path\File[12]" ; ==> "C:\Path\File"
sPathStr3 = "C:\Path\File.txt" ; ==> "C:\Path\File.txt"
sPathStr4 = "C:\Path\[3].txt" ; ==> "C:\Path\[3].txt"
sPathStr5 = "C:\Path\777[7].File(1)[3].txt" ; ==> "C:\Path\777[7].File(1).txt"
sMsgTitel = "Demo udfPathUndecorate (sPathStr)"
sMsgText = ""
sMsgText = StrCat(sMsgText,sPathStr1,@LF,udfPathUndecorate(sPathStr1),@LF,@LF)
sMsgText = StrCat(sMsgText,sPathStr2,@LF,udfPathUndecorate(sPathStr2),@LF,@LF)
sMsgText = StrCat(sMsgText,sPathStr3,@LF,udfPathUndecorate(sPathStr3),@LF,@LF)
sMsgText = StrCat(sMsgText,sPathStr4,@LF,udfPathUndecorate(sPathStr4),@LF,@LF)
sMsgText = StrCat(sMsgText,sPathStr5,@LF,udfPathUndecorate(sPathStr5),@LF,@LF)
Message(sMsgTitel,sMsgText)
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
;*EOF*
|
|
|
How to remove tabs and spaces from a string? |
;------------------------------------------------------------------------------------------------------------------------------------------
; How to remove tabs and spaces from a string.
;------------------------------------------------------------------------------------------------------------------------------------------
; This is a collection of six different algorithms
; including a performancetest.
;------------------------------------------------------------------------------------------------------------------------------------------
; Detlev Dalitz.20020201
;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfStrRemoveTabSpace_1 (str)
len = StrLen(str)
OutStr = ""
i = 1
While (i <= len)
While (i < len) && (StrClean(StrSub(str,i,2),StrCat(@TAB," "),"",@FALSE,1) == "")
i = i + 1
EndWhile
OutStr = StrCat(OutStr,StrSub(str,i,1))
i = i + 1
EndWhile
Return (OutStr)
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfStrRemoveTabSpace_2 (str)
str = StrReplace(str,@TAB," ")
While @TRUE
lenpre = StrLen(str)
str = StrReplace(str," "," ")
lenpost = StrLen(str)
If (lenpre==lenpost) Then Break
EndWhile
Return (str)
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfStrRemoveTabSpace_3 (str)
str = StrReplace(str,@TAB," ")
lenpost = StrLen(str)
lenpre = lenpost + 1
While (lenpre>lenpost)
lenpre = lenpost
str = StrReplace(str," "," ")
lenpost = StrLen(str)
EndWhile
Return (str)
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfStrRemoveTabSpace_4 (str)
str = StrClean(str,@TAB," ",@FALSE,1)
While StrIndex(str," ",1,@FWDSCAN)
str = StrReplace(str," "," ")
EndWhile
Return (str)
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfStrRemoveTabSpace_5 (str) ; This udf seems to be the fastest.
str = StrReplace(str,@TAB," ")
While StrIndex(str," ",1,@FWDSCAN)
str = StrReplace(str," "," ")
EndWhile
Return (str)
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfStrRemoveTabSpace_6 (str)
bb = BinaryAlloc(StrLen(str))
BinaryPokeStr(bb,0,str)
BinaryReplace(bb,@TAB," ",@FALSE)
While (BinaryReplace(bb," "," ",@FALSE) > 1)
EndWhile
str = BinaryPeekStr(bb,0,BinaryEodGet(bb))
BinaryFree(bb)
Return (str)
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------
;--- test ---
msgtitle = "Demo udfStrRemoveTabSpace Performance Test"
TestStr = StrCat(@TAB,@TAB,@TAB,@TAB," Hi there. ")
TestLoop = 100
MaxTests = 6
For t=1 To MaxTests
Display(1,msgtitle,"Running Test %t%, please wait ...")
Exclusive(@ON)
start = GetTickCount()
For i=1 To TestLoop
str = udfStrRemoveTabSpace_%t% (TestStr)
Next
stop = GetTickCount()
Exclusive(@ON)
Ticks%t% = stop-start
Next
MaxTicks = 0
For t=1 To MaxTests
MaxTicks = Max(MaxTicks,Ticks%t%)
Next
For t=1 To MaxTests
Pct%t% = 100*Ticks%t%/MaxTicks
Next
msgtext = ""
For t=1 To MaxTests
msgtext = StrCat(msgtext,"Test ",t,@TAB,"Ticks = ",@TAB,Ticks%t%,@TAB,Pct%t%," %%",@CRLF)
Next
ClipPut(msgtext)
Message(msgtitle,msgtext)
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
; WinBatch Studio Debug
; Test 1 Ticks = 73098 100 %
; Test 2 Ticks = 16307 22 %
; Test 3 Ticks = 17598 24 %
; Test 4 Ticks = 9515 13 %
; Test 5 Ticks = 9358 12 % <== The Winner.
; Test 6 Ticks = 9928 13 %
;------------------------------------------------------------------------------------------------------------------------------------------
; WinBatch Studio Run
; Test 1 Ticks = 10586 100 %
; Test 2 Ticks = 1955 18 %
; Test 3 Ticks = 1764 16 %
; Test 4 Ticks = 1324 12 %
; Test 5 Ticks = 1284 12 % <== The Winner.
; Test 6 Ticks = 1684 15 %
;------------------------------------------------------------------------------------------------------------------------------------------
;*EOF*
|
|
|
udfStrReverse (sString)
|
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstrreverse_1",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfstrreverse_1
#DefineFunction udfStrReverse_1 (str)
len=StrLen(str)
OutStr=""
For i=len To 1 By -1
OutStr=StrCat(OutStr,StrSub(str,i,1))
Next
Return (OutStr)
;..........................................................................................................................................
; Returns string reversed.
; Backward reading.
; "0123456789" <==> "9876543210"
;..........................................................................................................................................
#EndFunction
:skip_udfstrreverse_1
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstrreverse_2",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfstrreverse_2
#DefineFunction udfStrReverse_2 (str)
len=StrLen(str)
len1=len+1
len2=len/2
bb=BinaryAlloc(len1)
BinaryPokeStr(bb,1,str)
For i=1 To len2
BinaryCopy(bb,0,bb,len1-i,1)
BinaryCopy(bb,len1-i,bb,i,1)
BinaryCopy(bb,i,bb,0,1)
Next
str=BinaryPeekStr(bb,1,len)
BinaryFree(bb)
Return (str)
;..........................................................................................................................................
; Returns string reversed.
; Swapping.
; "0123456789" <==> "9876543210"
;..........................................................................................................................................
#EndFunction
; Etwa 1,5 mal langsamer als udfStrReverse_1 !
:skip_udfstrreverse_2
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstrreverse_3",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfstrreverse_3
#DefineFunction udfStrReverse_3 (str)
len=StrLen(str)
bb=BinaryAlloc(len)
BinaryPokeStr(bb,0,str)
For j=len-1 To 1 By -1
For i=0 To j-1
BinaryPoke(bb,i,BinaryPoke(bb,i+1,BinaryPeek(bb,i)))
Next
Next
str=(BinaryPeekStr(bb,0,len))
BinaryFree(bb)
Return (str)
;..........................................................................................................................................
; Returns string reversed.
; Swapping.
; "0123456789" <==> "9876543210"
;..........................................................................................................................................
#EndFunction
; Etwa 70 mal langsamer als udfStrReverse_1 !!!
:skip_udfstrreverse_3
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstrreverse_4",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfstrreverse_4
#DefineFunction udfStrReverse_4 (str)
len=StrLen(str)
A=ArrDimension(len + 1)
For i=1 To len
A[i]=StrSub(str,i,1)
Next
For j=len To 1 By -1
For i=1 To j-1
A[0]=A[i]
A[i]=A[i+1]
A[i+1]=A[0]
Next
Next
str=""
For i=1 To len
str=StrCat(str,A[i])
Next
Drop (A)
Return (str)
;..........................................................................................................................................
; Returns string reversed.
; Swapping.
; "0123456789" <==> "9876543210"
;..........................................................................................................................................
#EndFunction
; Etwa 50 mal langsamer als udfStrReverse_1 !!
:skip_udfstrreverse_4
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udsstrreverse_5",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udsstrreverse_5
#DefineFunction udfStrReverse_5 (str,i,len)
j = 1 + len - i
If (i < j)
ch = StrSub(str,i,1)
str = StrCat(StrSub(str,1,i-1),StrSub(str,j,1),StrSub(str,i+1,-1))
str = StrCat(StrSub(str,1,j-1),ch,StrSub(str,j+1,-1))
str = udfStrReverse_5 (str,i+1,len)
EndIf
Return (str)
;..........................................................................................................................................
; Returns string reversed.
; Recursive.
; "0123456789" <==> "9876543210"
;..........................................................................................................................................
#EndFunction
;
:skip_udsstrreverse_5
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfisstrpalindrome",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfisstrpalindrome
#DefineFunction udfIsStrPalindrome (sString)
If sString=="" Then Return @FALSE
iStrLen = 1+StrLen(sString)
iMid = iStrLen/2
For i=1 To iMid
If StrSub(sString,i,1)<>StrSub(sString,iStrLen-i,1) Then Return @FALSE
Next
Return @TRUE
;..........................................................................................................................................
; This Function "udfIsPalindrome" returns a boolean value
; which indicates if a given string is a Palindrome or not.
; A Palindrome is a string which can be read either from left to right and from right to left.
; For Example: "madam".
;..........................................................................................................................................
#EndFunction
:skip_udfisstrpalindrome
;------------------------------------------------------------------------------------------------------------------------------------------
;goto test2
; --- test ---
:test1
IsPalindrome1 = udfIsStrPalindrome("madam")
IsPalindrome2 = udfIsStrPalindrome("mad adam")
:test2
; TestStr = "REGEN"
; TestStr = "EINNEGERMITGAZELLEZAGTIMREGENNIE"
; TestStr = "RADAR"
; TestStr = "CIVIC"
; TestStr = "ABBA"
; TestStr = "A man, a plan, a canal, Panama."
; TestStr = "madam"
; TestStr = "Lid off a daffodil"
; TestStr = "Norma is as selfless as I am, Ron"
TestStr = "0123456789"
; str1 = udfStrReverse_1 (TestStr)
; str2 = udfStrReverse_2 (TestStr)
; str3 = udfStrReverse_3 (TestStr)
; str4 = udfStrReverse_4 (TestStr)
str5 = udfStrReverse_5 (TestStr,1,StrLen(TestStr))
:Performancetest
msgtitle = "Demo udfStrReverse (str) Performance Test"
BoxOpen(msgtitle,"")
TestStr = "A man, a plan, a canal, Panama."
TestLoop = 10
:Testloop
MaxTests = 4
For t=1 To MaxTests
BoxText("Running Test %t%, please wait ...")
Exclusive(@ON)
start = GetTickCount()
For i=1 To TestLoop
str = udfStrReverse_%t% (TestStr)
Next
stop = GetTickCount()
Exclusive(@OFF)
Ticks%t% = stop-start
Next
:Test5
MaxTests = 5
t=5
BoxText("Running Test %t%, please wait ...")
Exclusive(@ON)
start = GetTickCount()
For i=1 To TestLoop
str = udfStrReverse_%t% (TestStr,1,StrLen(TestStr))
Next
stop = GetTickCount()
Exclusive(@OFF)
Ticks%t% = stop-start
:Result
MaxTicks = 0
For t=1 To MaxTests
MaxTicks = Max(MaxTicks,Ticks%t%)
Next
For t=1 To MaxTests
Pct%t% = 100*Ticks%t%/MaxTicks
Next
msgtext = ""
For t=1 To MaxTests
msgtext = StrCat(msgtext,"Test ",t,@TAB,"Ticks = ",@TAB,Ticks%t%,@TAB,Pct%t%," %%",@CRLF)
Next
BoxButtonDraw(1,1,"&OK","20,780,980,950")
BoxText(msgtext)
While !BoxButtonStat(1,1)
EndWhile
ClipPut(msgtext)
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
; WinBatch Studio Run
; Test 1 Ticks = 1775 3 % <== The Winner.
; Test 2 Ticks = 2620 4 %
; Test 3 Ticks = 53585 100 %
; Test 4 Ticks = 39225 73 %
; Test 5 Ticks = 4875 9 %
;------------------------------------------------------------------------------------------------------------------------------------------
;*EOF*
|
|
|
udfStrCapitalize (str) |
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstrcap_1",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfstrcap_1
#DefineFunction udfStrCap_1 (str)
len=StrLen(str)
If (len==0) Then Return("")
flag=@TRUE
cap=""
For i=1 To len
ch=StrSub(str,i,1)
If flag
cap=StrCat(cap,StrUpper(ch))
Else
cap=StrCat(cap,ch)
EndIf
flag=(ch==" ")
Next
Return (cap)
#EndFunction
:skip_udfstrcap_1
;------------------------------------------------------------------------------------------------------------------------------------------
; --- test ---
InStr = "To be OR NOT to be" ; "To Be OR NOT To Be"
CapStr = udfStrCap_1 (InStr)
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstrcap_2",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfstrcap_2
#DefineFunction udfStrCap_2 (str)
len=StrLen(str)
x=1
While 1
While 1
st2=StrSub(str,x,1)
If st2<>" " || x==len Then Break
x=x+1
EndWhile
str=StrCat(StrFixChars(str,"",x-1),StrUpper(st2),StrFixCharsL(str,"",len-x))
While 1
st3=StrSub(str,x,1)
If st3==" " || x==len Then Break
x=x+1
EndWhile
If x==len Then Break
EndWhile
Return str
#EndFunction
:skip_udfstrcap_2
;------------------------------------------------------------------------------------------------------------------------------------------
; --- test ---
InStr = "To be OR NOT to be"
CapStr = udfStrCap_2 (InStr) ; "To Be OR NOT To Be"
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstrcap_3",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfstrcap_3
#DefineFunction udfStrCap_3 (str)
item_count=ItemCount(str," ")
For i=1 To item_count
item=ItemExtract(i,str," ")
If (item<>"")
first=StrSub(item,1,1)
first=StrUpper(first)
other=StrSub(item,2,-1)
item=StrCat(first,other)
str=ItemReplace(item,i,str," ")
EndIf
Next
Return (str)
#EndFunction
:skip_udfstrcap_3
;------------------------------------------------------------------------------------------------------------------------------------------
; --- test ---
InStr = "To be OR NOT to be"
CapStr = udfStrCap_3 (InStr) ; "To Be OR NOT To Be"
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstrcap_4",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfstrcap_4
#DefineFunction udfStrCap_4 (sString) ; This algorithm seems to be the fastest.
sStrOut=""
While sString>""
sStrOut=ItemInsert(StrCat(StrUpper(StrSub(ItemExtract(1,sString," "),1,1)),StrSub(StrLower(ItemExtract(1,sString," ")),2,-1)),-1,sStrOut," ")
sString=ItemRemove(1,sString," ")
EndWhile
Return sStrOut
#EndFunction
:skip_udfstrcap_4
;------------------------------------------------------------------------------------------------------------------------------------------
; --- test ---
InStr = "To be OR NOT to be"
CapStr = udfStrCap_4 (InStr) ; "To Be Or Not To Be"
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstrcap_5",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfstrcap_5
#DefineFunction udfStrCap_5 (str)
pcStr=''
While (str<>'')
item=ItemExtract(1,str,' ')
first=StrSub(item,1,1)
first=StrUpper(first)
other=StrSub(item,2,-1)
other=StrLower(other)
item=StrCat(first,other)
pcStr=ItemInsert(item,-1,pcStr,' ')
str=ItemRemove(1,str,' ')
EndWhile
Return pcStr
#EndFunction
:skip_udfstrcap_5
;------------------------------------------------------------------------------------------------------------------------------------------
; --- test ---
InStr = "To be OR NOT to be"
CapStr = udfStrCap_5 (InStr) ; "To Be Or Not To Be"
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstrcap_6",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfstrcap_6
#DefineFunction udfStrCap_6 (str)
x=0
len=StrLen(str)
buf=BinaryAlloc(len+100)
BinaryPokeStr(buf,0,str)
y=0
While 1
While 1
st2=BinaryPeekStr(buf,x,1)
st5=BinaryIndexEx(buf,y,@CRLF,@FWDSCAN,0)
If st5<>-1
BinaryPokeStr(buf,st5+2,StrUpper(BinaryPeekStr(buf,st5+2,1)))
y=st5+2
EndIf
If st2<>" " || x==len Then Break
x=x+1
EndWhile
BinaryPokeStr(buf,x,StrUpper(st2))
While 1
st3=BinaryPeekStr(buf,x,1)
If st3==" " || x==len Then Break
x=x+1
EndWhile
If x==len Then Break
EndWhile
str=BinaryPeekStr(buf,0,len)
Return str
#EndFunction
:skip_udfstrcap_6
;------------------------------------------------------------------------------------------------------------------------------------------
; --- test ---
InStr = "To be OR NOT to be"
CapStr = udfStrCap_6 (InStr) ; "To Be OR NOT To Be"
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstrcap_7",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfstrcap_7
#DefineFunction udfStrCap_7 (sString)
iLen = StrLen(sString)
If !iLen Then Return ("")
sOut = StrUpper(StrSub(sString,1,1))
For i=2 To iLen
If StrIndex(" ,.:;-=<>?!/()[]{}",StrSub(sString,i-1,1),1,@FWDSCAN) Then sOut = StrCat(sOut,StrUpper(StrSub(sString,i,1)))
Else sOut = StrCat(sOut,StrSub(sString,i,1))
Next
Return (sOut)
#EndFunction
:skip_udfstrcap_7
;------------------------------------------------------------------------------------------------------------------------------------------
; --- test ---
InStr = "To be OR NOT to be"
CapStr = udfStrCap_7 (InStr) ; "To Be OR NOT To Be"
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udffilecap",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udffilecap
#DefineFunction udfFileCap (InFilename, OutFilename)
fsize=FileSize(InFilename)
If (fsize==0) Then Return ("")
bb=BinaryAlloc(fsize+2)
BinaryPokeStr(bb,0," ") ; Insert one blank character.
BinaryPokeStr(bb,fsize+1," ") ; Append one blank character.
BinaryReadEx(bb,1,InFilename,0,fsize)
BinaryConvert(bb,0,0,0,2) ; Convert to lowercase.
For i=65 To 90 ; "A" to "Z"
ch=Num2Char(i)
str=StrCat(@TAB,ch)
BinaryReplace(bb,str,str,@FALSE)
str=StrCat(@CR,ch)
BinaryReplace(bb,str,str,@FALSE)
str=StrCat(@LF,ch)
BinaryReplace(bb,str,str,@FALSE)
str=StrCat(" ",ch)
BinaryReplace(bb,str,str,@FALSE)
str=StrCat("-",ch)
BinaryReplace(bb,str,str,@FALSE)
str=StrCat("=",ch)
BinaryReplace(bb,str,str,@FALSE)
str=StrCat(",",ch)
BinaryReplace(bb,str,str,@FALSE)
str=StrCat(".",ch)
BinaryReplace(bb,str,str,@FALSE)
str=StrCat(":",ch)
BinaryReplace(bb,str,str,@FALSE)
str=StrCat("?",ch)
BinaryReplace(bb,str,str,@FALSE)
str=StrCat("!",ch)
BinaryReplace(bb,str,str,@FALSE)
str=StrCat("/",ch)
BinaryReplace(bb,str,str,@FALSE)
str=StrCat("(",ch)
BinaryReplace(bb,str,str,@FALSE)
str=StrCat(")",ch)
BinaryReplace(bb,str,str,@FALSE)
str=StrCat("[",ch)
BinaryReplace(bb,str,str,@FALSE)
str=StrCat("]",ch)
BinaryReplace(bb,str,str,@FALSE)
str=StrCat("{",ch)
BinaryReplace(bb,str,str,@FALSE)
str=StrCat("}",ch)
BinaryReplace(bb,str,str,@FALSE)
str=StrCat("'",ch)
BinaryReplace(bb,str,str,@FALSE)
str=StrCat('"',ch)
BinaryReplace(bb,str,str,@FALSE)
Next
BinaryWriteEx(bb,0,OutFilename,0,-1) ; Create new file.
num=BinaryWriteEx(bb,1,OutFilename,0,fsize) ; Discard added blanks.
BinaryFree(bb)
Return (num)
#EndFunction
:skip_udffilecap
;------------------------------------------------------------------------------------------------------------------------------------------
; --- test ---
InFilename = IntControl(1004,0,0,0,0) ; Use this script as test input.
OutFilename = FileCreateTemp("TMP")
num = udfFileCap (InFilename, OutFilename)
RunZoomWait("notepad",OutFilename)
FileDelete(OutFilename)
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
:Performancetest
msgtitle = "Demo udfStrCap (str) Performance Test"
TestStr = StrCat("To be",@TAB,"OR NOT",@TAB,"to be")
TestLoop = 50
MaxTests = 7
For t=1 To MaxTests
Display(1,msgtitle,"Running Test %t%, please wait ...")
Exclusive(@ON)
start = GetTickCount()
For i=1 To TestLoop
str = udfStrCap_%t% (TestStr)
Next
stop = GetTickCount()
Exclusive(@OFF)
Ticks%t% = stop-start
Next
MaxTicks = 0
For t=1 To MaxTests
MaxTicks = Max(MaxTicks,Ticks%t%)
Next
For t=1 To MaxTests
Pct%t% = 100*Ticks%t%/MaxTicks
Next
msgtext = ""
For t=1 To MaxTests
msgtext = StrCat(msgtext,"Test ",t,@TAB,"Ticks = ",@TAB,Ticks%t%,@TAB,Pct%t%," %%",@CRLF)
Next
Message(msgtitle,msgtext)
ClipPut(msgtext)
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
; Test in WinBatch Studio Debug Mode
; Test 1 Ticks = 14082 81 %
; Test 2 Ticks = 13883 80 %
; Test 3 Ticks = 5511 31 %
; Test 4 Ticks = 2828 16 % <== The Winner.
; Test 5 Ticks = 5574 32 %
; Test 6 Ticks = 17323 100 %
; Test 7 Ticks = 9151 52 %
;------------------------------------------------------------------------------------------------------------------------------------------
; Test in WinBatch Studio Run Mode
; Test 1 Ticks = 3529 67 %
; Test 2 Ticks = 3977 76 %
; Test 3 Ticks = 1810 34 %
; Test 4 Ticks = 1164 22 % <== The Winner.
; Test 5 Ticks = 1839 35 %
; Test 6 Ticks = 5218 100 %
; Test 7 Ticks = 3480 66 %
;------------------------------------------------------------------------------------------------------------------------------------------
; Detlev Dalitz.20030210
;------------------------------------------------------------------------------------------------------------------------------------------
;*EOF*
|
|
|
udfStrTranslate (sString, sTableOut, sTableIn, sPad) |
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstrtranslate_1",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfStrTranslate_1
#DefineFunction udfStrTranslate_1 (sString, sTableOut, sTableIn, sPad) ; speed performance = low = 100 pct.
If (sTableOut=="") Then If (sTableIn=="") Then Return (StrUpper(sString))
If (sPad=="") Then sPad = " "
hBBTable = BinaryAlloc(256)
For i=0 To 255
BinaryPoke(hBBTable,i,i)
Next
iLenString = StrLen(sString)
iLenIn = StrLen(sTableIn)
sTableOut = StrFix(sTableOut,sPad,iLenIn)
iLenOut = StrLen(sTableOut)
For i=1 To iLenIn
BinaryPoke(hBBTable,Char2Num(StrSub(sTableIn,i,1)),Char2Num(StrSub(sTableOut,i,1)))
Next
sOut = ""
For i=1 To iLenString
sOut = StrCat(sOut,Num2Char(BinaryPeek(hBBTable,Char2Num(StrSub(sString,i,1)))))
Next
BinaryFree(hBBTable)
Return (sOut)
; Detlev Dalitz.20020219
#EndFunction
:skip_udfStrTranslate_1
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstrtranslate_2",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfstrtranslate_2
#DefineFunction udfStrTranslate_2 (sString, sTableOut, sTableIn, sPad) ; speed performance = middle = 92..96 pct.
If (sTableOut=="") Then If (sTableIn=="") Then Return (StrUpper(sString))
If (sPad=="") Then sPad = " "
hBBTable = BinaryAlloc(256)
For i=0 To 255
BinaryPoke(hBBTable,i,i)
Next
iLenString = StrLen(sString)
iLenIn = StrLen(sTableIn)
sTableOut = StrFix(sTableOut,sPad,iLenIn)
iLenOut = StrLen(sTableOut)
hBBString = BinaryAlloc(iLenString)
hBBOut = BinaryAlloc(iLenOut)
hBBIn = BinaryAlloc(iLenIn)
BinaryPokeStr(hBBString,0,sString)
BinaryPokeStr(hBBOut,0,sTableOut)
BinaryPokeStr(hBBIn,0,sTableIn)
ilen = iLenIn-1
For i=0 To ilen
BinaryCopy(hBBTable,BinaryPeek(hBBIn,i),hBBOut,i,1)
Next
BinaryXlate(hBBString,hBBTable,0)
sOut = BinaryPeekStr(hBBString,0,iLenString)
BinaryFree(hBBTable)
BinaryFree(hBBString)
BinaryFree(hBBOut)
BinaryFree(hBBIn)
Return (sOut)
; Detlev Dalitz.20020219
#EndFunction
:skip_udfstrtranslate_2
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstrtranslate_3",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfstrtranslate_3
#DefineFunction udfStrTranslate_3 (sString, sTableOut, sTableIn, sPad)
If (sTableOut=="") Then If (sTableIn=="") Then Return (StrUpper(sString))
If (sPad=="") Then sPad = " "
aArray = ArrDimension(256)
For i=0 To 255
aArray[i] = i
Next
iLenString = StrLen(sString)
iLenIn = StrLen(sTableIn)
sTableOut = StrFix(sTableOut,sPad,iLenIn)
iLenOut = StrLen(sTableOut)
For i=1 To iLenIn
aArray[Char2Num(StrSub(sTableIn,i,1))] = Char2Num(StrSub(sTableOut,i,1))
Next
sOut = ""
For i=1 To iLenString
sOut = StrCat(sOut,Num2Char(aArray[Char2Num(StrSub(sString,i,1))]))
Next
Drop(aArray)
Return (sOut)
; Detlev Dalitz.20020219
#EndFunction
:skip_udfstrtranslate_3
;------------------------------------------------------------------------------------------------------------------------------------------
; --- test ---
sMsgTitle = "Demo udfStrTranslate (sString, sTableOut, sTableIn, sPad)"
sMsgText = ""
TestItem = 'udfStrTranslate_3 ("abczyx", "", "", "")'
sMsgText = StrCat(sMsgText,`%TestItem%`,@TAB,' = ',%TestItem%,@LF) ; ABCZYX
TestItem = 'udfStrTranslate_3 ("abzyx!", "1234?", "abcd!","")'
sMsgText = StrCat(sMsgText,`%TestItem%`,@TAB,' = ',%TestItem%,@LF) ; 12zyx?
TestItem = 'udfStrTranslate_3 ("5678/12/34", "mmddyyyy:", "12345678/", "")'
sMsgText = StrCat(sMsgText,`%TestItem%`,@TAB,' = ',%TestItem%,@LF) ; yyyy:mm:dd
TestItem = 'udfStrTranslate_3 ("1.22.333.4", "-", ".0123456789", "?")'
sMsgText = StrCat(sMsgText,`%TestItem%`,@TAB,' = ',%TestItem%,@LF) ; ?-??-???-?
TestItem = 'udfStrTranslate_3 ("1.2.3.4", "-0123456789", ".", "?")'
sMsgText = StrCat(sMsgText,`%TestItem%`,@TAB,' = ',%TestItem%,@LF) ; 1-2-3-4
Message(sMsgTitle,sMsgText)
;------------------------------------------------------------------------------------------------------------------------------------------
:Performancetest
sMsgTitle = "Demo udfStrTranslate (sString, sTableOut, sTableIn, sPad) Performance Test"
; TestItem = '("abcdefg", "", "", "")'
TestItem = '("5678/12/34", "12345678/", "mmddyyyy:", "")'
TestLoop = 10
MaxTests = 3
For t=1 To MaxTests
Display(1,sMsgTitle,"Running Test %t%, please wait ...")
Exclusive(@ON)
start = GetTickCount()
For i=1 To TestLoop
sResult = udfStrTranslate_%t% %TestItem%
Next
stop = GetTickCount()
Exclusive(@OFF)
Ticks%t% = stop-start
Next
MaxTicks = 0
For t=1 To MaxTests
MaxTicks = Max(MaxTicks,Ticks%t%)
Next
For t=1 To MaxTests
Pct%t% = 100*Ticks%t%/MaxTicks
Next
sMsgText = ""
For t=1 To MaxTests
sMsgText = StrCat(sMsgText,"Test ",t,@TAB,"Ticks = ",@TAB,Ticks%t%,@TAB,Pct%t%," %%",@LF)
Next
Message(sMsgTitle,sMsgText)
ClipPut(sMsgText)
; WinBatch Studio Run
;------------------------------------------------------------------------------------------------------------------------------------------
:Test_ROT13
; As an alternative to the function "udfStrROT13 (sString)".
sString = "# ABC -- WinBatch rotates *You* -- XYZ !"
sTableIn = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ'
sTableOut = 'nopqrstuvwxyzabcdefghijklmNOPQRSTUVWXYZABCDEFGHIJKLM'
sPad = ""
sRot = udfStrTranslate_3 (sString, sTableOut, sTableIn, sPad) ; "# NOP -- JvaOngpu ebgngrf *Lbh* -- KLM !"
sRotRot = udfStrTranslate_3 (sRot, sTableOut, sTableIn, sPad) ; "# ABC -- WinBatch rotates *You* -- XYZ !"
sMsgText = StrCat(sString,@LF,sRot,@LF,sRotRot)
Message(sMsgTitle,sMsgText)
;------------------------------------------------------------------------------------------------------------------------------------------
:Test_Remove_Accents
sString = "Šêñòr Žž Øçÿ íßt ÑËÜ."
sTableIn = "ŠŒŽšœžŸ¥µÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖØÙÚÛÜÝßàáâãäåæçèéêëìíîïðñòóôõöøùúûüýÿ"
sTableOut = "SOZsozYYuAAAAAAACEEEEIIIIDNOOOOOOUUUUYsaaaaaaaceeeeiiiionoooooouuuuyy"
sPad = ""
sTrans = udfStrTranslate_3 (sString, sTableOut, sTableIn, sPad) ; "Senor Zz Ocy ist NEU."
sMsgText = StrCat(sString,@LF,sTrans)
Message(sMsgTitle,sMsgText)
;------------------------------------------------------------------------------------------------------------------------------------------
:Test_Lowcase
; As an alternative to the not-yet-existing php function "stritr".
sString = "aBc"
sTableIn = "ABCabc"
sTableOut = "xyzxyz"
sPad = ""
sTrans = udfStrTranslate_3 (sString, sTableOut, sTableIn, sPad) ; "xyz"
sMsgText = StrCat(sString,@LF,sTrans)
Message(sMsgTitle,sMsgText)
;------------------------------------------------------------------------------------------------------------------------------------------
:Test_FormatNumberString
sString = "(abc) defg-hijk"
sTableIn = "abcdefghijk"
sTableOut = "12345678901"
sPad = ""
sTrans = udfStrTranslate_3 (sString, sTableOut, sTableIn, sPad)
sMsgText = StrCat(sString,@LF,sTrans)
Message(sMsgTitle,sMsgText)
;------------------------------------------------------------------------------------------------------------------------------------------
:Soundex
;----------------------------------------------------------
; Soundex und SoundexEx with udfStrTranslate()
;----------------------------------------------------------
Name = "Ashcraft"
Mode = 0 ; 0=normal, 1=extended Soundex.
Tabin = 'WHYEAUIOBFPVCGJKQSXZDTLMNR'
Tabout0 = '00000000111122222222334556'
Tabout1 = '00000000121234435355667889'
Soundex = StrClean(Name,Tabin,"",@FALSE,2)
Soundex = StrUpper(Soundex)
Soundex1 = StrSub(Soundex,1,1)
Soundex = udfStrTranslate_3(Soundex,Tabout%Mode%,Tabin,"")
Soundex = StrSub(Soundex,2,-1)
Soundex = StrCat(Soundex1,Soundex)
Soundex = StrReplace(Soundex,"0","")
i=2
While i<StrLen(Soundex)
Char = StrSub(Soundex,i,1)
Soundex = StrReplace(Soundex,StrCat(Char,Char),Char)
i=i+1
EndWhile
Soundex = StrFix(Soundex,"0",4+Mode)
Message(Name,Soundex)
;------------------------------------------------------------------------------------------------------------------------------------------
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
;*EOF*
|
|
|
udfStrReplaceNC (sourcestr, oldstr, newstr) |
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstrreplacenc_1",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfstrreplacenc_1
#DefineFunction udfStrReplaceNC_1 (sourcestr, oldstr, newstr)
lenin = StrLen(sourcestr)
lenold = StrLen(oldstr)
lennew = StrLen(newstr)
bbsize = lenin
If (lennew>lenold) Then bbsize = (1+(lenin/lenold))*lennew
bb = BinaryAlloc(bbsize)
BinaryPokeStr(bb,0,sourcestr)
BinaryReplace(bb,oldstr,newstr,@FALSE)
outstr = BinaryPeekStr(bb,0,BinaryEodGet(bb))
BinaryFree(bb)
Return (outstr)
;..........................................................................................................................................
; Adapted from
; Conf: WinBatch
; From: Marty marty+bbs@winbatch.com
; Date: Thursday, May 16, 2002 01:01 PM
;..........................................................................................................................................
; Slighty modified by Detlev Dalitz.20020517
;..........................................................................................................................................
#EndFunction
:skip_udfstrreplacenc_1
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstrreplacenc_2",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfstrreplacenc_2
#DefineFunction udfStrReplaceNC_2 (sourcestr, oldstr, newstr)
lenin = StrLen(sourcestr)
lenold = StrLen(oldstr)
pos = 1
While 1
pos = StrIndexNC(sourcestr,oldstr,pos,@FWDSCAN)
If !pos Then Break
sourcestr = StrCat(StrSub(sourcestr,1,pos-1),newstr,StrSub(sourcestr,pos+lenold,-1))
EndWhile
Return (sourcestr)
;..........................................................................................................................................
; Adapted from
; Conf: WinBatch
; From: billmeek winbatch@tfic.com
; Date: Thursday, May 16, 2002 01:24 PM
;..........................................................................................................................................
; Slighty modified by Detlev Dalitz.20020517
;..........................................................................................................................................
#EndFunction
:skip_udfstrreplacenc_2
;------------------------------------------------------------------------------------------------------------------------------------------
; --- test ---
sourcestr = " Hello Cat the dog said to the cAt"
oldstr = "cat"
newstr = "Sammy"
outstr = udfStrReplaceNC_1 (sourcestr, oldstr, newstr)
Message(sourcestr,outstr)
; ==> "Hello Sammy the dog said to the Sammy"
outstr = udfStrReplaceNC_2 (sourcestr, oldstr, newstr)
Message(sourcestr,outstr)
; ==> " Hello Sammy the dog said to the Sammy"
;------------------------------------------------------------------------------------------------------------------------------------------
:Performancetest
msgtitle = "Demo udfStrReplaceNC Performance Test"
sourcestr = " Hello Cat the dog said to the cAt"
oldstr = "cat"
newstr = "Sammy"
TestLoop = 200
Maxtests = 2
For t=1 To Maxtests
Display(1,msgtitle,"Running Test %t%, please wait ...")
Exclusive(@ON)
start = GetTickCount()
For i=1 To TestLoop
str = udfStrReplaceNC_%t% (sourcestr, oldstr, newstr)
Next
stop = GetTickCount()
Exclusive(@OFF)
Ticks%t% = stop-start
Next
MaxTicks = 0
For t=1 To MaxTests
MaxTicks = Max(MaxTicks,Ticks%t%)
Next
For t=1 To MaxTests
Pct%t% = 100*Ticks%t%/MaxTicks
Next
msgtext = ""
For t=1 To MaxTests
msgtext = StrCat(msgtext,"Test ",t,@TAB,"Ticks = ",@TAB,Ticks%t%,@TAB,Pct%t%," %%",@CRLF)
Next
Message(msgtitle,msgtext)
ClipPut(msgtext)
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
; WinBatch Studio Run
; Test 1 Ticks = 2668 84 % <== The Winner.
; Test 2 Ticks = 3167 100 %
;------------------------------------------------------------------------------------------------------------------------------------------
;*EOF*
|
|
|
udfStrNumThousands (numstr, mode) |
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstrnumthousands",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfstrnumthousands
#DefineFunction udfStrNumThousands (numstr, mode)
; #DefineFunction udfStrNumCommaize (numstr, mode)
If (numstr=="") Then Return (numstr)
If mode
point = "," ; European style
sep = "."
Else
point = "." ; American style
sep = ","
EndIf
numstr = StrClean(numstr,StrCat(point,"0123456789"),"",@TRUE,2) ; Allow digits and decimal point.
numle = ItemExtract(1,numstr,point)
numri = ItemExtract(2,numstr,point)
numle = StrSub(numle,StrScan(numle,"123456789",1,@FWDSCAN),-1) ; Delete leading zeroes.
numri = StrSub(numri,1,StrScan(numri,"123456789",StrLen(numri),@BACKSCAN)) ; Delete trailing zeroes.
If (numle == "")
outle = "0"
Else
outle = ""
len = StrLen(numle)
While (len > 3)
outle = ItemInsert(StrSub(numle,len-2,3),0,outle,sep)
numle = StrSub(numle,1,len-3)
len = StrLen(numle)
EndWhile
outle = ItemInsert(numle,0,outle,sep)
EndIf
numout = outle
If (numri == "")
; numri = "0"
Else
outri = ""
len = StrLen(numri)
While (len > 3)
outri = ItemInsert(StrSub(numri,1,3),-1,outri,sep)
numri = StrSub(numri,4,-1)
len = StrLen(numri)
EndWhile
numri = StrFix(numri,"0",3)
outri = ItemInsert(numri,-1,outri,sep)
numout = StrCat(outle,point,outri)
EndIf
Return (numout)
;..........................................................................................................................................
; This function returns a number string formatted in 3-digit packets ("Commaize").
; mode = 0 = American number style = "1,234.567,890"
; mode = 1 = European number style = "1.234,567.890"
;..........................................................................................................................................
; Detlev Dalitz.20020614
;..........................................................................................................................................
#EndFunction
:skip_udfstrnumthousands
;------------------------------------------------------------------------------------------------------------------------------------------
; --- test ---
number1 = "00001234567890000"
str1 = udfStrNumThousands (number1,0)
; ==> "1,234,567,890,000"
number2 = "00001234.567890000"
str2 = udfStrNumThousands (number2,0)
; ==> "1,234.567,890"
number3 = "0000123.4567890000"
str3 = udfStrNumThousands (number3,0)
; ==> "123.456,789"
msgtitle = "Demo udfStrNumThousands(numstr,mode)"
msgtext = ""
msgtext = StrCat(msgtext,number1,@TAB," = ",str1,@CRLF)
msgtext = StrCat(msgtext,number2,@TAB," = ",str2,@CRLF)
msgtext = StrCat(msgtext,number3,@TAB," = ",str3,@CRLF)
Message(msgtitle,msgtext)
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
;*EOF*
|
|
|
udfStrFormatByteSize (iNumber)
|
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstrformatbytesize",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfstrformatbytesize
#DefineFunction udfStrFormatByteSize (iNumber)
iBBSize = 16
hBB = BinaryAlloc(iBBSize)
BinaryEodSet(hBB,iBBSize)
sFormStr = ""
If DllCall(StrCat(DirWindows(1),"SHLWAPI.DLL"),long:"StrFormatByteSizeA",long:iNumber,lpbinary:hBB,long:iBBSize) Then sFormStr = BinaryPeekStr(hBB,0,iBBSize)
BinaryFree(hBB)
Return (sFormStr)
;..........................................................................................................................................
; Range for iNumber = 0..(2**32)-1
;..........................................................................................................................................
; StrFormatByteSizeA Function
; Converts a numeric value into a string that represents the number expressed
; as a size value in bytes, kilobytes, megabytes, or gigabytes, depending on the size.
;
; Syntax
; LPTSTR StrFormatByteSizeA(
; DWORD dw,
; LPSTR pszBuf,
; UINT cchBuf
; );
;
; Parameters
; dw
; [in] Numeric value to be converted.
;
; pszBuf
; [out] Pointer to the converted string.
;
; cchBuf
; [in] Size of pszBuf, in characters.
;
; Return Value
; Returns the address of the converted string, or NULL if the conversion fails.
;
; Remarks
; The first parameter of this function has a different type for the ANSI and Unicode versions.
; If your numeric value is a DWORD, you can use StrFormatByteSize with text macros for both cases.
; The compiler will cast the numerical value to a LONGLONG for the Unicode case.
; If your numerical value is a LONGLONG, you should use StrFormatByteSizeW explicitly.
;
; Example
; 532 -> 532 bytes
; 1340 -> 1.3KB
; 23506 -> 23.5KB
; 2400016 -> 2.4MB
; 2400000000 -> 2.4GB
;
; Function Information
; Minimum DLL Version shlwapi.dll version 4.71 or later
;..........................................................................................................................................
#EndFunction
:skip_udfstrformatbytesize
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstrformbytesize",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfstrformbytesize
#DefineFunction udfStrFormByteSize (numstr, numlen, declen)
div = 1024
len = StrLen(div)
dim = 0
lenpre = numlen-declen-(declen>0)
If (lenpre<1) Then Return ("")
While 1
pos = 1
num = StrSub(numstr,pos,len)
pos = pos + len
numpre = 0
numpost = 0
resultstr = ""
While 1
numpre = num / div
numpost = num - (numpre * div)
resultstr = StrCat(resultstr,numpre)
digit = StrSub(numstr,pos,1)
If (digit=="") Then Break
num = StrCat(numpost,digit)
pos = pos + 1
EndWhile
dim = dim + 1
If (StrLen(resultstr)<=lenpre) Then Break
numstr = resultstr
EndWhile
If (numpost>0)
numpost = 1.0 * numpost / div ; 0.1234567
numpost = StrReplace(numpost,".","") ; "01234567"
lenpost = StrLen(numpost)
strpost = ""
lenmin = Max(2,declen+2)
For i=lenpost To lenmin By -1
numround = Min(9,StrSub(numpost,i-1,1) + (StrSub(numpost,i,1)>4))
strpost = StrCat(numround,strpost)
Next
strpost = StrCat(StrSub(numpost,1,declen),strpost)
resultstr = 0 + resultstr + StrSub(strpost,1,1) ; add maybe overflow
If (declen>0)
resultstr = StrCat(resultstr,".")
For i=1 To declen
resultstr = StrCat(resultstr,StrSub(strpost,i+1,1))
Next
EndIf
Else
If (declen>0)
resultstr = StrCat(resultstr,".",StrFill("0",declen))
EndIf
EndIf
dim = ItemExtract(dim+1," Byte, KB, MB, GB, TB, ??",",")
resultstr = StrCat(resultstr,dim)
Return (resultstr)
;..........................................................................................................................................
; Example:
; sNumString = udfStrFormByte ("23456789", 6, 2)
; This function "udfStrFormByteSize" returns a formatted string like "22.37 MB".
;..........................................................................................................................................
; Detlev Dalitz.20020529
;..........................................................................................................................................
#EndFunction
:skip_udfstrformbytesize
;------------------------------------------------------------------------------------------------------------------------------------------
; --- test ---
; Note: Germany country settings.
:test1
sStr11 = udfStrFormatByteSize ( 532) ; "532 Byte"
sStr12 = udfStrFormatByteSize ( 9999) ; "9,76 KB"
sStr13 = udfStrFormatByteSize ( 65536) ; "64,0 KB"
sStr14 = udfStrFormatByteSize ( 131072) ; "128 KB"
sStr15 = udfStrFormatByteSize ( 1048576) ; "1,00 MB"
sStr16 = udfStrFormatByteSize ( 16777216) ; "16,0 MB"
sStr17 = udfStrFormatByteSize (1073741824) ; "1,00 GB"
sStr18 = udfStrFormatByteSize (4294967296-1) ; "3,99 GB"
sStr19 = udfStrFormatByteSize (4294967296) ; "0 Byte" !!!
:test2
number = 4294967296
sMsgTitle = number
sMsgText = udfStrFormByteSize (number, 6, 2) ; "0.00 KB"
Message(sMsgTitle,sMsgText)
number = "4294967296"
sMsgTitle = number
sMsgText = udfStrFormByteSize (number, 6, 2) ; "4.00 GB"
Message(sMsgTitle,sMsgText)
number = "4294967296000"
sMsgTitle = number
sMsgText = udfStrFormByteSize (number, 6, 2) ; "3.91 TB"
Message(sMsgTitle,sMsgText)
:test3
;sTestNumber = "4294967296" ; 4 GB = 4096 * 1024 * 1024
sTestNumber = "4294967295" ; 4GB - 1 Byte
;sTestNumber = "242992069738496" ; 221 TB
BoxOpen(sMsgTitle,"Running test ...")
sList = ""
For declen=3 To 0 By -1
For numlen=10 To (declen+2) By -1
BoxText(StrCat("Test ",@TAB,numlen,@TAB,declen))
numstr = udfStrFormByteSize (sTestNumber, numlen, declen)
sList = StrCat(sList,'udfStrFormByteSize (',sTestNumber,', ',numlen,', ',declen,')',@TAB,' = ',@TAB,'"',numstr,'"',@LF)
Next
Next
BoxShut()
IntControl(28,1,0,0,0)
IntControl(63,200,100,800,900)
AskItemlist(sMsgTitle,sList,@LF,@UNSORTED,@SINGLE)
:CANCEL
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
;*EOF*
|
|
|
udfStrFromTimeInterval (iTimeMSec, iDigits) |
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstrfromtimeinterval",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfstrfromtimeinterval
#DefineFunction udfStrFromTimeInterval (iTimeMSec, iDigits)
shlwapidll = StrCat(DirWindows(1),"SHLWAPI.DLL")
cchMax = DllCall(shlwapidll,long:"StrFromTimeIntervalA",lpnull,lpnull,long:iTimeMSec,long:iDigits)
hbb = BinaryAlloc(cchMax)
BinaryEodSet(hbb,cchMax)
cchMax = DllCall(shlwapidll,long:"StrFromTimeIntervalA",lpbinary:hbb,long:cchMax,long:iTimeMSec,long:iDigits)
sTime = BinaryPeekStr(hbb,0,cchMax)
BinaryFree(hbb)
Return (sTime)
;..........................................................................................................................................
; StrFromTimeInterval Function
; Converts a time interval, specified in milliseconds, to a string.
;
; Syntax
; int StrFromTimeInterval( LPTSTR pszOut,
; UINT cchMax,
; DWORD dwTimeMS,
; int digits
; );
;
; Parameters
; pszOut
; [out] Pointer to a character buffer that receives the converted string.
;
; cchMax
; [in] Size of pszOut, in characters.
; If cchMax is set to zero, StrFromTimeInterval will return the minimum size
; of the character buffer needed to hold the converted string.
; In this case, pszOut will not contain the converted string.
;
; dwTimeMS
; [in] Time interval, in milliseconds.
; digits
;
; [in] Maximum number of digits to be represented in pszOut. Some examples are: dwTimeMS digits pszOut
; 34000 3 34 sec
; 34000 2 34 sec
; 34000 1 30 sec
; 74000 3 1 min 14 sec
; 74000 2 1 min 10 sec
; 74000 1 1 min
;
; Return Value
; Returns the number of characters in pszOut, excluding the NULL terminator.
;
; Remarks
; The time value returned in pszOut will always be in the form hh hours mm minutes ss seconds.
; Times that exceed twenty four hours are not converted to days or months.
; Fractions of seconds are ignored.
;..........................................................................................................................................
#EndFunction
:skip_udfstrfromtimeinterval
;------------------------------------------------------------------------------------------------------------------------------------------
; --- test ---
; Germany country settings
iTimeMSec = 34000
iDigits = 3
sTime11 = udfStrFromTimeInterval (iTimeMSec, iDigits) ; " 34 Sek"
iTimeMSec = 34000
iDigits = 2
sTime12 = udfStrFromTimeInterval (iTimeMSec, iDigits) ; " 34 Sek"
iTimeMSec = 34000
iDigits = 1
sTime13 = udfStrFromTimeInterval (iTimeMSec, iDigits) ; " 30 Sek"
iTimeMSec = 84000
iDigits = 3
sTime21 = udfStrFromTimeInterval (iTimeMSec, iDigits) ; " 1 Min. 24 Sek"
iTimeMSec = 84000
iDigits = 2
sTime22 = udfStrFromTimeInterval (iTimeMSec, iDigits) ; " 1 Min. 20 Sek"
iTimeMSec = 84000
iDigits = 1
sTime23 = udfStrFromTimeInterval (iTimeMSec, iDigits) ; " 1 Min"
iTimeMSec = 1234*60*60*24*2
iDigits = 6
sTime31 = udfStrFromTimeInterval (iTimeMSec, iDigits) ; " 59 Std. 13 Min. 55 Sek"
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
;*EOF*
|
|
|
udfStrRandom (iLenMax) |
;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfStrRandom_1 (iMaxLen)
; sChars = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz.,?!1234567890;:'`"
sChars = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
iCharsLen = StrLen(sChars) - 1
iRandom = 1 + Random(iMaxLen - 1)
sRandom = ""
For i=1 To iRandom
sRandom = StrCat(sRandom,StrSub(sChars,1+Random(iCharsLen),1))
Next
Return (sRandom)
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfStrRandom_2 (iMaxLen)
iRandom = 1 + Random(iMaxLen - 1)
sRandom = ""
For i=1 To iRandom
sRandom = StrCat(sRandom,Num2Char(65 + Random(25)))
Next
Return (sRandom)
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------
; --- test ---
msgtitle = "Demo udfStrRandom (iLen)"
BoxOpen(msgtitle,"")
iCountMax = 100 ; how many strings?
iMaxLen = 80 ; which length?
For t=1 To 2
sRandomList = ""
Exclusive(@ON)
start=GetTickCount()
For i=1 To iCountMax
sRandom = udfStrRandom_%t% (iMaxLen)
sRandomList = ItemInsert(sRandom,-1,sRandomList,@TAB)
If !(i mod (iCountMax/10)) Then BoxText(StrCat("Test %t%: creating items ...",@LF,iCountMax,"/",i,@LF,sRandom))
Next
stop=GetTickCount()
Exclusive(@OFF)
Ticks%t% = stop-start
IntControl(63,100,200,900,800)
AskItemlist(msgtitle,sRandomList,@TAB,@UNSORTED,@SINGLE)
Next
MaxTicks = Max(Ticks1,Ticks2)
Pct1 = 100*Ticks1/MaxTicks
Pct2 = 100*Ticks2/MaxTicks
msgtext = StrCat("Performancetest",@LF)
msgtext = StrCat(msgtext,"ticks1=",ticks1,@TAB,Pct1,"%%",@LF)
msgtext = StrCat(msgtext,"ticks2=",ticks2,@TAB,Pct2,"%%",@LF)
Message (msgtitle,msgtext)
ClipPut(msgtext)
:CANCEL
BoxShut()
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
; WinBatch Studio Run
; Performancetest
; ticks1=9315 100%
; ticks2=6625 71% <== The Winner.
;------------------------------------------------------------------------------------------------------------------------------------------
;*EOF*
|
|
|
udfStrBanner (sString, sFillChar) |
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstrbanner",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfstrbanner
#DefineFunction udfStrBanner (sString, sFillChar)
If (sString=="") Then Return ("")
; Define the printable characters here.
; Note: Printable char must exist in BannerCharSet.
sPrintChars = " !""#$\%%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~"
sString = StrClean(sString,sPrintChars,"",@TRUE,2)
If (sString=="") Then Return ("")
sWork = StrClean(sPrintChars,sString,"",@TRUE,2)
iWorkLen = StrLen(sWork)
For i=1 To iWorkLen
iNum = Char2Num(StrSub(sWork,i,1))
GoSub ch%iNum% ; Gosub DefineBannerChars.
Next
If (sFillChar=="") ; Set individual banner print points.
For i=1 To iWorkLen
iNum = Char2Num(StrSub(sWork,i,1))
ch%iNum% = StrReplace(ch%iNum%,"0",Num2Char(iNum))
Next
EndIf
sBanner = ""
iStringLen = StrLen(sString)
For iLine=1 To 7
sLine = ""
For i=1 To iStringLen
iNum = Char2Num(StrSub(sString,i,1))
sLine = StrCat(sLine,ItemExtract(iLine,ch%iNum%,","))
Next
sBanner = StrCat(sBanner,sLine,@CRLF)
Next
If (sFillChar<>"")
sBanner = StrReplace(sBanner,"0",StrSub(sFillChar,1,1)) ; Set all banner print points to filler char.
EndIf
Return (sBanner)
;------------------------------------------------------------------------------------------------------------------------------------------
; DefineBannerChars ; Character scanlines usually written from top to down here written from left to right.
;------------------------------------------------------------------------------------------------------------------------------------------
:ch1
ch1 = " 000000 ,0 0,0 0 0 0,0 0,0 0000 0,0 00 0,0 0, 000000 "
Return
:ch2
ch2 = " 000000 ,00000000,00 00 00,00000000,00 00,000 000,00000000, 000000 "
Return
:ch3
ch3 = " 00 00 ,0000000 ,0000000 ,0000000 , 00000 , 000 , 0 , "
Return
:ch4
ch4 = " 0 , 000 , 00000 ,0000000 , 00000 , 000 , 0 , "
Return
:ch5
ch5 = " 000 , 00000 , 000 ,0000000 ,0000000 , 00000 , 000 , 00000 "
Return
:ch6
ch6 = " 0 , 0 , 000 , 00000 ,0000000 , 00000 , 000 , 00000 "
Return
:ch7
ch7 = " , , 00 , 0000 , 0000 , 00 , , "
Return
:ch8
ch8 = "00000000,00000000,000 000,00 00,00 00,000 000,00000000,00000000"
Return
:ch9
ch9 = " , 0000 , 00 00 , 0 0 , 0 0 , 00 00 , 0000 , "
Return
:ch10
ch10 = "00000000,00 00,0 00 0,0 0000 0,0 0000 0,0 00 0,00 00,00000000"
Return
:ch11
ch11 = " 0000, 000, 0000, 00000 0,00 00 ,00 00 ,00 00 , 0000 "
Return
:ch12
ch12 = " 0000 , 00 00 , 00 00 , 00 00 , 0000 , 00 , 000000 , 00 "
Return
:ch13
ch13 = " 00 00 , 00 00 , 00 00 , 00 00 , 00 00 , , 00 00 , "
Return
:ch14
ch14 = " 0000000, 00 00, 0000000, 00 00, 00 00, 00 000,000 00 ,00 "
Return
:ch15
ch15 = "0 00 0, 0 00 0 , 0000 ,000 000,000 000, 0000 , 0 00 0 ,0 00 0"
Return
:ch16
ch16 = "0 ,000 ,00000 ,0000000 ,00000 ,000 ,0 , "
Return
:ch17
ch17 = " 0 , 000 , 00000 ,0000000 , 00000 , 000 , 0 , "
Return
:ch18
ch18 = " 00 , 0000 , 000000 , 00 , 00 , 000000 , 0000 , 00 "
Return
:ch19
ch19 = " 00 00 , 00 00 , 00 00 , 00 00 , 00 00 , , 00 00 , "
Return
:ch20
ch20 = " 0000000,00 00 00,00 00 00, 0000 00, 00 00, 00 00, 00 00, "
Return
:ch21
ch21 = " 00000 , 00 00, 000 , 00 00 , 00 00 , 000 ,00 00 , 0000 "
Return
:ch22
ch22 = " , , , , 000000 , 000000 , 000000 , "
Return
:ch23
ch23 = " 00 , 0000 , 000000 , 00 , 000000 , 0000 , 00 ,00000000"
Return
:ch24
ch24 = " 00 , 0000 , 000000 , 00 , 00 , 00 , 00 , "
Return
:ch25
ch25 = " 00 , 00 , 00 , 00 , 000000 , 0000 , 00 , "
Return
:ch26
ch26 = " , 00 , 00 ,0000000 , 00 , 00 , , "
Return
:ch27
ch27 = " , 00 , 00 ,0000000 , 00 , 00 , , "
Return
:ch28
ch28 = " , ,00 ,00 ,00 ,0000000 , , "
Return
:ch29
ch29 = " , 0 0 , 00 00 ,00000000, 00 00 , 0 0 , , "
Return
:ch30
ch30 = " , 00 , 0000 , 000000 ,00000000,00000000, , "
Return
:ch31
ch31 = " ,00000000,00000000, 000000 , 0000 , 00 , , "
Return
:ch32
ch32 = " , , , , , , , " ; Blank
Return
:ch33
ch33 = " 00 , 0000 , 0000 , 00 , 00 , , 00 , " ; ! Exclamation Mark
Return
:ch34
ch34 = " 00 00 , 00 00 , 00 00 , , , , , " ; " Double Quote
Return
:ch35
ch35 = " 00 00 , 00 00 ,0000000 , 00 00 ,0000000 , 00 00 , 00 00 , " ; #
Return
:ch36
ch36 = " 00 , 00000 ,00 , 0000 , 00 ,00000 , 00 , " ; $ Dollar Sign
Return
:ch37
ch37 = " ,00 00 ,00 00 , 00 , 00 , 00 00 ,00 00 , " ; Percent Sign
Return
:ch38
ch38 = " 000 , 00 00 , 000 , 000 00 ,00 000 ,00 00 , 000 00 , " ; & Ampersand
Return
:ch39
ch39 = " 00 , 00 ,00 , , , , , " ; ' Single Quote
Return
:ch40
ch40 = " 00 , 00 , 00 , 00 , 00 , 00 , 00 , " ; ( Round Bracket Opened
Return
:ch41
ch41 = " 00 , 00 , 00 , 00 , 00 , 00 , 00 , " ; ) Round Bracket Closed
Return
:ch42
ch42 = " , 00 00 , 0000 ,00000000, 0000 , 00 00 , , " ; * Star sign
Return
:ch43
ch43 = " , 00 , 00 ,000000 , 00 , 00 , , " ; + Plus Sign
Return
:ch44
ch44 = " , , , , , 00 , 00 , 00 " ; , Comma
Return
:ch45
ch45 = " , , ,000000 , , , , " ; - Minus
Return
:ch46
ch46 = " , , , , , 00 , 00 , " ; . Point
Return
:ch47
ch47 = " 00 , 00 , 00 , 00 , 00 ,00 ,0 , " ; / Slash
Return
:ch48
ch48 = " 00000 ,00 00 ,00 000 ,00 0000 ,0000 00 ,000 00 , 00000 , " ; 0
Return
:ch49
ch49 = " 00 , 000 , 00 , 00 , 00 , 00 ,000000 , " ; 1
Return
:ch50
ch50 = " 0000 ,00 00 , 00 , 000 , 00 ,00 00 ,000000 , " ; 2
Return
:ch51
ch51 = " 0000 ,00 00 , 00 , 000 , 00 ,00 00 , 0000 , " ; 3
Return
:ch52
ch52 = " 000 , 0000 , 00 00 ,00 00 ,0000000 , 00 , 0000 , " ; 4
Return
:ch53
ch53 = "000000 ,00 ,00000 , 00 , 00 ,00 00 , 0000 , " ; 5
Return
:ch54
ch54 = " 000 , 00 ,00 ,00000 ,00 00 ,00 00 , 0000 , " ; 6
Return
:ch55
ch55 = "000000 ,00 00 , 00 , 00 , 00 , 00 , 00 , " ; 7
Return
:ch56
ch56 = " 0000 ,00 00 ,00 00 , 0000 ,00 00 ,00 00 , 0000 , " ; 8
Return
:ch57
ch57 = " 0000 ,00 00 ,00 00 , 00000 , 00 , 00 , 000 , " ; 9
Return
:ch58
ch58 = " , 00 , 00 , , , 00 , 00 , " ; : Colon
Return
:ch59
ch59 = " , 00 , 00 , , , 00 , 00 , 00 " ; ; Semicolon
Return
:ch60
ch60 = " 00 , 00 , 00 ,00 , 00 , 00 , 00 , " ; <
Return
:ch61
ch61 = " , ,000000 , , ,000000 , , " ; = Equal Sign
Return
:ch62
ch62 = " 00 , 00 , 00 , 00 , 00 , 00 , 00 , " ; >
Return
:ch63
ch63 = " 0000 ,00 00 , 00 , 00 , 00 , , 00 , " ; ? Question Mark
Return
:ch64
ch64 = " 00000 ,00 00 ,00 0000 ,00 0000 ,00 0000 ,00 , 0000 , " ; @
Return
:ch65
ch65 = " 00 , 0000 ,00 00 ,00 00 ,000000 ,00 00 ,00 00 , " ; A
Return
:ch66
ch66 = "000000 , 00 00 , 00 00 , 00000 , 00 00 , 00 00 ,000000 , " ; B
Return
:ch67
ch67 = " 0000 , 00 00 ,00 ,00 ,00 , 00 00 , 0000 , " ; C
Return
:ch68
ch68 = "00000 , 00 00 , 00 00 , 00 00 , 00 00 , 00 00 ,00000 , " ; D
Return
:ch69
ch69 = "0000000 , 00 0 , 00 0 , 0000 , 00 0 , 00 0 ,0000000 , " ; E
Return
:ch70
ch70 = "0000000 , 00 0 , 00 0 , 0000 , 00 0 , 00 ,0000 , " ; F
Return
:ch71
ch71 = " 0000 , 00 00 ,00 ,00 ,00 000 , 00 00 , 00000 , " ; G
Return
:ch72
ch72 = "00 00 ,00 00 ,00 00 ,000000 ,00 00 ,00 00 ,00 00 , " ; H
Return
:ch73
ch73 = " 0000 , 00 , 00 , 00 , 00 , 00 , 0000 , " ; I
Return
:ch74
ch74 = " 0000 , 00 , 00 , 00 ,00 00 ,00 00 , 0000 , " ; J
Return
:ch75
ch75 = "000 00 , 00 00 , 00 00 , 0000 , 00 00 , 00 00 ,000 00 , " ; K
Return
:ch76
ch76 = "0000 , 00 , 00 , 00 , 00 0 , 00 00 ,0000000 , " ; L
Return
:ch77
ch77 = "00 00 ,000 000 ,0000000 ,0000000 ,00 0 00 ,00 00 ,00 00 , " ; M
Return
:ch78
ch78 = "00 00 ,000 00 ,0000 00 ,00 0000 ,00 000 ,00 00 ,00 00 , " ; N
Return
:ch79
ch79 = " 000 , 00 00 ,00 00 ,00 00 ,00 00 , 00 00 , 000 , " ; O
Return
:ch80
ch80 = "000000 , 00 00 , 00 00 , 00000 , 00 , 00 ,0000 , " ; P
Return
:ch81
ch81 = " 0000 ,00 00 ,00 00 ,00 00 ,00 000 , 0000 , 000 , " ; Q
Return
:ch82
ch82 = "000000 , 00 00 , 00 00 , 00000 , 00 00 , 00 00 ,000 00 , " ; R
Return
:ch83
ch83 = " 0000 ,00 00 ,000 , 000 , 000 ,00 00 , 0000 , " ; S
Return
:ch84
ch84 = "000000 ,0 00 0 , 00 , 00 , 00 , 00 , 0000 , " ; T
Return
:ch85
ch85 = "00 00 ,00 00 ,00 00 ,00 00 ,00 00 ,00 00 ,000000 , " ; U
Return
:ch86
ch86 = "00 00 ,00 00 ,00 00 ,00 00 ,00 00 , 0000 , 00 , " ; V
Return
:ch87
ch87 = "00 00 ,00 00 ,00 00 ,00 0 00 ,0000000 ,000 000 ,00 00 , " ; W
Return
:ch88
ch88 = "00 00 ,00 00 , 00 00 , 000 , 000 , 00 00 ,00 00 , " ; X
Return
:ch89
ch89 = "00 00 ,00 00 ,00 00 , 0000 , 00 , 00 , 0000 , " ; Y
Return
:ch90
ch90 = "0000000 ,00 00 ,0 00 , 00 , 00 0 , 00 00 ,0000000 , " ; Z
Return
:ch91
ch91 = " 0000 , 00 , 00 , 00 , 00 , 00 , 0000 , " ;
Return
:ch92
ch92 = "00 , 00 , 00 , 00 , 00 , 00 , 0 , " ;
Return
:ch93
ch93 = " 0000 , 00 , 00 , 00 , 00 , 00 , 0000 , " ;
Return
:ch94
ch94 = " 0 , 000 , 00 00 ,00 00 , , , , " ;
Return
:ch95
ch95 = " , , , , , , ,00000000" ;
Return
:ch96
ch96 = " 00 , 00 , 00 , , , , , " ;
Return
:ch97
ch97 = " , , 0000 , 00 , 00000 ,00 00 , 000 00 , " ; a
Return
:ch98
ch98 = "000 , 00 , 00 , 00000 , 00 00 , 00 00 ,00 000 , " ; b
Return
:ch99
ch99 = " , , 0000 ,00 00 ,00 ,00 00 , 0000 , " ; c
Return
:ch100
ch100 = " 000 , 00 , 00 , 00000 ,00 00 ,00 00 , 000 00 , " ; d
Return
:ch101
ch101 = " , , 0000 ,00 00 ,000000 ,00 , 0000 , " ; e
Return
:ch102
ch102 = " 000 , 00 00 , 00 ,0000 , 00 , 00 ,0000 , " ; f
Return
:ch103
ch103 = " , , 000 00 ,00 00 ,00 00 , 00000 , 00 ,00000 " ; g
Return
:ch104
ch104 = "000 , 00 , 00 00 , 000 00 , 00 00 , 00 00 ,000 00 , " ; h
Return
:ch105
ch105 = " 00 , , 000 , 00 , 00 , 00 , 0000 , " ; i
Return
:ch106
ch106 = " 00 , , 00 , 00 , 00 ,00 00 ,00 00 , 0000 " ; j
Return
:ch107
ch107 = "000 , 00 , 00 00 , 00 00 , 0000 , 00 00 ,000 00 , " ; k
Return
:ch108
ch108 = " 000 , 00 , 00 , 00 , 00 , 00 , 0000 , " ; l
Return
:ch109
ch109 = " , ,00 00 ,0000000 ,0000000 ,00 0 00 ,00 00 , " ; m
Return
:ch110
ch110 = " , ,00000 ,00 00 ,00 00 ,00 00 ,00 00 , " ; n
Return
:ch111
ch111 = " , , 0000 ,00 00 ,00 00 ,00 00 , 0000 , " ; o
Return
:ch112
ch112 = " , ,00 000 , 00 00 , 00 00 , 00000 , 00 ,0000 " ; p
Return
:ch113
ch113 = " , , 000 00 ,00 00 ,00 00 , 00000 , 00 , 0000 " ; q
Return
:ch114
ch114 = " , ,00 000 , 000 00 , 00 00 , 00 ,0000 , " ; r
Return
:ch115
ch115 = " , , 00000 ,00 , 0000 , 00 ,00000 , " ; s
Return
:ch116
ch116 = " 0 , 00 , 00000 , 00 , 00 , 00 0 , 00 , " ; t
Return
:ch117
ch117 = " , ,00 00 ,00 00 ,00 00 ,00 00 , 000 00 , " ; u
Return
:ch118
ch118 = " , ,00 00 ,00 00 ,00 00 , 0000 , 00 , " ; v
Return
:ch119
ch119 = " , ,00 00 ,00 0 00 ,0000000 ,0000000 , 00 00 , " ; w
Return
:ch120
ch120 = " , ,00 00 , 00 00 , 000 , 00 00 ,00 00 , " ; x
Return
:ch121
ch121 = " , ,00 00 ,00 00 ,00 00 , 00000 , 00 ,00000 " ; y
Return
:ch122
ch122 = " , ,000000 ,0 00 , 00 , 00 0 ,000000 , " ; z
Return
:ch123
ch123 = " 000 , 00 , 00 ,000 , 00 , 00 , 000 , " ; {
Return
:ch124
ch124 = " 00 , 00 , 00 , , 00 , 00 , 00 , " ; |
Return
:ch125
ch125 = "000 , 00 , 00 , 000 , 00 , 00 ,000 , " ; }
Return
:ch126
ch126 = " 000 00 ,00 000 , , , , , , " ; ~
Return
:ch127
ch127 = " , 0 , 000 , 00 00 ,00 00 ,00 00 ,0000000 , " ;
Return
:ch128
ch128 = " 0000 ,00 00 ,00 ,00 00 , 0000 , 00 , 00 , 0000 " ;
Return
:ch129
ch129 = " ,00 00 , ,00 00 ,00 00 ,00 00 , 000000 , " ;
Return
:ch130
ch130 = " 000 , , 0000 ,00 00 ,000000 ,00 , 0000 , " ;
Return
:ch131
ch131 = " 000000 ,00 00, 0000 , 00 , 00000 , 00 00 , 000000, " ;
Return
:ch132
ch132 = "00 00 , , 0000 , 00 , 00000 ,00 00 , 000000 , " ;
Return
:ch133
ch133 = "000 , , 0000 , 00 , 00000 ,00 00 , 000000 , " ;
Return
:ch134
ch134 = " 00 , 00 , 0000 , 00 , 00000 ,00 00 , 000000 , " ;
Return
:ch135
ch135 = " , , 0000 ,00 ,00 , 0000 , 00 , 000 " ;
Return
:ch136
ch136 = " 000000 ,00 00, 0000 , 00 00 , 000000 , 00 , 0000 , " ;
Return
:ch137
ch137 = "00 00 , , 0000 ,00 00 ,000000 ,00 , 0000 , " ;
Return
:ch138
ch138 = "000 , , 0000 ,00 00 ,000000 ,00 , 0000 , " ;
Return
:ch139
ch139 = "00 00 , , 000 , 00 , 00 , 00 , 0000 , " ;
Return
:ch140
ch140 = " 00000 ,00 00 , 000 , 00 , 00 , 00 , 0000 , " ;
Return
:ch141
ch141 = "000 , , 000 , 00 , 00 , 00 , 0000 , " ;
Return
:ch142
ch142 = "00 00 , 000 , 00 00 ,00 00 ,0000000 ,00 00 ,00 00 , " ;
Return
:ch143
ch143 = " 00 , 00 , , 0000 ,00 00 ,000000 ,00 00 , " ;
Return
:ch144
ch144 = " 000 , ,000000 , 00 , 0000 , 00 ,000000 , " ;
Return
:ch145
ch145 = " , , 0000000, 00 , 0000000,00 00 , 0000000, " ;
Return
:ch146
ch146 = " 00000 , 00 00 ,00 00 ,0000000 ,00 00 ,00 00 ,00 000 , " ;
Return
:ch147
ch147 = " 0000 ,00 00 , , 0000 ,00 00 ,00 00 , 0000 , " ;
Return
:ch148
ch148 = " ,00 00 , , 0000 ,00 00 ,00 00 , 0000 , " ;
Return
:ch149
ch149 = " ,000 , , 0000 ,00 00 ,00 00 , 0000 , " ;
Return
:ch150
ch150 = " 0000 ,00 00 , ,00 00 ,00 00 ,00 00 , 000000 , " ;
Return
:ch151
ch151 = " ,000 , ,00 00 ,00 00 ,00 00 , 000000 , " ;
Return
:ch152
ch152 = " ,00 00 , ,00 00 ,00 00 , 00000 , 00 ,00000 " ;
Return
:ch153
ch153 = "00 00, 00 , 0000 , 00 00 , 00 00 , 0000 , 00 , " ;
Return
:ch154
ch154 = "00 00 , ,00 00 ,00 00 ,00 00 ,00 00 , 0000 , " ;
Return
:ch155
ch155 = " 00 , 00 , 000000 ,00 ,00 , 000000 , 00 , 00 " ;
Return
:ch156
ch156 = " 000 , 00 00 , 00 0 ,0000 , 00 ,000 00 ,000000 , " ;
Return
:ch157
ch157 = "00 00 ,00 00 , 0000 ,000000 , 00 ,000000 , 00 , 00 " ;
Return
:ch158
ch158 = "00000 ,00 00 ,00 00 ,00000 0 ,00 00 ,00 0000,00 00 ,00 000" ;
Return
:ch159
ch159 = " 000 , 00 00, 00 , 0000 , 00 , 00 ,00 00 , 000 " ;
Return
:ch160
ch160 = " 000 , , 0000 , 00 , 00000 ,00 00 , 000000 , " ;
Return
:ch161
ch161 = " 000 , , 000 , 00 , 00 , 00 , 0000 , " ;
Return
:ch162
ch162 = " , 000 , , 0000 ,00 00 ,00 00 , 0000 , " ;
Return
:ch163
ch163 = " , 000 , ,00 00 ,00 00 ,00 00 , 000000 , " ;
Return
:ch164
ch164 = " ,00000 , ,00000 ,00 00 ,00 00 ,00 00 , " ;
Return
:ch165
ch165 = "000000 , ,00 00 ,000 00 ,000000 ,00 000 ,00 00 , " ;
Return
:ch166
ch166 = " 0000 , 00 00 , 00 00 , 00000 , , 000000 , , " ;
Return
:ch167
ch167 = " 000 , 00 00 , 00 00 , 000 , , 00000 , , " ;
Return
:ch168
ch168 = " 00 , , 00 , 00 ,00 ,00 00 , 0000 , " ;
Return
:ch169
ch169 = " , , ,000000 ,00 ,00 , , " ;
Return
:ch170
ch170 = " , , ,000000 , 00 , 00 , , " ;
Return
:ch171
ch171 = "00 00,00 00 ,00 00 ,00 0000 , 00 00, 00 00 ,00 00 , 0000" ;
Return
:ch172
ch172 = "00 00,00 00 ,00 00 ,00 00 00, 00 000, 00 0000,00 0000, 00" ;
Return
:ch173
ch173 = " 00 , 00 , , 00 , 00 , 00 , 00 , " ;
Return
:ch174
ch174 = " , 00 00, 00 00 ,00 00 , 00 00 , 00 00, , " ;
Return
:ch175
ch175 = " ,00 00 , 00 00 , 00 00, 00 00 ,00 00 , , " ;
Return
:ch176
ch176 = " 0 0 ,0 0 , 0 0 ,0 0 , 0 0 ,0 0 , 0 0 ,0 0 " ;
Return
:ch177
ch177 = " 0 0 0 0,0 0 0 0 , 0 0 0 0,0 0 0 0 , 0 0 0 0,0 0 0 0 , 0 0 0 0,0 0 0 0 " ;
Return
:ch178
ch178 = "00 00 00, 000 000,00 00 00,000 000 ,00 00 00, 000 000,00 00 00,000 000 " ;
Return
:ch179
ch179 = " 00 , 00 , 00 , 00 , 00 , 00 , 00 , 00 " ;
Return
:ch180
ch180 = " 00 , 00 , 00 , 00 ,00000 , 00 , 00 , 00 " ;
Return
:ch181
ch181 = " 00 , 00 ,00000 , 00 ,00000 , 00 , 00 , 00 " ;
Return
:ch182
ch182 = " 00 00 , 00 00 , 00 00 , 00 00 ,0000 00 , 00 00 , 00 00 , 00 00 " ;
Return
:ch183
ch183 = " , , , ,0000000 , 00 00 , 00 00 , 00 00 " ;
Return
:ch184
ch184 = " , ,00000 , 00 ,00000 , 00 , 00 , 00 " ;
Return
:ch185
ch185 = " 00 00 , 00 00 ,0000 00 , 00 ,0000 00 , 00 00 , 00 00 , 00 00 " ;
Return
:ch186
ch186 = " 00 00 , 00 00 , 00 00 , 00 00 , 00 00 , 00 00 , 00 00 , 00 00 " ;
Return
:ch187
ch187 = " , ,0000000 , 00 ,0000 00 , 00 00 , 00 00 , 00 00 " ;
Return
:ch188
ch188 = " 00 00 , 00 00 ,0000 00 , 00 ,0000000 , , , " ;
Return
:ch189
ch189 = " 00 00 , 00 00 , 00 00 , 00 00 ,0000000 , , , " ;
Return
:ch190
ch190 = " 00 , 00 ,00000 , 00 ,00000 , , , " ;
Return
:ch191
ch191 = " , , , ,00000 , 00 , 00 , 00 " ;
Return
:ch192
ch192 = " 00 , 00 , 00 , 00 , 00000, , , " ;
Return
:ch193
ch193 = " 00 , 00 , 00 , 00 ,00000000, , , " ;
Return
:ch194
ch194 = " , , , ,00000000, 00 , 00 , 00 " ;
Return
:ch195
ch195 = " 00 , 00 , 00 , 00 , 00000, 00 , 00 , 00 " ;
Return
:ch196
ch196 = " , , , ,00000000, , , " ;
Return
:ch197
ch197 = " 00 , 00 , 00 , 00 ,00000000, 00 , 00 , 00 " ;
Return
:ch198
ch198 = " 00 , 00 , 00000, 00 , 00000, 00 , 00 , 00 " ;
Return
:ch199
ch199 = " 00 00 , 00 00 , 00 00 , 00 00 , 00 000, 00 00 , 00 00 , 00 00 " ;
Return
:ch200
ch200 = " 00 00 , 00 00 , 00 000, 00 , 000000, , , " ;
Return
:ch201
ch201 = " , , 000000, 00 , 00 000, 00 00 , 00 00 , 00 00 " ;
Return
:ch202
ch202 = " 00 00 , 00 00 ,0000 000, ,00000000, , , " ;
Return
:ch203
ch203 = " , ,00000000, ,0000 000, 00 00 , 00 00 , 00 00 " ;
Return
:ch204
ch204 = " 00 00 , 00 00 , 00 000, 00 , 00 000, 00 00 , 00 00 , 00 00 " ;
Return
:ch205
ch205 = " , ,00000000, ,00000000, , , " ;
Return
:ch206
ch206 = " 00 00 , 00 00 ,0000 000, ,0000 000, 00 00 , 00 00 , 00 00 " ;
Return
:ch207
ch207 = " 00 , 00 ,00000000, ,00000000, , , " ;
Return
:ch208
ch208 = " 00 00 , 00 00 , 00 00 , 00 00 ,00000000, , , " ;
Return
:ch209
ch209 = " , ,00000000, ,00000000, 00 , 00 , 00 " ;
Return
:ch210
ch210 = " , , , ,00000000, 00 00 , 00 00 , 00 00 " ;
Return
:ch211
ch211 = " 00 00 , 00 00 , 00 00 , 00 00 , 000000, , , " ;
Return
:ch212
ch212 = " 00 , 00 , 00000, 00 , 00000, , , " ;
Return
:ch213
ch213 = " , , 00000, 00 , 00000, 00 , 00 , 00 " ;
Return
:ch214
ch214 = " , , , , 000000, 00 00 , 00 00 , 00 00 " ;
Return
:ch215
ch215 = " 00 00 , 00 00 , 00 00 , 00 00 ,00000000, 00 00 , 00 00 , 00 00 " ;
Return
:ch216
ch216 = " 00 , 00 ,00000000, 00 ,00000000, 00 , 00 , 00 " ;
Return
:ch217
ch217 = " 00 , 00 , 00 , 00 ,00000 , , , " ;
Return
:ch218
ch218 = " , , , , 00000, 00 , 00 , 00 " ;
Return
:ch219
ch219 = "00000000,00000000,00000000,00000000,00000000,00000000,00000000,00000000" ;
Return
:ch220
ch220 = " , , , ,00000000,00000000,00000000,00000000" ;
Return
:ch221
ch221 = "0000 ,0000 ,0000 ,0000 ,0000 ,0000 ,0000 ,0000 " ;
Return
:ch222
ch222 = " 0000, 0000, 0000, 0000, 0000, 0000, 0000, 0000" ;
Return
:ch223
ch223 = "00000000,00000000,00000000,00000000, , , , " ;
Return
:ch224
ch224 = " , , 000 00 ,00 000 ,00 0 ,00 000 , 000 00 , " ;
Return
:ch225
ch225 = " , 0000 ,00 00 ,00000 ,00 00 ,00000 ,00 ,00 " ;
Return
:ch226
ch226 = " ,000000 ,00 00 ,00 ,00 ,00 ,00 , " ;
Return
:ch227
ch227 = " ,0000000 , 00 00 , 00 00 , 00 00 , 00 00 , 00 00 , " ;
Return
:ch228
ch228 = "000000 ,00 00 , 00 , 00 , 00 ,00 00 ,000000 , " ;
Return
:ch229
ch229 = " , , 000000 ,00 00 ,00 00 ,00 00 , 000 , " ;
Return
:ch230
ch230 = " , 00 00 , 00 00 , 00 00 , 00 00 , 00000 , 00 ,00 " ;
Return
:ch231
ch231 = " , 000 00 ,00 000 , 00 , 00 , 00 , 00 , " ;
Return
:ch232
ch232 = "000000 , 00 , 0000 ,00 00 ,00 00 , 0000 , 00 ,000000 " ;
Return
:ch233
ch233 = " 000 , 00 00 ,00 00 ,0000000 ,00 00 , 00 00 , 000 , " ;
Return
:ch234
ch234 = " 000 , 00 00 ,00 00 ,00 00 , 00 00 , 00 00 ,000 000 , " ;
Return
:ch235
ch235 = " 000 , 00 , 00 , 00000 ,00 00 ,00 00 , 0000 , " ;
Return
:ch236
ch236 = " , , 000000 ,00 00 00,00 00 00, 000000 , , " ;
Return
:ch237
ch237 = " 00 , 00 , 000000 ,00 00 00,00 00 00, 000000 , 00 ,00 " ;
Return
:ch238
ch238 = " 000 , 00 ,00 ,00000 ,00 , 00 , 000 , " ;
Return
:ch239
ch239 = " 0000 ,00 00 ,00 00 ,00 00 ,00 00 ,00 00 ,00 00 , " ;
Return
:ch240
ch240 = " ,000000 , ,000000 , ,000000 , , " ;
Return
:ch241
ch241 = " 00 , 00 ,000000 , 00 , 00 , ,000000 , " ;
Return
:ch242
ch242 = " 00 , 00 , 00 , 00 , 00 , ,000000 , " ;
Return
:ch243
ch243 = " 00 , 00 , 00 , 00 , 00 , ,000000 , " ;
Return
:ch244
ch244 = " 000 , 00 00, 00 00, 00 , 00 , 00 , 00 , 00 " ;
Return
:ch245
ch245 = " 00 , 00 , 00 , 00 , 00 ,00 00 ,00 00 , 000 " ;
Return
:ch246
ch246 = " 00 , 00 , ,000000 , , 00 , 00 , " ;
Return
:ch247
ch247 = " , 000 00 ,00 000 , , 000 00 ,00 000 , , " ;
Return
:ch248
ch248 = " 000 , 00 00 , 00 00 , 000 , , , , " ;
Return
:ch249
ch249 = " , , , 00 , 00 , , , " ;
Return
:ch250
ch250 = " , , , , 00 , , , " ;
Return
:ch251
ch251 = " 0000, 00 , 00 , 00 ,000 00 , 00 00 , 0000 , 000 " ;
Return
:ch252
ch252 = " 0000 , 00 00 , 00 00 , 00 00 , 00 00 , , , " ;
Return
:ch253
ch253 = " 000 , 00 , 00 , 00 , 0000 , , , " ;
Return
:ch254
ch254 = " , , 0000 , 0000 , 0000 , 0000 , , " ;
Return
:ch255
ch255 = " , , , , , , , " ;
Return
;..........................................................................................................................................
; This Function "udfStrBanner" returns a 'Bannerstring'.
;
; Parameters:
; sString ..... The string to be printed.
; sFillChar ... The Character to be used as the print point character.
;..........................................................................................................................................
; Detlev Dalitz.20020720
;..........................................................................................................................................
#EndFunction
:skip_udfstrbanner
;------------------------------------------------------------------------------------------------------------------------------------------
; --- test ---
:test1
sString = "#1+2%% & 0.00 ($)"
sBanner = udfStrBanner(sString,"0") ; Set all banner print points to zero character.
IntControl(63,0,100,999,400)
IntControl(28, 1, 0, 0, 0)
AskItemlist("Demo udfStrBanner (sString, sFillChar)", StrReplace(sBanner,@CRLF,@TAB),@TAB,@UNSORTED,@SINGLE)
:test2
sString = "That's a Banner!"
sBanner = udfStrBanner(sString,"") ; All banner chars have their individual print point character.
IntControl(63,0,100,999,400)
IntControl(28, 1, 0, 0, 0)
AskItemlist("Demo udfStrBanner (sString, sFillChar)", StrReplace(sBanner,@CRLF,@TAB),@TAB,@UNSORTED,@SINGLE)
:test3
sString = "That's a Banner!"
sBanner = udfStrBanner(sString,"0") ; Set all banner print points to zero character.
IntControl(63,0,100,999,400)
IntControl(28, 1, 0, 0, 0)
AskItemlist("Demo udfStrBanner (sString, sFillChar)", StrReplace(sBanner,@CRLF,@TAB),@TAB,@UNSORTED,@SINGLE)
:test4
sString = "#1+ 2%% = 0.00($)"
sBanner = udfStrBanner(sString,"") ; All banner chars have their individual print point character.
IntControl(63,0,100,999,400)
IntControl(28, 1, 0, 0, 0)
AskItemlist("Demo udfStrBanner (sString, sFillChar)", StrReplace(sBanner,@CRLF,@TAB),@TAB,@UNSORTED,@SINGLE)
:test5
sString = "*** THE END ***"
sBanner = udfStrBanner(sString,"*") ; Set all banner print points to star character.
IntControl(63,0,100,999,400)
IntControl(28, 1, 0, 0, 0)
AskItemlist("Demo udfStrBanner (sString, sFillChar)", StrReplace(sBanner,@CRLF,@TAB),@TAB,@UNSORTED,@SINGLE)
:CANCEL
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
;*EOF*
|
|
|
udfStrAcronym (sString, iLength, iCaseMode, iVowelDelMode) |
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstracronym",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfstracronym
#DefineFunction udfStrAcronym (sString, iLength, iCaseMode, iVowelDelMode)
If (sString=="") Then Return ("")
iCaseMode = Min(1,Max(0,iCaseMode))
iVowelDelMode = Min(1,Max(0,iVowelDelMode))
sString = StrClean(sString," abcdefghijklmnopqrstuvwxyz","",@FALSE,2) ; Use only alpha chars and blank.
If iVowelDelMode Then sString = StrClean(sString,"aeiouy","",@TRUE,1) ; Delete vowels and y char.
iLength = Max(-1,iLength)
If (iLength==0) Then iLength = 1 ; Use at least one chararcter.
sAcronym = ""
iCount = ItemCount(sString," ")
For i=1 To iCount
sWord = StrSub(ItemExtract(i,sString," "),1,iLength)
If iCaseMode
sChar = StrSub(sWord,1,1)
If (sChar==StrLower(sChar)) Then Continue
EndIf
sAcronym = StrCat(sAcronym,sWord)
Next
Return (sAcronym)
;..........................................................................................................................................
; This Function "udfStrAcronym" converts a string into its acronym, a sequence of abbreviations,
; by returning the leading substring of iLength alphanumeric characters from each word.
;
; iVowelDelMode=0 ... Vowels are left untouched.
; iVowelDelMode=1 ... All lowercase Vowels and the y character will be deleted from the given string.
; iCaseMode=0 ....... All first letter are returned.
; iCaseMode=1 ....... Only capital first letters are returned.
; iLength ........... The length of each acronym substring to be returned, one char minimum at least.
; iLength=-1 ........ The whole words will be used, no truncation.
;..........................................................................................................................................
; Detlev Dalitz.20020723
;..........................................................................................................................................
#EndFunction
:skip_udfstracronym
;------------------------------------------------------------------------------------------------------------------------------------------
; --- test ---
sAcronym1 = udfStrAcronym("Hey User, this is a Acronym test.",0,0,0) ; "HUtiaAt"
sAcronym2 = udfStrAcronym("Hey User, this is a Acronym test.",0,1,0) ; "HUA"
sAcronym3 = udfStrAcronym("Hey User, this is a Acronym test.",1,0,0) ; "HUtiaAT"
sAcronym4 = udfStrAcronym("Hey User, this is a Acronym test.",1,1,0) ; "HUA"
sAcronym5 = udfStrAcronym("Hey User, this is a Acronym test.",-1,0,0) ; "HeyUserthisisaAcronymtest"
sAcronym6 = udfStrAcronym("Hey User, this is a Acronym test.",-1,1,0) ; "HeyUserAcronym"
sAcronym7 = udfStrAcronym("Hey User, this is a Acronym test.",3,0,0) ; "HeyUsethiisaAcrtes"
sAcronym8 = udfStrAcronym("Hey User, this is a Acronym test.",3,1,0) ; "HeyUseAcr"
sAcronym9 = udfStrAcronym("Hey User, this is a Acronym test.",3,0,1) ; "HUsrthssAcrtst"
sAcronym10 = udfStrAcronym("Hey User, this is a Acronym test.",3,1,1) ; "HUsrAcr"
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
;*EOF*
|
|
|
udfFileRootExt (sPathStr)
|
;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfFileRootExt_1 (sPathStr)
Return StrCat(FileRoot(sPathStr),StrSub(".",1,FileExtension(sPathStr)>""),FileExtension(sPathStr))
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfFileRootExt_2 (sPathStr)
Return StrReplace(sPathStr,FilePath(sPathStr),"")
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfFileRootExt_3 (sPathStr)
Return ItemExtract(-1,ItemExtract(-1,sPathStr,":"),"\")
#EndFunction
; This seems to be resp. this was the fastest method
; before FileBaseName was implemented as a native function.
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfFileRootExt_4 (sPathStr)
Return FileBaseName(sPathStr,0)
#EndFunction
; This should be the fastest method, wrapped into udf just for the performancetest.
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfFileRootExt_5 (sPathStr)
Return FileBaseName(sPathStr,1)
#EndFunction
; This should be the fastest method, wrapped into udf just for the performancetest.
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfPathStripPath (sPathStr) ; JustFilename
If (sPathStr=="") Then Return (sPathStr)
iMAX_PATH = 260
hBB = BinaryAlloc(iMAX_PATH)
BinaryPokeStr(hBB,0,sPathStr)
iResult = DllCall(StrCat(DirWindows(1),"SHLWAPI.DLL"),long:"PathStripPathA",lpbinary:hBB)
sPathStr = BinaryPeekStr(hBB,0,iMAX_PATH)
BinaryFree(hBB)
Return (sPathStr)
; Removes the path portion of a fully qualified path and file.
; Detlev Dalitz.20010807
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------
; --- test ---
sFilename101 = udfPathStripPath ("D:\TEMP\TEST.TXT") ; "TEST.TXT"
sFilename102 = udfPathStripPath ("\\XXX\X\TEMP TEMP\TEST.TXT") ; "TEST.TXT"
sFilename103 = udfPathStripPath ("\\XXX\X\TEMP TEMP\TEST.") ; "TEST."
sFilename104 = udfPathStripPath ("\\XXX\X\TEMP TEMP\.") ; "."
sFilename105 = udfPathStripPath ("\\XXX\X\TEMP TEMP\..") ; ".."
sFilename106 = udfPathStripPath ("\\XXX\X\TEMP TEMP\...") ; "..."
sFilename107 = udfPathStripPath ("\\XXX\X\TEMP TEMP\....") ; "...."
sFilename108 = udfPathStripPath ("\\XXX\X\TEMP TEMP\TEST") ; "TEST"
sFilename109 = udfPathStripPath ("\\XXX\X\TEMP TEMP\") ; "TEMP TEMP\"
sFilename110 = udfPathStripPath ("\\XXX\X\TEMP TEMP") ; "TEMP TEMP"
sFilename111 = udfPathStripPath ("\\XXX\X\") ; "X\"
sFilename112 = udfPathStripPath ("\\XXX\X") ; "X"
sFilename113 = udfPathStripPath ("\\XXX\") ; "XXX\"
sFilename114 = udfPathStripPath ("\\XXX") ; "XXX"
sFilename115 = udfPathStripPath ("\\") ; "\\"
sFilename116 = udfPathStripPath ("\") ; "\"
sFilename117 = udfPathStripPath ("") ; ""
sFilename118 = udfPathStripPath ("D:TEST.TXT") ; "TEST.TXT"
sFilename201 = udfFileRootExt_1 ("D:\TEMP\TEST.TXT") ; "TEST.TXT"
sFilename202 = udfFileRootExt_1 ("\\XXX\X\TEMP TEMP\TEST.TXT") ; "TEST.TXT"
sFilename203 = udfFileRootExt_1 ("\\XXX\X\TEMP TEMP\TEST.") ; "TEST"
sFilename204 = udfFileRootExt_1 ("\\XXX\X\TEMP TEMP\.") ; ""
sFilename205 = udfFileRootExt_1 ("\\XXX\X\TEMP TEMP\..") ; "."
sFilename206 = udfFileRootExt_1 ("\\XXX\X\TEMP TEMP\...") ; ".."
sFilename207 = udfFileRootExt_1 ("\\XXX\X\TEMP TEMP\....") ; "..."
sFilename208 = udfFileRootExt_1 ("\\XXX\X\TEMP TEMP\TEST") ; "TEST"
sFilename209 = udfFileRootExt_1 ("\\XXX\X\TEMP TEMP\") ; ""
sFilename210 = udfFileRootExt_1 ("\\XXX\X\TEMP TEMP") ; "TEMP TEMP"
sFilename211 = udfFileRootExt_1 ("\\XXX\X\") ; ""
sFilename212 = udfFileRootExt_1 ("\\XXX\X") ; "X"
sFilename213 = udfFileRootExt_1 ("\\XXX\") ; ""
sFilename214 = udfFileRootExt_1 ("\\XXX") ; "XXX"
sFilename215 = udfFileRootExt_1 ("\\") ; ""
sFilename216 = udfFileRootExt_1 ("\") ; ""
sFilename217 = udfFileRootExt_1 ("") ; ""
sFilename218 = udfFileRootExt_1 ("D:TEST.TXT") ; "TEST.TXT"
sFilename301 = udfFileRootExt_2 ("D:\TEMP\TEST.TXT") ; "TEST.TXT"
sFilename302 = udfFileRootExt_2 ("\\XXX\X\TEMP TEMP\TEST.TXT") ; "TEST.TXT"
sFilename303 = udfFileRootExt_2 ("\\XXX\X\TEMP TEMP\TEST.") ; "TEST."
sFilename304 = udfFileRootExt_2 ("\\XXX\X\TEMP TEMP\.") ; "."
sFilename305 = udfFileRootExt_2 ("\\XXX\X\TEMP TEMP\..") ; ".."
sFilename306 = udfFileRootExt_2 ("\\XXX\X\TEMP TEMP\...") ; "..."
sFilename307 = udfFileRootExt_2 ("\\XXX\X\TEMP TEMP\....") ; "...."
sFilename308 = udfFileRootExt_2 ("\\XXX\X\TEMP TEMP\TEST") ; "TEST"
sFilename309 = udfFileRootExt_2 ("\\XXX\X\TEMP TEMP\") ; ""
sFilename310 = udfFileRootExt_2 ("\\XXX\X\TEMP TEMP") ; "TEMP TEMP"
sFilename311 = udfFileRootExt_2 ("\\XXX\X\") ; ""
sFilename312 = udfFileRootExt_2 ("\\XXX\X") ; "X"
sFilename313 = udfFileRootExt_2 ("\\XXX\") ; ""
sFilename314 = udfFileRootExt_2 ("\\XXX") ; "XXX"
sFilename315 = udfFileRootExt_2 ("\\") ; ""
sFilename316 = udfFileRootExt_2 ("\") ; ""
sFilename317 = udfFileRootExt_2 ("") ; ""
sFilename318 = udfFileRootExt_2 ("D:TEST.TXT") ; "TEST.TXT"
sFilename401 = udfFileRootExt_3 ("D:\TEMP\TEST.TXT") ; "TEST.TXT"
sFilename402 = udfFileRootExt_3 ("\\XXX\X\TEMP TEMP\TEST.TXT") ; "TEST.TXT"
sFilename403 = udfFileRootExt_3 ("\\XXX\X\TEMP TEMP\TEST.") ; "TEST."
sFilename404 = udfFileRootExt_3 ("\\XXX\X\TEMP TEMP\.") ; "."
sFilename405 = udfFileRootExt_3 ("\\XXX\X\TEMP TEMP\..") ; ".."
sFilename406 = udfFileRootExt_3 ("\\XXX\X\TEMP TEMP\...") ; "..."
sFilename407 = udfFileRootExt_3 ("\\XXX\X\TEMP TEMP\....") ; "...."
sFilename408 = udfFileRootExt_3 ("\\XXX\X\TEMP TEMP\TEST") ; "TEST"
sFilename409 = udfFileRootExt_3 ("\\XXX\X\TEMP TEMP\") ; ""
sFilename410 = udfFileRootExt_3 ("\\XXX\X\TEMP TEMP") ; "TEMP TEMP"
sFilename411 = udfFileRootExt_3 ("\\XXX\X\") ; ""
sFilename412 = udfFileRootExt_3 ("\\XXX\X") ; "X"
sFilename413 = udfFileRootExt_3 ("\\XXX\") ; ""
sFilename414 = udfFileRootExt_3 ("\\XXX") ; "XXX"
sFilename415 = udfFileRootExt_3 ("\\") ; ""
sFilename416 = udfFileRootExt_3 ("\") ; ""
sFilename417 = udfFileRootExt_3 ("") ; ""
sFilename418 = udfFileRootExt_3 ("D:TEST.TXT") ; "TEST.TXT"
sFilename501 = udfFileRootExt_4 ("D:\TEMP\TEST.TXT") ; "TEST.TXT"
sFilename502 = udfFileRootExt_4 ("\\XXX\X\TEMP TEMP\TEST.TXT") ; "TEST.TXT"
sFilename503 = udfFileRootExt_4 ("\\XXX\X\TEMP TEMP\TEST.") ; "TEST"
sFilename504 = udfFileRootExt_4 ("\\XXX\X\TEMP TEMP\.") ; ""
sFilename505 = udfFileRootExt_4 ("\\XXX\X\TEMP TEMP\..") ; "."
sFilename506 = udfFileRootExt_4 ("\\XXX\X\TEMP TEMP\...") ; ".."
sFilename507 = udfFileRootExt_4 ("\\XXX\X\TEMP TEMP\....") ; "..."
sFilename508 = udfFileRootExt_4 ("\\XXX\X\TEMP TEMP\TEST") ; "TEST"
sFilename509 = udfFileRootExt_4 ("\\XXX\X\TEMP TEMP\") ; ""
sFilename510 = udfFileRootExt_4 ("\\XXX\X\TEMP TEMP") ; "TEMP TEMP"
sFilename511 = udfFileRootExt_4 ("\\XXX\X\") ; ""
sFilename512 = udfFileRootExt_4 ("\\XXX\X") ; "X"
sFilename513 = udfFileRootExt_4 ("\\XXX\") ; ""
sFilename514 = udfFileRootExt_4 ("\\XXX") ; "XXX"
sFilename515 = udfFileRootExt_4 ("\\") ; ""
sFilename516 = udfFileRootExt_4 ("\") ; ""
sFilename517 = udfFileRootExt_4 ("") ; ""
sFilename518 = udfFileRootExt_4 ("D:TEST.TXT") ; "TEST.TXT"
sFilename601 = udfFileRootExt_5 ("D:\TEMP\TEST.TXT") ; "TEST.TXT"
sFilename602 = udfFileRootExt_5 ("\\XXX\X\TEMP TEMP\TEST.TXT") ; "TEST.TXT"
sFilename603 = udfFileRootExt_5 ("\\XXX\X\TEMP TEMP\TEST.") ; "TEST."
sFilename604 = udfFileRootExt_5 ("\\XXX\X\TEMP TEMP\.") ; "."
sFilename605 = udfFileRootExt_5 ("\\XXX\X\TEMP TEMP\..") ; ".."
sFilename606 = udfFileRootExt_5 ("\\XXX\X\TEMP TEMP\...") ; "..."
sFilename607 = udfFileRootExt_5 ("\\XXX\X\TEMP TEMP\....") ; "...."
sFilename608 = udfFileRootExt_5 ("\\XXX\X\TEMP TEMP\TEST") ; "TEST."
sFilename609 = udfFileRootExt_5 ("\\XXX\X\TEMP TEMP\") ; "."
sFilename610 = udfFileRootExt_5 ("\\XXX\X\TEMP TEMP") ; "TEMP TEMP."
sFilename611 = udfFileRootExt_5 ("\\XXX\X\") ; "."
sFilename612 = udfFileRootExt_5 ("\\XXX\X") ; "X."
sFilename613 = udfFileRootExt_5 ("\\XXX\") ; "."
sFilename614 = udfFileRootExt_5 ("\\XXX") ; "XXX".
sFilename615 = udfFileRootExt_5 ("\\") ; "."
sFilename616 = udfFileRootExt_5 ("\") ; "."
sFilename617 = udfFileRootExt_5 ("") ; "."
sFilename618 = udfFileRootExt_5 ("D:TEST.TXT") ; "TEST.TXT"
;------------------------------------------------------------------------------------------------------------------------------------------
:Performancetest
sMsgTitle = "Demo Performance Test"
sURL = "\\SERVER\SHARE\FOLDER\FILENAME.EXT"
iTestLoop = 1000
iMaxTests = 6
iTest=1
Display(1,sMsgTitle,"Running Test %iTest%, please wait ...")
Exclusive(@ON)
iStart = GetTickCount()
For i=1 To iTestLoop
Result = udfPathStripPath(sURL)
Next
iStop = GetTickCount()
Exclusive(@OFF)
iTicks%iTest% = iStop-iStart
iTest=2
Display(1,sMsgTitle,"Running Test %iTest%, please wait ...")
Exclusive(@ON)
iStart = GetTickCount()
For i=1 To iTestLoop
Result = udfFileRootExt_1(sURL)
Next
iStop = GetTickCount()
Exclusive(@OFF)
iTicks%iTest% = iStop-iStart
iTest=3
Display(1,sMsgTitle,"Running Test %iTest%, please wait ...")
Exclusive(@ON)
iStart = GetTickCount()
For i=1 To iTestLoop
Result = udfFileRootExt_2(sURL)
Next
iStop = GetTickCount()
Exclusive(@OFF)
iTicks%iTest% = iStop-iStart
iTest=4
Display(1,sMsgTitle,"Running Test %iTest%, please wait ...")
Exclusive(@ON)
iStart = GetTickCount()
For i=1 To iTestLoop
Result = udfFileRootExt_3(sURL)
Next
iStop = GetTickCount()
Exclusive(@OFF)
iTicks%iTest% = iStop-iStart
iTest=5
Display(1,sMsgTitle,"Running Test %iTest%, please wait ...")
Exclusive(@ON)
iStart = GetTickCount()
For i=1 To iTestLoop
Result = udfFileRootExt_4(sURL)
Next
iStop = GetTickCount()
Exclusive(@OFF)
iTicks%iTest% = iStop-iStart
iTest=6
Display(1,sMsgTitle,"Running Test %iTest%, please wait ...")
Exclusive(@ON)
iStart = GetTickCount()
For i=1 To iTestLoop
Result = udfFileRootExt_5(sURL)
Next
iStop = GetTickCount()
Exclusive(@OFF)
iTicks%iTest% = iStop-iStart
iMaxTicks = 0
For iTest=1 To iMaxTests
iMaxTicks = Max(iMaxTicks,iTicks%iTest%)
Next
For iTest=1 To iMaxTests
iPct%iTest% = 100*iTicks%iTest%/iMaxTicks
Next
sMsgText = ""
For iTest=1 To iMaxTests
sMsgText = StrCat(sMsgText,"Test ",iTest,@TAB,"Ticks = ",@TAB,iTicks%iTest%,@TAB,iPct%iTest%," %%",@CRLF)
Next
Message(sMsgTitle,sMsgText)
ClipPut(sMsgText)
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
; WB Studio Run
; Test 1 Ticks = 11258 100 %
; Test 2 Ticks = 5242 46 %
; Test 3 Ticks = 4338 38 %
; Test 4 Ticks = 3942 35 % <==
; Test 5 Ticks = 3647 32 % <==
; Test 6 Ticks = 3667 32 % <==
;------------------------------------------------------------------------------------------------------------------------------------------
;*EOF*
|
|
|
udfUrlIsOpaqueA (sUrl) |
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfurlisopaquea",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfurlisopaquea
#DefineFunction udfUrlIsOpaqueA (sUrl)
Return (DllCall(StrCat(DirWindows(1),"SHLWAPI.DLL"),long:"UrlIsOpaqueA",lpstr:StrSub(sUrl,1,2083)))
;..........................................................................................................................................
; This function "udfUrlIsOpaqueA" returns a boolean value which indicates if the given URL is opaque or not.
; @TRUE resp. 1 ... is opaque.
; @FALSE resp. 0 ... is not opaque.
;
; Parameters
; sURL ... String of maximum length INTERNET_MAX_URL_LENGTH that contains the URL.
;
; Remarks
; A URL that has a scheme that is not followed by two slashes (//) is opaque.
; For example, mailto:xyz@somecompany.com is an opaque URL.
; Opaque URLs cannot be separated into the standard URL hierarchy.
;
; Requires minimum Version 5.00 of SHLWAPI.DLL
;
; Syntax
; BOOL UrlIsOpaque(
; LPCTSTR pszURL
; );
;
; INTERNET_MAX_PATH_LENGTH = 2048
; INTERNET_MAX_SCHEME_LENGTH = 32 ; longest protocol name length
; INTERNET_MAX_URL_LENGTH = 2083 ; (INTERNET_MAX_SCHEME_LENGTH + StrLen("://") + INTERNET_MAX_PATH_LENGTH)
;
;..........................................................................................................................................
; Detlev Dalitz.20020826
;..........................................................................................................................................
#EndFunction
:skip_udfurlisopaquea
;------------------------------------------------------------------------------------------------------------------------------------------
;--- test ---
sUrl1 = "mailto:xyz@somecompany.com" ; ... is an opaque URL.
sUrl2 = "http://somecompany.com" ; ... is not an opaque URL.
sMsgTitel = "Demo udfUrlIsOpaqueA (sUrl)"
sMsgText = ""
sMsgText = StrCat(sMsgText,sUrl1,@LF,udfUrlIsOpaqueA(sUrl1),@LF,@LF)
sMsgText = StrCat(sMsgText,sUrl2,@LF,udfUrlIsOpaqueA(sUrl2),@LF,@LF)
Message(sMsgTitel,sMsgText)
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
;*EOF*
|
|
|
udfStrArrayize (sString, bMode) |
| goto special page 'Array Functions' |
|
|
udfStrROT13 (sString) |
| goto special page 'Conversion Functions' |
|
|
udfStrTagFind (sString, sBeginTag, sEndTag, iTagMode, sDelim) |
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstrtagfind",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfstrtagfind
#DefineFunction udfStrTagFind (sString, sBeginTag, sEndTag, iTagMode, sDelim)
If (sString=="") Then Return ("")
If (sBeginTag=="") Then sBeginTag = @LF
If (sEndTag=="") Then sEndTag = @CR
iTagMode = Min(1,Max(0,iTagMode))
sFindList = ""
iBBSize = 2+StrLen(sString)
hBB = BinaryAlloc(iBBSize)
BinaryPokeStr(hBB,0,@LF)
BinaryPokeStr(hBB,1,sString)
BinaryPokeStr(hBB,iBBSize-1,@CR)
sBBTag = BinaryTagInit(hBB,sBeginTag,sEndTag)
While 1
sBBTag = BinaryTagFind(sBBTag)
If (sBBTag=="") Then Break
iExtractBegin = BinaryTagIndex(sBBTag,iTagMode)
iExtractLen = BinaryTagLen(sBBTag,iTagMode)
iExtractEnd = iExtractBegin + iExtractLen
If (iExtractBegin==0) Then iExtractBegin = 1
If (iExtractEnd==iBBSize) Then iExtractLen = iExtractLen-2
sExtract = BinaryPeekStr(hBB,iExtractBegin,iExtractLen)
sFindList = ItemInsert(sExtract,-1,sFindList,sDelim)
EndWhile
iResult = BinaryFree(hBB)
Return (sFindList)
;..........................................................................................................................................
; This Function "udfStrTagFindStr" returns a string list sFindList
; which contains zero, one or more string items
; depending on the result of the search routine.
;
; sString ... The input string to be searched.
; sBeginTag ... The opening tag of the phrase to be found.
; sEndTag ... The closing tag of the phrase to be found.
; iTagMode=0 ... The tag find search routine returns the inner content of between the tags.
; iTagMode=1 ... The tag find search routine returns the enclosing tags too.
; sDelim ... Defines the separator character used to delimit the items in the sFindList.
;..........................................................................................................................................
; Detlev Dalitz.20020726
;------------------------------------------------------------------------------------------------------------------------------------------
#EndFunction
:skip_udfstrtagfind
;------------------------------------------------------------------------------------------------------------------------------------------
; --- test ---
sString = "This is a test string test."
sBeginTag = "his"
sEndTag = "string"
iTagMode = 0
sDelim = @TAB
sList1 = udfStrTagFind (sString, sBeginTag, sEndTag, iTagMode, sDelim) ; " is a test "
sString = "This is a test string test."
sBeginTag = " "
sEndTag = " "
iTagMode = 0
sDelim = @TAB
sList2 = udfStrTagFind (sString, sBeginTag, sEndTag, iTagMode, sDelim) ; "is@TABtest" (2 items).
sString = "This is a test string test."
sBeginTag = ""
sEndTag = "test"
iTagMode = 0
sDelim = @TAB
sList3 = udfStrTagFind (sString, sBeginTag, sEndTag, iTagMode, sDelim) ; "This is a "
sString = "This is a test string test."
sBeginTag = "is"
sEndTag = ""
iTagMode = 0
sDelim = @TAB
sList4 = udfStrTagFind (sString, sBeginTag, sEndTag, iTagMode, sDelim) ; " is a test string test."
sString = "This is a test string test."
sBeginTag = "a"
sEndTag = "g"
iTagMode = 1
sDelim = @TAB
sList5 = udfStrTagFind (sString, sBeginTag, sEndTag, iTagMode, sDelim) ; "a test string"
sString = "Find HTML tags <b>like this one</b> in HTML strings."
sBeginTag = "<B>"
sEndTag = "</B>"
iTagMode = 0
sDelim = @TAB
sList6 = udfStrTagFind (sString, sBeginTag, sEndTag, iTagMode, sDelim) ; "like this one"
sString = " This is a test string test. "
sBeginTag = " "
sEndTag = " "
iTagMode = 0
sDelim = @TAB
sList7 = udfStrTagFind (sString, sBeginTag, sEndTag, iTagMode, sDelim) ; "This@TABis@TABa@TABtest@TABstring@TABtest." (6 items).
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
;*EOF*
|
|
|
udfStrLeft (sString, iLength, sPadString) |
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstrleft",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfstrleft
#DefineFunction udfStrLeft (sString, iLength, sPadString)
If (sPadString=="") Then sPadString = " "
Return (StrFix(StrSub(sString,1,iLength),sPadString,iLength))
;..........................................................................................................................................
; This Function "udfStrLeft" returns the leftmost length characters of string.
; If string has less than length characters, the result will be padded on the right
; with the pad string, which defaults to a blank.
;..........................................................................................................................................
; Detlev Dalitz.20030312
;..........................................................................................................................................
#EndFunction
:skip_udfstrleft
;------------------------------------------------------------------------------------------------------------------------------------------
; --- test ---
sResult1 = udfStrLeft("abcd",10,"-#") ; "abcd-#-#-#"
sResult2 = udfStrLeft("abcd",6,"*") ; "abcd**"
sResult3 = udfStrLeft("testabcdefgh",4,"*") ; "test"
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
;*EOF*
|
|
|
udfStrRight (sString, iLength, sPadString) |
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstrright",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfstrright
#DefineFunction udfStrRight (sString, iLength, sPadString)
If (sPadString=="") Then sPadString = " "
Return (StrFixLeft(StrSub(sString,Max(1,StrLen(sString)-iLength),-1),sPadString,iLength))
;..........................................................................................................................................
; This Function "udfStrRight" returns the rightmost length characters of string.
; If string has less than length characters, the result will be padded on the left
; with the pad string, which defaults to a blank.
;..........................................................................................................................................
; Detlev Dalitz.20030312
;..........................................................................................................................................
#EndFunction
:skip_udfstrright
;------------------------------------------------------------------------------------------------------------------------------------------
; --- test ---
sResult1 = udfStrRight("abcd",10,"-#") ; "-#-#-#abcd"
sResult2 = udfStrRight("abcd",6,"*") ; "**abcd"
sResult3 = udfStrRight("abcdefghtest",4,"*") ; "test"
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
;*EOF*
|
|
|
udfStrSubCase (sString, iStart, iLength, iMode) |
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstrsubcase",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfstrsubcase
#DefineFunction udfStrSubCase (sString, iStart, iLength, iMode)
iStrLen=StrLen(sString)
If !iStrLen Then Return sString
If iStart<=0 Then iStart=iStrLen+iStart+1
If iLength>0
iL=iStart
iR=iStart+iLength-1
Else
iL=iStart+iLength+1
iR=iStart
EndIf
If iL<1 Then iL=1
If iR>iStrLen Then iR=iStrLen
If iL>iR Then Return sString
hBB=BinaryAlloc(iStrLen)
BinaryPokeStr(hBB,0,sString)
If !!iMode Then BinaryPokeStr(hBB,iL-1,StrUpper(StrSub(sString,iL,iR-iL+1)))
Else BinaryPokeStr(hBB,iL-1,StrLower(StrSub(sString,iL,iR-iL+1)))
sString=BinaryPeekStr(hBB,0,iStrLen)
BinaryFree(hBB)
Return sString
;..........................................................................................................................................
; This Function "udfStrSubCase" returns a string with partial uppercased resp. lowercased characters.
; If parameter iStart is a negative number then the start position is relative to the end of the given string.
; If parameter iLength is a negative number then the characters are counted backwards.
; iMode = 0 ... SubString conversion to lower case.
; iMode = 1 ... SubString conversion to upper case.
;..........................................................................................................................................
; Detlev Dalitz.20030909
;..........................................................................................................................................
#EndFunction
:skip_udfstrsubcase
;------------------------------------------------------------------------------------------------------------------------------------------
; --- test ---
sResult11 = udfStrSubCase("a" , 1, 1,1) ; ==> "A"
sResult12 = udfStrSubCase("a" , 1,-1,1) ; ==> "A"
sResult13 = udfStrSubCase("a" ,-1, 1,1) ; ==> "A"
sResult14 = udfStrSubCase("a" ,-1,-1,1) ; ==> "A"
sResult21 = udfStrSubCase("abc" , 1, 1,1) ; ==> "Abc"
sResult22 = udfStrSubCase("abc" , 1,-1,1) ; ==> "Abc"
sResult23 = udfStrSubCase("abc" ,-1, 1,1) ; ==> "abC"
sResult24 = udfStrSubCase("abc" ,-1,-1,1) ; ==> "abC"
sResult31 = udfStrSubCase("abc" , 2, 1,1) ; ==> "aBc"
sResult32 = udfStrSubCase("abc" , 2,-1,1) ; ==> "aBc"
sResult33 = udfStrSubCase("abc" ,-2, 1,1) ; ==> "aBc"
sResult34 = udfStrSubCase("abc" ,-2,-1,1) ; ==> "aBc
sResult41 = udfStrSubCase("abc" , 2, 2,1) ; ==> "aBC"
sResult42 = udfStrSubCase("abc" , 2,-2,1) ; ==> "ABc"
sResult43 = udfStrSubCase("abc" ,-2, 2,1) ; ==> "aBC"
sResult44 = udfStrSubCase("abc" ,-2,-2,1) ; ==> "ABc"
sResult51 = udfStrSubCase("abcd" , 3, 2,1) ; ==> "abCD"
sResult52 = udfStrSubCase("abcd" , 3,-2,1) ; ==> "aBCd"
sResult53 = udfStrSubCase("abcd" ,-3, 2,1) ; ==> "aBCd"
sResult54 = udfStrSubCase("abcd" ,-3,-2,1) ; ==> "ABcd"
sResult61 = udfStrSubCase("abcde", 3, 2,1) ; ==> "abCDe"
sResult62 = udfStrSubCase("abcde", 3,-2,1) ; ==> "aBCde"
sResult63 = udfStrSubCase("abcde",-3, 2,1) ; ==> "abCDe"
sResult64 = udfStrSubCase("abcde",-3,-2,1) ; ==> "aBCde"
sResult90 = udfStrSubCase("this is a test string",-100, 6,1) ; ==> "this is a test string"
sResult91 = udfStrSubCase("this is a test string", 0, 6,1) ; ==> "this is a test string"
sResult92 = udfStrSubCase("this is a test string", 1,-6,1) ; ==> "This is a test string"
sResult93 = udfStrSubCase("this is a test string", 11, 4,1) ; ==> "this is a TEST string"
sResult94 = udfStrSubCase("this is a test string", -11, 4,1) ; ==> "this is a TEST string"
sResult95 = udfStrSubCase("this is a test string", -1, 6,1) ; ==> "this is a test strinG"
sResult96 = udfStrSubCase("this is a test string", -18,-4,1) ; ==> "THIS is a test string"
sResult97 = udfStrSubCase("this is a test string", -18,-5,1) ; ==> "THIS is a test string"
sResult98 = udfStrSubCase("this is a test string", -21,-4,1) ; ==> "This is a test string"
sResult99 = udfStrSubCase("this is a test string", -22,-4,1) ; ==> "this is a test string"
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
;*EOF*
|
|
|
udfStrExpandEnvStrings (sString) |
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstrexpandenvstrings",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfstrexpandenvstrings
#DefineFunction udfStrExpandEnvStrings (sString)
@c0 = ""
@c37 = "%%"
@sPattern = "%%*%%"
iPos = 0
iLen = 0
While @TRUE
iPos = StrIndexWild(sString,@sPattern,iPos+iLen+1)
If !iPos Then Break
sSearch = StrSubWild(sString,@sPattern,iPos)
iLen = StrLen(sSearch)
If (iLen>2)
sReplace = Environment(StrReplace(sSearch,@c37,@c0))
If (sReplace>"") Then sString = StrCat(StrSub(sString,1,iPos-1),sReplace,StrSub(sString,iPos+StrLen(sReplace),-1))
Else
sString = StrCat(StrSub(sString,1,iPos-1),@c37,StrSub(sString,iPos+2,-1))
EndIf
EndWhile
Return (sString)
;..........................................................................................................................................
; This function "udfStrExpandEnvStrings" works on a given string (datatype ExpandSz),
; which contains one or more environment variable names enclosed in percent signs (e.g. [pct]path[pct]).
; If there exists a defined variable with such a name in the environment,
; then this function replaces the name token with the value of the environment variable.
;..........................................................................................................................................
; Detlev Dalitz.20030911
;..........................................................................................................................................
#EndFunction
:skip_udfstrexpandenvstrings
;------------------------------------------------------------------------------------------------------------------------------------------
; --- test ---
sString = 'The %%%%windir%%%% folder is "%%windir%%" named.'
sResult = udfStrExpandEnvStrings(sString)
sMsgTitle = "Demo udfStrExpandEnvStrings (sString)"
sMsgText = StrCat(sString,@LF,sResult)
Message(sMsgTitle,sMsgText)
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
;*EOF*
|
|
|
udfStrStrip (sString, sBoundary, sChar) |
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstrstrip",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfstrstrip
#DefineFunction udfStrStrip (sString, sBoundary, sChar)
sChar = StrSub(sChar,1,1)
sBoundary = StrLower(StrSub(sBoundary,1,1))
If !StrScan(sBoundary,"lrb",1,@FWDSCAN) Then sBoundary = "b"
Switch @TRUE
Case sChar==""
Case sChar==" "
Switch StrIndex("lrb",sBoundary,1,@FWDSCAN)
Case 1
Return ItemExtract(1,StrTrim(StrCat(sString,@LF)),@LF)
Break
Case 2
Return ItemExtract(2,StrTrim(StrCat(@LF,sString)),@LF)
Break
Case 3
Return StrTrim(sString)
Break
EndSwitch
Break
Case @TRUE
Switch StrIndex("lrb",sBoundary,1,@FWDSCAN)
Case 1
Case 3
iPos = 1
While StrSub(sString,iPos,1)==sChar
iPos = iPos+1
EndWhile
sString = StrSub(sString,iPos,-1)
Continue
Case 2
Case 3
iPos = StrLen(sString)
While StrSub(sString,iPos,1)==sChar
iPos = iPos-1
EndWhile
sString = StrSub(sString,1,iPos)
Continue
EndSwitch
Break
EndSwitch
Return sString
;..........................................................................................................................................
; This Function "udfStrStrip" returns a substring from the given sString.
; Depending on whether sBoundary option is "L" ("Left"), "R" ("Right"), or "B" ("Both"),
; the leading, trailing, or both leading and trailing occurrences of sChar
; will be deleted and the result string will be returned.
;
; Examples:
; udfStrStrip(' text ','B',' ') ==> 'text'
; udfStrStrip(' text ','L',' ') ==> 'text '
; udfStrStrip(' text ','R',' ') ==> ' text'
; udfStrStrip('---text---','B','-') ==> 'text'
;
;..........................................................................................................................................
; Detlev Dalitz.20030924
;..........................................................................................................................................
#EndFunction
:skip_udfstrstrip
;------------------------------------------------------------------------------------------------------------------------------------------
; --- test ---
sString = ",,,,12,345,,,"
sBoundary = "L"
sChar = ","
sResult11 = udfStrStrip(sString,sBoundary,sChar)
sString = ",,,,12,345,,,"
sBoundary = "R"
sChar = ","
sResult12 = udfStrStrip(sString,sBoundary,sChar)
sString = ",,,,12,345,,,"
sBoundary = "B"
sChar = ","
sResult13 = udfStrStrip(sString,sBoundary,sChar)
sString = " 12,345 "
sBoundary = "L"
sChar = ""
sResult21 = udfStrStrip(sString,sBoundary,sChar)
sString = " 12,345 "
sBoundary = "R"
sChar = ""
sResult22 = udfStrStrip(sString,sBoundary,sChar)
sString = " 12,345 "
sBoundary = "B"
sChar = ""
sResult23 = udfStrStrip(sString,sBoundary,sChar)
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
; Example: 'Commaize' a big number into blocks of three digits.
;------------------------------------------------------------------------------------------------------------------------------------------
AddExtender("xmt34i.dll")
sDigits = "1234567890998877665544332211"
sTabIn = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
sTabOut = "abc,def,ghi,jkl,mno,pqr,stu,vwx,yzA,BCD,EFG,HIJ,KLM,NOP,QRS,TUV,WXY,Z"
sDigits = mtStrReverse(sDigits)
sDigits = mtStrTranslate(sTabOut,sDigits,sTabIn,",")
sDigits = udfStrStrip(sDigits,"r",",")
sDigits = mtStrReverse(sDigits) ; ==> "1,234,567,890,998,877,665,544,332,211"
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
;*EOF*
|
|
|
udfIsStrPalindrome (sString) |
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfisstrpalindrome_1",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfisstrpalindrome_1
#DefineFunction udfIsStrPalindrome_1 (sString)
If sString=="" Then Return @FALSE
sString = StrClean(sString,"abcdefghijklmnopqrstuvwxyz0123456789","",@FALSE,2)
If sString=="" Then Return @FALSE
sString = StrLower(sString)
iStrLen = StrLen(sString)
iMid = iStrLen/2
iStrLen = iStrLen+1
For i=1 To iMid
If StrSub(sString,i,1)!=StrSub(sString,iStrLen-i,1) Then Return @FALSE
Next
Return @TRUE
;..........................................................................................................................................
; This Function "udfIsPalindrome" returns a boolean value
; which indicates if a given string is a Palindrome or not.
; A Palindrome is a string which can be read either from left to right and from right to left.
; For Example: "madam".
;..........................................................................................................................................
#EndFunction
:skip_udfisstrpalindrome_1
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfisstrpalindrome_2",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfisstrpalindrome_2
#DefineFunction udfIsStrPalindrome_2 (sString)
If sString=="" Then Return @FALSE
sString = StrClean(sString,"abcdefghijklmnopqrstuvwxyz0123456789","",@FALSE,2)
If sString=="" Then Return @FALSE
iStrLen = StrLen(sString)
iMidL = iStrLen/2
iMidR = iStrLen-iMidL+1
sRev = ""
For ii=iStrLen To iMidR By -1
sRev = StrCat(sRev,StrSub(sString,ii,1))
Next
Return !StriCmp(sRev,StrSub(sString,1,iMidL))
;..........................................................................................................................................
; This Function "udfIsPalindrome" returns a boolean value
; which indicates if a given string is a Palindrome or not.
; A Palindrome is a string which can be read either from left to right and from right to left.
; For Example: "madam".
;..........................................................................................................................................
#EndFunction
:skip_udfisstrpalindrome_2
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfisstrpalindrome_3",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfisstrpalindrome_3
#DefineFunction udfIsStrPalindrome_3 (sString)
If sString=="" Then Return @FALSE
sString = StrClean(sString,"abcdefghijklmnopqrstuvwxyz0123456789","",@FALSE,2)
If sString=="" Then Return @FALSE
iStrLen = StrLen(sString)
iMidL = iStrLen/2
iMidR = iStrLen-iMidL+1
sRev = ""
For ii=iMidR To iStrLen
sRev = StrCat(StrSub(sString,ii,1),sRev)
Next
Return !StriCmp(StrSub(sString,1,iMidL),sRev)
;..........................................................................................................................................
; This Function "udfIsPalindrome" returns a boolean value
; which indicates if a given string is a Palindrome or not.
; A Palindrome is a string which can be read either from left to right and from right to left.
; For Example: "madam".
;..........................................................................................................................................
#EndFunction
:skip_udfisstrpalindrome_3
;------------------------------------------------------------------------------------------------------------------------------------------
:test1
; sTestStr = "REGEN"
; sTestStr = "EINNEGERMITGAZELLEZAGTIMREGENNIE"
; sTestStr = "RADAR"
; sTestStr = "CIVIC"
; sTestStr = "ABBA"
; sTestStr = "A man, a plan, a canal, Panama."
; sTestStr = "madam"
; sTestStr = "Lid off a daffodil"
; sTestStr = "Norma is as selfless as I am, Ron"
IsPalindrome1 = udfIsStrPalindrome_3("madam")
IsPalindrome2 = udfIsStrPalindrome_3("mad adam")
: Performancetest
sString = "Norma is as selfless as I am, Ron"
;sString = "RADAR"
iTest = 3
iLoop = 100
For it=1 To iTest
Exclusive(@ON)
iStart=GetTickCount()
For ii=1 To iLoop
vResult = udfIsStrPalindrome_%it%(sString)
Next
iStop=GetTickCount()
Exclusive(@OFF)
iTicks%it%=iStop-iStart
Next
:Result
iMax=0
For it=1 To iTest
iMax = Max(iMax,iTicks%it%)
Next
For it=1 To iTest
iPct%it% = 100*iTicks%it%/iMax
Next
sMsgTitle="Demo Performance Test udfIsStrPalindrome (sString)"
sMsgText=""
For it=1 To iTest
sMsgText = StrCat(sMsgText,"Test ",it,@TAB,iTicks%it%,@TAB,iPct%it%,"%%",@LF)
Next
Message(sMsgTitle,sMsgText)
ClipPut(sMsgText)
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
; in WinBatch Studio Debug Mode
; Test 1 6766 100%
; Test 2 6643 98%
; Test 3 6696 98%
;------------------------------------------------------------------------------------------------------------------------------------------
; in WinBatch Studio Run Mode
; Test 1 4945 100%
; Test 2 4616 93%
; Test 3 4279 86% <== The Winner.
;------------------------------------------------------------------------------------------------------------------------------------------
;*EOF*
|
|
|
udfParseStrToArray (sString) |
;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfParseStrToArray (sString)
Param0 = ParseData(sString)
aParam = ArrDimension(Param0)
For ii=1 To Param0
aParam[ii-1]=Param%ii%
Next
Return (aParam)
;..........................................................................................................................................
; This function "udfParseStrToArray" returns a dim-1 array,
; each cell populated with one parameter parsed from the given string.
;
; Detlev Dalitz.20040325
;..........................................................................................................................................
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------
; --- test ---
sMsgTitle = "Demo udfParseStrToArray (sString)"
iTest = 1
aParam = udfParseStrToArray(IntControl(1006,0,0,0,0)) ; Parse WinBatch command line.
GoSub DisplayResult
iTest = 2
sString = '11 222 "text with blanks" 333' ; Here are 4 parameters.
aParam = udfParseStrToArray(sString)
GoSub DisplayResult
iTest = 3
sString = "11 222 'text with blanks' 333" ; Here are 4 parameters.
aParam = udfParseStrToArray(sString)
GoSub DisplayResult
iTest = 4
sString = "11 222 `text with blanks` 333" ; Here are 4 parameters.
aParam = udfParseStrToArray(sString)
GoSub DisplayResult
iTest = 5
sString = "11 222 ´text with blanks´ 333" ; Here are 6 parameters.
aParam = udfParseStrToArray(sString)
GoSub DisplayResult
iTest = 6
sString = "11 222 text with blanks 333" ; Here are 6 parameters.
aParam = udfParseStrToArray(sString)
GoSub DisplayResult
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
:DisplayResult
aParam_iDims = ArrInfo(aParam,0) ; Number of dimensions in the array.
aParam_iDim1 = ArrInfo(aParam,1) ; Number of elements in dimension 1.
sMsgText = StrCat("Example ",iTest,@LF,"aParam_iDims = ",aParam_iDims,@LF,"aParam_iDim1 = ",aParam_iDim1,@LF,@LF)
sParams = "[No array elements]"
If aParam_iDim1
iHigh = aParam_iDim1 - 1
sParams = ""
For ia=0 To iHigh
sParams=StrCat(sParams,aParam[ia],@LF)
Next
EndIf
AskItemlist(StrCat("Example ",iTest),StrCat(sMsgText,sParams),@LF,@UNSORTED,@SINGLE)
Return
;------------------------------------------------------------------------------------------------------------------------------------------
; run("Drive:\Folder\udfGetParamArray().wbt",'11 222 "text with blanks" 333') ; Here are 5 parameters.
;------------------------------------------------------------------------------------------------------------------------------------------
;*EOF*
|
|
|
How to delete empty lines from a text file |
;==========================================================================================================================================
; How to delete empty lines from a text file? (c)20040327.Detlev Dalitz
;==========================================================================================================================================
;
; If you have a text file, which lines are delimited by the DOS standard line
; delimiter sequence @CR@LF, there exist some methods to delete empty lines.
;
;------------------------------------------------------------------------------------------------------------------------------------------
;
; 0. Understand lines of text as a stream of characters.
; 1. Using FileRead and FileWrite.
; 2. Using Binary Buffer functions.
; 3. Using FileGet and FilePut.
;
;------------------------------------------------------------------------------------------------------------------------------------------
;
; 0. Understand lines of text as a stream of characters.
;
; Example:
; Look at these three lines,
; they are the example lines,
; to explain how line delimiters work.
;
; What you see here in the document is:
; three lines of text.
;
; In a disk file these lines are organized as a stream of characters,
; where the lines are 'delimited' or 'connected' by a sequence of two characters,
; called 'Carriage Return' (@CR) and 'Linefeed' (@LF)
; (in former times data transport was done by type writer telegraphs).
;
; The text stream is stored as:
; "Look at these three lines,@CR@LFthey are the example lines,@CR@LFto explain how line delimiters work.@CR@LF"
;
;
; More simple view to the problem:
;
; The text stream looks like:
; "text@CR@LFtext@CR@LFtext@CR@LF"
;
; If there is an empty line in the stream, it looks like:
; "text@CR@LF@CR@LFtext@CR@LF"
;
; You see, an empty line is referenced by two following @CRLF sequences.
;
; If you replace two following @CRLF sequences by one sequence, then you delete one empty line.
; "text@CR@LF@CR@LFtext@CRqLF" ==> "text@CR@LFtext@CR@LF"
;
;
; Other view to the replacing problem:
;
; Replacing of the inner sequence "@LF@CR" with nothing has the same result
; as replacing two @CR@LF's with one @CR@LF.
;
; "@CR@LF@CR@LF" ==> "@CR@LF"
; "...======..." ==> "......"
;
; I will use this technique in further examples to speed the replacing action a little bit.
;
; But keep in mind:
; This only works on DOS standard delimited text files,
; where a line is delimited by a sequence of two special characters @CR@LF,
; the 'CarriageReturn+Linefeed' sequence.
;
;------------------------------------------------------------------------------------------------------------------------------------------
;
; 1. Using FileRead and FileWrite.
;
; Use the FileRead and FileWrite functions.,
; Read line by line from input file,
; skip empty lines,
; and write the good lines to output file.
sFilenameIn = "input.txt"
sFilenameOut = "output.txt"
hFR = FileOpen(sFilename,"READ")
hFW = FileOpen(sFilename,"WRITE")
While @TRUE
sLine = FileRead(hFR)
If (sLine=="") Then Continue
If (sLine=="*EOF*") Then Break
FileWrite(hFW,sLine)
EndWhile
FileClose(hFW)
FileClose(hFR)
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
;
; 2. Using Binary Buffer functions.
;
; Instead of reading a text file line by line,
; you may read the entire file into a binary buffer,
; and use binary buffer replace function to eliminate
; empty lines, then write the buffer back to the same
; filename or to a new filename.
;
; Following example changes the input file and saves it back to itself.
sFilename = "input.txt"
iFilesize = FileSize(sFilename)
If iFilesize
hBB = BinaryAlloc(iFilesize)
iResult = BinaryRead(hBB,sFilename)
iResult = BinaryReplace(hBB,StrCat(@LF,@CR),"",@TRUE)
iResult = BinaryWrite(hBB,sFilename)
iResult = BinaryFree(hBB)
EndIf
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
;
; 3. Using FileGet and FilePut.
;
; Instead of reading a text file line by line,
; you may read the entire file into a string by FileGet(),
; and use string replace function to eliminate
; empty lines, then write the string back to the same
; filename or to a new filename by FilePut().
;
; Following example reads a text file and saves changed text to new output file.
sFilenameIn = "input.txt"
sFilenameOut = "output.txt"
sString = FileGet(sFilenameIn)
If (sString>"")
sString = StrReplace(sString,StrCat(@LF,@CR),""))
iResult = FilePut(sFilenameOut,sString)
EndIf
Exit
; Almost the same as above, but condensed into one code line:
iResult = FilePut("output.txt",StrReplace(FileGet("input.txt"),StrCat(@LF,@CR),"")))
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
;==========================================================================================================================================
;*EOF*
|
|
|
How to extract a specified line from a text file |
;==========================================================================================================================================
; How to extract a specified line from a text file (c)20040327.Detlev Dalitz
;==========================================================================================================================================
;
; Assuming the given text file is a DOS standard text file
; with each line delimited by a sequence of @CR@LF,
; we are able to extract a line, say line number 5,
; by using different techniques.
;
;------------------------------------------------------------------------------------------------------------------------------------------
;
; 1. Using FileRead.
; 2. Using Binary Buffer functions.
; 3. Using Fileget and ItemExtract.
;
;------------------------------------------------------------------------------------------------------------------------------------------
;
; 1. Using FileRead.
iLineToExtract = 5
sFilename = "input.txt"
; sFilename = IntControl(1004,0,0,0,0) ; Use this script as input file.
iLine = 0
sLine = ""
hFR = FileOpen(sFilename,"READ")
While @TRUE
sLine = FileRead(hFR)
If (sLine=="*EOF*") Then Break
iLine = iLine + 1
If (iLine==iLineToExtract) Then Break
EndWhile
FileClose(hFR)
If (iLine==iLineToExtract)
Message(StrCat("This is Line # ",iLineToExtract),sLine)
Else
Message("Warning",StrCat("Line not found # ",iLineToExtract))
EndIf
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
;
; 2. Using Binary Buffer functions.
iLineToExtract = 5
sFilename = "input.txt"
; sFilename = IntControl(1004,0,0,0,0) ; Use this script as input file.
iLine = 0
sLine = ""
iFilesize = FileSize(sFilename)
If iFilesize
hBB = BinaryAlloc(1 + iFilesize)
iResult = BinaryPokeStr(hBB,0,@LF)
iResult = BinaryReadEx(hBB,1,sFilename,0,iFilesize)
sBBTag = BinaryTagInit(hBB,@LF,@CR)
While @TRUE
sBBTag = BinaryTagFind(sBBTag)
If (sBBTag=="") Then Break
iLine = iLine + 1
If (iLine==iLineToExtract)
sLine = BinaryTagExtr(sBBTag,0)
Break
EndIf
EndWhile
iResult = BinaryFree(hBB)
EndIf
If (iLine==iLineToExtract)
Message(StrCat("This is Line # ",iLineToExtract),sLine)
Else
Message("Warning",StrCat("Line not found # ",iLineToExtract))
EndIf
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
;
; 3. Using Fileget and ItemExtract.
iLineToExtract = 5
sFilename = "input.txt"
; sFilename = IntControl(1004,0,0,0,0) ; Use this script as input file.
sString = FileGet(sFilename)
sString = StrReplace(sString,@CRLF,@LF)
If (ItemCount(sString,@LF) >= iLineToExtract)
sLine = ItemExtract(iLineToExtract,sString,@LF)
Message(StrCat("This is Line # ",iLineToExtract),sLine)
Else
Message("Warning",StrCat("Line not found # ",iLineToExtract))
EndIf
Exit
; Almost the same as above, condensed into one code line:
sLine5 = ItemExtract(5,StrReplace(FileGet("input.txt"),@CRLF,@LF),@LF)
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
;==========================================================================================================================================
;*EOF*
|
|
|
udfParseCmdLineToArray (sCmdLine) |
;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfParseCmdLineToArray (sCmdLine)
ParseData(sCmdLine)
aParam = ArrDimension(Param0,4)
ArrInitialize(aParam,"")
iObject = 0
iOption = 0
For ii=1 To Param0
ia = ii-1
sParam = Param%ii%
If (1==StrScan(sParam,"-/",1,@FWDSCAN))
; Parameter type 1=Option.
aParam[ia,0] = 1
iOption = iOption + 1
aParam[ia,1] = iOption
sParam = StrSub(sParam,2,-1)
iPos = StrScan(sParam,":=",1,@FWDSCAN)
If iPos
; Name of option.
aParam[ia,2] = StrSub(sParam,1,iPos-1)
; Value of option.
aParam[ia,3] = StrSub(sParam,iPos+1,-1)
sParam = StrLower(aParam[ia,3])
Switch @TRUE
Case !!ItemLocate(sParam,"1,on,true,yes,+",",")
aParam[ia,3] = @TRUE
Break
Case !!ItemLocate(sParam,"0,off,false,no,-",",")
aParam[ia,3] = @FALSE
Break
EndSwitch
Else
; Option without specific value.
aParam[ia,2] = sParam
; Set value to @TRUE, that means, Option exists.
aParam[ia,3] = @TRUE
EndIf
Else
; Parameter type 0=Object.
aParam[ia,0] = 0
iObject = iObject + 1
aParam[ia,1] = iObject
aParam[ia,3] = sParam
EndIf
Next
Return (aParam)
;..........................................................................................................................................
; This function "udfParseCmdLineToArray (sCmdLine)" returns a 4-dim array.
; Cells are populated with parameters parsed from the given commandline string.
;..........................................................................................................................................
; aParam[0] = Type of parameter: 0=Object, 1=Option.
; aParam[1] = Ordinal number 1..n of parameter type.
; aParam[2] = Name of option, if any.
; aParam[3] = Value of parameter resp. option.
;..........................................................................................................................................
; Idea adapted from: Kevin van Haaren.
; Topic: Command line parser
; Conf: WinBatch Script Exchange
; From: kvanhaaren kvanhaaren@hntb.com
; Date: Saturday, June 16, 2001 07:52 PM
;..........................................................................................................................................
; Detlev Dalitz.20040329
;..........................................................................................................................................
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------
; --- test ---
sMsgTitle = "Demo udfParseCmdLineToArray (sCmdLine)"
sCmdLine = `WBApp.exe TheFileIn /lower -OEM:- TheFileOut -AppFolder:"C:\Program Files\" -Loop=forever /count=221` ; 8 parameters.
aParam = udfParseCmdLineToArray (sCmdLine)
GoSub DisplayResult
; +----+------------+-----------+--------------+-------------------+
; | A0 | B0 | B1 | B2 | B3 |
; +----+------------+-----------+--------------+-------------------+
; | A0 | Param Type | Ord. Nr. | Option Name | Param Value |
; +----+------------+-----------+--------------+-------------------+
; | 0 | 0 | 1 | | WBApp.exe |
; | 1 | 0 | 2 | | TheFileIn |
; | 2 | 1 | 1 | lower | 1 |
; | 3 | 1 | 2 | OEM | 0 |
; | 4 | 0 | 3 | | TheFileOut |
; | 5 | 1 | 3 | AppFolder | C:\Program Files |
; | 6 | 1 | 4 | Loop | forever |
; | 7 | 1 | 5 | count | 221 |
; +----+------------+-----------+--------------+-------------------+
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
:DisplayResult
iDims = ArrInfo(aParam,0) ; Number of dimensions in the array.
sMsgText = StrCat("iDims = ",iDims,@LF)
For iDim=1 To iDims
iDim%iDim% = ArrInfo(aParam,iDim) ; Number of elements in dimension x.
sMsgText = StrCat(sMsgText,"iDim%iDim% = ",iDim%iDim%,@LF)
Next
sMsgText = StrCat(sMsgText,@LF)
sResult = "[No array elements]"
If iDim1
iDim1High = iDim1 - 1
sResult = ""
For iDim1=0 To iDim1High
sRow = ""
iDim2High = iDim2 - 1
For iDim2=0 To iDim2High
sRow = ItemInsert(aParam[iDim1,iDim2],-1,sRow,@TAB)
Next
sResult = StrCat(sResult,sRow,@LF)
Next
EndIf
IntControl(63,200,200,800,700) ; Sets coordinates for AskFileText, AskItemList and AskTextBox windows.
IntControl(28,1,0,0,0) ; Selects system font used in list boxes. p1=1=fixed pitch font.
AskItemlist("Example udfParseCmdLineToArray (sCmdLine)",StrCat(sMsgText,sResult),@LF,@UNSORTED,@SINGLE)
Return
;------------------------------------------------------------------------------------------------------------------------------------------
;*EOF*
|
|
|
udfStrReplaceWild (sString, sWild, sReplace) |
;------------------------------------------------------------------------------------------------------------------------------------------ #DefineFunction udfStrReplaceWild (sString, sWild, sReplace) iRepLen = StrLen(sReplace) iWildPos = StrIndexWild(sString,sWild,1) While iWildPos iWildLen = StrLenWild(sString,sWild,iWildPos) sString = StrCat(StrSub(sString,1,iWildPos-1),sReplace,StrSub(sString,iWildPos+iWildLen,-1)) iWildPos = StrIndexWild(sString,sWild,iWildPos+iRepLen) EndWhile Return sString ;.......................................................................................................................................... ; Adapted from: ; Conf: WinBatch Script Exchange ; From: kdmoyers admin@guden.com ; Date: Friday, April 02, 2004 07:56 PM ; ; Modified by Detlev Dalitz.20040403 ;.......................................................................................................................................... #EndFunction ;------------------------------------------------------------------------------------------------------------------------------------------ ; --- test --- sString = "zsdqwdx.ABC.ashjfhhrebc.ydfmksdl" sWild = "a*c" sReplace = "O" sReplaced = udfStrReplaceWild(sString,sWild,sReplace) ; ==> "zsdqwdx.O.O.ydfmksdl" Message(sString,sReplaced) Exit ;------------------------------------------------------------------------------------------------------------------------------------------ ;*EOF* |
| Page Date 2004-05-18 DD-Software |
|
|
|
MyWbtHelp current version |