IDC资讯中心
option explicit
===============================================
words.bas – string handling functions for words
author: evan sims [esims@arcola-il.com]
based on a module by kevin obrien
version – 1.2 (sept. 1996 – dec 1999)
these functions deal with "words".
words = blank-delimited strings
blank = any combination of one or more spaces,
tabs, line feeds, or carriage returns.
examples:
pword("find 3 in here", 3) = "in" 3rd word
words("find 3 in here") = 4 number of words
split("heres /s more", "/s") = "more" returns words after split identifier (/s)
delword("find 3 in here", 1, 2) = "in here" delete 2 words, start at 1
midword("find 3 in here", 1, 2) = "find 3" return 2 words, start at 1
wordpos("find 3 in here", "in") = 3 word-number of "in"
wordcount("find 3 in here", "in") = 1 occurrences of word "in"
wordindex("find 3 in here", "in") = 8 position of "in"
wordindex("find 3 in here", 3) = 8 position of 3rd word
wordindex("find 3 in here", "3") = 6 position of "3"
wordlength("find 3 in here", 3) = 2 length of 3rd word
difference between instr() and wordindex():
instr("find 3 in here", "in") = 2
wordindex("find 3 in here", "in") = 8
instr("find 3 in here", "her") = 11
wordindex("find 3 in here", "her") = 0
===============================================
public function pword(byval ssource as string, _
n as long) as string
=================================================
word retrieves the nth word from ssource
usage:
word("red blue green ", 2) "blue"
=================================================
const sp as string = " "
dim pointer as long start parameter of instr()
dim pos as long position of target in instr()
dim x as long word count
dim lend as long position of trailing word delimiter
ssource = cspace(ssource)
find the nth word
x = 1
pointer = 1
do
do while mid$(ssource, pointer, 1) = sp skip consecutive spaces
pointer = pointer + 1
loop
if x = n then the target word-number
lend = instr(pointer, ssource, sp) pos of space at end of word
if lend = 0 then lend = len(ssource) + 1 or if its the last word
pword = mid$(ssource, pointer, lend – pointer)
exit do word found, done
end if
pos = instr(pointer, ssource, sp) find next space
if pos = 0 then exit do word not found
x = x + 1 increment word counter
pointer = pos + 1 start of next word
loop
end function
public function words(byval ssource as string) as long
=================================================
words returns the number of words in a string
usage:
words("red blue green") 3
=================================================
const sp as string = " "
dim lsource as long length of ssource
dim pointer as long start parameter of instr()
dim pos as long position of target in instr()
dim x as long word count
ssource = cspace(ssource)
lsource = len(ssource)
if lsource = 0 then exit function
count words
x = 1
pointer = 1
do
do while mid$(ssource, pointer, 1) = sp skip consecutive spaces
pointer = pointer + 1
loop
pos = instr(pointer, ssource, sp) find next space
if pos = 0 then exit do no more words
x = x + 1 increment word counter
pointer = pos + 1 start of next word
loop
if mid$(ssource, lsource, 1) = sp then x = x – 1 adjust if trailing space
words = x
end function
public function wordcount(byval ssource as string, _
starget as string) as long
=====================================================
wordcount returns the number of times that
word, starget, is found in ssource.
usage:
wordcount("a rose is a rose", "rose") 2
=================================================
const sp as string = " "
dim pointer as long start parameter of instr()
dim lsource as long length of ssource
dim ltarget as long length of starget
dim pos as long position of target in instr()
dim x as long word count
ltarget = len(starget)
lsource = len(ssource)
ssource = cspace(ssource)
find target word
pointer = 1
do while mid$(ssource, pointer, 1) = sp skip consecutive spaces
pointer = pointer + 1
loop
if pointer > lsource then exit function ssource contains no words
do find position of starget
pos = instr(pointer, ssource, starget)
if pos = 0 then exit do string not found
if mid$(ssource, pos + ltarget, 1) = sp _
or pos + ltarget > lsource then must be a word
if pos = 1 then
x = x + 1 word found
elseif mid$(ssource, pos – 1, 1) = sp then
x = x + 1 word found
end if
end if
pointer = pos + ltarget
loop
wordcount = x
end function
public function wordpos(byval ssource as string, _
starget as string) as long
=====================================================
wordpos returns the word number of the
word, starget, in ssource.
usage:
wordpos("red blue green", "blue") 2
=================================================
const sp as string = " "
dim pointer as long start parameter of instr()
dim lsource as long length of ssource
dim ltarget as long length of starget
dim lpostarget as long position of target-word
dim pos as long position of target in instr()
dim x as long word count
ltarget = len(starget)
lsource = len(ssource)
ssource = cspace(ssource)
find target word
pointer = 1
do while mid$(ssource, pointer, 1) = sp skip consecutive spaces
pointer = pointer + 1
loop
if pointer > lsource then exit function ssource contains no words
do find position of starget
pos = instr(pointer, ssource, starget)
if pos = 0 then exit function string not found
if mid$(ssource, pos + ltarget, 1) = sp _
or pos + ltarget > lsource then must be a word
if pos = 1 then exit do word found
if mid$(ssource, pos – 1, 1) = sp then exit do
end if
pointer = pos + ltarget
loop
count words until position of starget
lpostarget = pos save position of starget
pointer = 1
x = 1
do
do while mid$(ssource, pointer, 1) = sp skip consecutive spaces
pointer = pointer + 1
loop
if pointer >= lpostarget then exit do all words have been counted
pos = instr(pointer, ssource, sp) find next space
if pos = 0 then exit do no more words
x = x + 1 increment word count
pointer = pos + 1 start of next word
loop
wordpos = x
end function
public function wordindex(byval ssource as string, _
vtarget as variant) as long
===========================================================
wordindex returns the byte position of vtarget in ssource.
vtarget can be a word-number or a string.
usage:
wordindex("two plus 2 is four", 2) 5
wordindex("two plus 2 is four", "2") 10
wordindex("two plus 2 is four", "two") 1
===========================================================
const sp as string = " "
dim starget as string vtarget converted to string
dim ltarget as long vtarget converted to long, or length of starget
dim lsource as long length of ssource
dim pointer as long start parameter of instr()
dim pos as long position of target in instr()
dim x as long word counter
lsource = len(ssource)
ssource = cspace(ssource)
if vartype(vtarget) = vbstring then goto strindex
if not isnumeric(vtarget) then exit function
ltarget = clng(vtarget) convert to long
find byte position of ltarget (word number)
x = 1
pointer = 1
do
do while mid$(ssource, pointer, 1) = sp skip consecutive spaces
pointer = pointer + 1
loop
if x = ltarget then word-number of target
if pointer > lsource then exit do beyond end of ssource
wordindex = pointer position of word
exit do word found, done
end if
pos = instr(pointer, ssource, sp) find next space
if pos = 0 then exit do word not found
x = x + 1 increment word counter
pointer = pos + 1
loop
exit function
strindex:
starget = cstr(vtarget)
ltarget = len(starget)
if ltarget = 0 then exit function nothing to count
find byte position of starget (string)
pointer = 1
do
pos = instr(pointer, ssource, starget)
if pos = 0 then exit do
if mid$(ssource, pos + ltarget, 1) = sp _
or pos + ltarget > lsource then
if pos = 1 then exit do
if mid$(ssource, pos – 1, 1) = sp then exit do
end if
pointer = pos + ltarget
loop
wordindex = pos
end function
public function wordlength(byval ssource as string, _
n as long) as long
=========================================================
wordlength returns the length of the nth word in ssource
usage:
wordlength("red blue green", 2) 4
=========================================================
const sp as string = " "
dim lsource as long length of ssource
dim pointer as long start parameter instr()
dim pos as long position of target with instr()
dim x as long word count
dim lend as long position of trailing word delimiter
ssource = cspace(ssource)
lsource = len(ssource)
find the nth word
x = 1
pointer = 1
do
do while mid$(ssource, pointer, 1) = sp skip consecutive spaces
pointer = pointer + 1
loop
if x = n then the target word-number
lend = instr(pointer, ssource, sp) pos of space at end of word
if lend = 0 then lend = lsource + 1 or if its the last word
wordlength = lend – pointer
exit do word found, done
end if
pos = instr(pointer, ssource, sp) find next space
if pos = 0 then exit do word not found
x = x + 1 increment word counter
pointer = pos + 1 start of next word
loop
end function
public function delword(byval ssource as string, _
n as long, _
optional vwords as variant) as string
===========================================================
delword deletes from ssource, starting with the
nth word for a length of vwords words.
if vwords is omitted, all words from the nth word on are
deleted.
usage:
delword("now is not the time", 3) "now is"
delword("now is not the time", 3, 1) "now is the time"
===========================================================
const sp as string = " "
dim lwords as long length of starget
dim lsource as long length of ssource
dim pointer as long start parameter of instr()
dim pos as long position of target in instr()
dim x as long word counter
dim lstart as long position of word n
dim lend as long position of space after last word
lsource = len(ssource)
delword = ssource
ssource = cspace(ssource)
if ismissing(vwords) then
lwords = -1
elseif isnumeric(vwords) then
lwords = clng(vwords)
else
exit function
end if
if n = 0 or lwords = 0 then exit function nothing to delete
find position of n
x = 1
pointer = 1
do
do while mid$(ssource, pointer, 1) = sp skip consecutive spaces
pointer = pointer + 1
loop
if x = n then the target word-number
lstart = pointer
if lwords < 0 then exit do
end if
if lwords > 0 then lwords was provided
if x = n + lwords – 1 then find pos of last word
lend = instr(pointer, ssource, sp) pos of space at end of word
exit do word found, done
end if
end if
pos = instr(pointer, ssource, sp) find next space
if pos = 0 then exit do word not found
x = x + 1 increment word counter
pointer = pos + 1 start of next word
loop
if lstart = 0 then exit function
if lend = 0 then
delword = trim$(left$(ssource, lstart – 1))
else
delword = trim$(left$(ssource, lstart – 1) & mid$(ssource, lend + 1))
end if
end function
public function midword(byval ssource as string, _
n as long, _
optional vwords as variant) as string
===========================================================
midword returns a substring ssource, starting with the
nth word for a length of vwords words.
if vwords is omitted, all words from the nth word on are
returned.
usage:
midword("now is not the time", 3) "not the time"
midword("now is not the time", 3, 2) "not the"
===========================================================
const sp as string = " "
dim lwords as long vwords converted to long
dim lsource as long length of ssource
dim pointer as long start parameter of instr()
dim pos as long position of target in instr()
dim x as long word counter
dim lstart as long position of word n
dim lend as long position of space after last word
lsource = len(ssource)
ssource = cspace(ssource)
if ismissing(vwords) then
lwords = -1
elseif isnumeric(vwords) then
lwords = clng(vwords)
else
exit function
end if
if n = 0 or lwords = 0 then exit function nothing to delete
find position of n
x = 1
pointer = 1
do
do while mid$(ssource, pointer, 1) = sp skip consecutive spaces
pointer = pointer + 1
loop
if x = n then the target word-number
lstart = pointer
if lwords < 0 then exit do include rest of ssource
end if
if lwords > 0 then lwords was provided
if x = n + lwords – 1 then find pos of last word
lend = instr(pointer, ssource, sp) pos of space at end of word
exit do word found, done
end if
end if
pos = instr(pointer, ssource, sp) find next space
if pos = 0 then exit do word not found
x = x + 1 increment word counter
pointer = pos + 1 start of next word
loop
if lstart = 0 then exit function
if lend = 0 then
midword = trim$(mid$(ssource, lstart))
else
midword = trim$(mid$(ssource, lstart, lend – lstart))
end if
end function
public function cspace(ssource as string) as string
==================================================
cspace converts blank characters
(ascii: 9,10,13,160) to space (32)
cspace("a" & vbtab & "b") "a b"
cspace("a" & vbcrlf & "b") "a b"
==================================================
dim pointer as long
dim pos as long
dim x as long
dim ispace(3) as integer
define blank characters
ispace(0) = 9 horizontal tab
ispace(1) = 10 line feed
ispace(2) = 13 carriage return
ispace(3) = 160 hard space
cspace = ssource
for x = 0 to ubound(ispace) replace all blank characters with space
pointer = 1
do
pos = instr(pointer, cspace, chr$(ispace(x)))
if pos = 0 then exit do
mid$(cspace, pos, 1) = " "
pointer = pos + 1
loop
next x
end function
public function splitstring(isource as string, itarget as string, optional beforetarget as boolean = false) as string
==================================================
returns the characters before or after the split
identifier. by default will return text after id,
set beforetarget as true to return the text before
it.
==================================================
if beforetarget = true then
splitstring = delword(isource, wordpos(isource, itarget))
else
splitstring = delword(isource, 1, wordpos(isource, itarget))
end if
end function
