twfunc.tpl

在手机操作系统symbina上使用的一个脚本扩展语言的代码实现,可以参考用于自己的开发

endp


proc tLoc:
	local i%,a$(255),b$(1),name$(30)
	
	rem SubTest:("LOC test")
	name$="tWFunc\tLoc"
	a$="1234567890"
	i%=loc(a$,"1")
	if i%<>1 :raise 1 :endif
	i%=loc(a$,"0")
	if i%<>10 :raise 2 :endif
	i%=loc(a$,"")
	if i%<>1 :raise 3 :endif
	i%=loc(a$,"x")
	if i%<>0 :raise 4 :endif
	
	a$=rept$("A",254)+"1"
	i%=loc(a$,"1")
	if i%<>255 :raise 20 :endif
	i%=loc(a$,"A")
	if i%<>1 :raise 21 :endif
	i%=loc(a$,"")
	if i%<>1 :raise 22 :endif
	i%=loc(a$,"x")
	if i%<>0 :raise 23 :endif
	
	b$="1"
	i%=loc(b$,"1")
	if i%<>1 :raise 24 :endif
	i%=loc(b$,"")
	if i%<>1 :raise 25 :endif
	i%=loc(b$,"x")
	if i%<>0 :raise 26 :endif
endp



REM---------------------------------------------------------------------------

proc tFileW:
	
  rem SubTest:("Dbf Word Functions test")
  tExist:
  tCount:
  tEof:
  tPos:
  tBigFile:
endp


proc tBigFile:
  local i%,rec%,loops%,lastRec%
	
	rem cls
  rem SubTest:("FIND in large Database File")
  trap delete patha$+"\tWFunc.odb"
  rem print "Creating patha$+\tWFunc.odb"
  create patha$+"\tWFunc.odb",a,a$
	
  loops%=999
  lastRec%=loops%+1
  a.a$="a"
  rem print "Appending",loops%,"records of ""a""..."
  while i%<loops%
    append
    i%=i%+1
    rem if i%=i%/100*100 :at 1,7 :print i% :endif
  endwh
  a.a$="1234567890"
	rem print "Appending 1 record of """;a.a$;""""
  append
  if count <> lastRec% :raise 100 :endif
  if pos <> lastRec% :raise 101 :endif
  next
  if not eof :raise 102 :endif
	position 2
	if a.a$<>"a" :raise 103 :endif
	position lastRec%
	if pos<>lastRec% :raise 104 :endif
	if a.a$<>"1234567890" :raise 105 :endif
	rem print "Closing..."
  close
	rem print "Checking existence..."
  if not exist(patha$+"\tWFunc.odb") :raise 106 :endif
	rem print "Opening..."
  open patha$+"\tWFunc.odb",a,a$
  rem print "Finding *1* after",loops%,"records of 'a'"
  rec%=find("*1*")
  rem print "  Found",a.a$,"at record",
	if rec%>0
		rem print rec%
	else
		rem print 65536+rec%
  endif
  rem pause pause% :key
  if a.a$<>"1234567890" :raise 1 :endif
  if rec%<>lastRec% :raise 2:endif
	rem print "Closing..."
  close
	rem print "Deleting patha$+\tWFunc.odb ..."
  delete patha$+"\tWFunc.odb"
endp


proc tPos:
  local i%
	
  rem SubTest:("POS test")
  trap close :trap close :trap close :trap close
  onerr e1::
  pos
  raise 1 :rem all closed - must get error
	e1::
  onerr off
	
  trap delete patha$+"\tWFunc.odb"
	
  create patha$+"\tWFunc.odb",a,r%
  if pos<>1 :raise 2 :endif
  i%=0
  while i%<2
    a.r%=i%
    append
    i%=i%+1
    if pos<>i% :raise i%+2 :endif
  endwh
  first
  if pos<>1 :raise 10 :endif
  last
  if pos<>2 :raise 11 :endif
  next
  if pos<>3 :raise 12 :endif
  position 0
  if pos<>1 :raise 13 :endif
  position 100
  if pos<>3 :raise 14 :endif
  close
	
	rem Now check when OPENed
	
  open patha$+"\tWFunc.odb",a,r%
  if pos<>1 :raise 15 :endif
  first
  if pos<>1 :raise 16 :endif
  last
  if pos<>2 :raise 17 :endif
  next
  if pos<>3 :raise 18 :endif
  position 0
  if pos<>1 :raise 19 :endif
  position 100
  if pos<>3 :raise 20 :endif
  close
  delete patha$+"\tWFunc.odb"
endp


proc tExist:
  rem SubTest:("EXIST test")
	
  trap delete patha$+"\tWFunc.odb"
  if exist(patha$+"\tWFunc.odb") :raise 1 :endif
  create patha$+"\tWFunc.odb",a,a$,b$,c$,d$
  close
  if not exist(patha$+"\tWFunc.odb") :raise 3 :endif
  delete patha$+"\tWFunc.odb"
endp


proc tCount:
  rem SubTest:("COUNT test")
	
  trap close :trap close :trap close :trap close
  onerr e1::
  count
  raise 1 :rem all closed - must get error
	e1::
  onerr off
  trap delete patha$+"\tWFunc.odb"
  create patha$+"\tWFunc.odb",a,a$,b$,c$,d$
  if count<>0 :raise 2 :endif
  a.a$=""
  append
  if count<>1 :raise 3 :endif
  close
  delete patha$+"\tWFunc.odb"
endp


proc tEof:
  local i%
	
  rem SubTest:("EOF test")
  trap close :trap close :trap close :trap close
  onerr e1::
  while not eof
    raise 1 :rem all closed - must get error
  endwh
  raise 2
	e1::
  onerr off
  trap delete patha$+"\tWFunc.odb"
  create patha$+"\tWFunc.odb",a,r%
  i%=0
  while i%<2
    a.r%=i%
    append
    i%=i%+1
  endwh
  first
  i%=0
  while not eof
    rem print a.r%
    next
    i%=i%+1
  endwh
  if i%<>2 :raise 3 :endif
  close
  delete patha$+"\tWFunc.odb"
endp


REM--------------------------------------------------------------------------

proc tIo:
	rem SubTest:("Non-interactive IO test")
	tIow:
	tIoa:
	tWrRd:  :rem write and read
	tUnique:
endp


proc tIow:
	local err%,fcb%,buf$(255),message$(255),p%,fname$(30),len%
	local size%

	rem SubTest:("IOW test")
	fname$=patha$+"\tWFunc.txt"
	lopen fname$
	p%=addr(message$)+1+KOplAlignment%
	message$="IOW(-1) writes to LOPENed file ok"
	len%=len(message$)
	size%=SIZE(message$)
	err%=iow(-1,2,#p%,size%)
	if err%<0 :raise err% :endif
	lclose

	err%=ioOpen(fcb%,fname$,$220) :rem mode open|text|random
	if err% :raise 1: print err$(err) :pause pause% :raise 1 :endif

	err%=ioRead(fcb%,addr(buf$)+1+KOplAlignment%,255)
	if err%<0 : print err$(err) :pause pause% :raise 2 :endif
	pokeb addr(buf$),err%
	rem print buf$
	if buf$<>message$
		hLog%:(KhLogAlways%,"Expecting message$=["+message$+"]")
		hLog%:(KhLogAlways%,"Received buf$=["+buf$+"]")
		raise 3
	endif

	err%=ioClose(fcb%)
	if err% :raise 4 : print err$(err) :pause pause% :raise 4 :endif
	delete fname$
endp


proc tIoa:
  local err%,fcb%,buf$(255),message$(255),p%,fname$(30),status%,signals%,len%
	local size%
	
  rem SubTest:("IOA test")
  fname$=patha$+"\tWFunc.txt"
  lopen fname$
  p%=addr(message$)+1+KOplAlignment%
  message$="IOA(-1) writes to LOPENed file ok"
  len%=len(message$)
  size%=size(message$)
  status%=-46
  err%=ioa(-1,2,status%,#p%,size%)
  if err%<0 :raise err% :endif
	do
    iowait
    if status%=-46
      signals%=signals%+1
    endif
  until status%<>-46
  lclose
  if status% :raise status% :endif
  while signals% :rem 1 less for THIS ioa
    IoSignal
    signals%=signals%-1
  endwh
	
  err%=ioOpen(fcb%,fname$,$220) :rem mode open|text|random
  if err% :raise 1: print err$(err) :pause pause% :raise 1 :endif
  
  err%=ioRead(fcb%,addr(buf$)+1+KOplAlignment%,255)
  if err%<0 :raise 2 : print err$(err) :pause pause% :raise 2 :endif
  pokeb addr(buf$),err%
  rem print buf$
  if buf$<>message$ : raise 3 :endif
	
  err%=ioClose(fcb%)
  if err% :raise 4 : print err$(err) :pause pause% :raise 4 :endif
  delete fname$
endp


proc tUnique:
	local ret%,handle%,name$(128)
	
  rem SubTest:("IOOPEN Unique name test")
  name$="\fred"
	ret%=ioopen(handle%,addr(name$),4)
  if ret%<0
		rem print err$(ret%)
	else
    if loc(name$,".")=0
			name$=name$+"."
		endif
		rem print "Unique name =",name$
  endif
  ioclose(handle%)
	delete name$
endp


proc tWrRd:
  local err%,cb%,mode%,ioFunc%,access%,format%
  local fName$(64),txt$(255),res$(255)
  local pos&,sense%
  local size%
	
  rem SubTest:("IOOPEN/IOWRITE/IOREAD/IOCLOSE test")
  fName$=patha$+"\t_io.txt"
  trap delete fName$
  ioFunc%=$01 					:rem Create
  format%=$10						:rem STREAM_TEXT
  access%=$300					:rem UPDATE|RANDOM
  mode%=ioFunc% OR format% OR access%
  err%=ioOpen(cb%,fName$,mode%)
  if err%
  		raise 1
    rem print "Error opening",fName$
		rem print err$(err%) :beep 3,1000
    rem get
  endif
  txt$="IoWrite worked"
  size%=size(txt$)
  err%=ioWrite(cb%,addr(txt$)+1+KOplAlignment%,size%) REM stream_text is binary.
	if err%
		doClose:(cb%,fname$)
		raise 2
		rem print "Error writing to",fName$
		rem print err$(err%) :beep 3,1000
    rem get
  endif
  rem print "Written:",txt$
  pos&=0
  sense%=1			: rem from start	
  err%=ioSeek(cb%,sense%,pos&)
  if err%
		doClose:(cb%,fName$)
    raise 3
    print "Error seeking to start of",fName$
		print err$(err%) :beep 3,1000
    get
  endif
  err% = ioread(cb%,addr(res$)+1+KOplAlignment%,255)
  if err%<0
		doClose:(cb%,fName$)
    raise 4
    print "Error reading",fName$
		print err$(err%) :beep 3,1000
    get
  endif
  pokeB addr(res$), err%
  rem print "Read:",res$
  if res$<>txt$
  	print "Read=[";res$;"] len=";len(res$)
  	print "Expt=[";txt$;"] len=";len(txt$)
  	hLog%:(Khlogalways%,"!!TODO燬kipping over stream_text error.")
  	rem raise 6
  endif
	doClose:(cb%,fName$)
  rem print "Finished IoOpen,IoWrite,IoRead,IoSeek,IoClose ok"
  rem pause pause% :key
endp


proc doClose:(cb%,fName$)
	local err%
	err%=ioClose(cb%)
	if err%
		raise err%
		rem print "Error closing",fName$
		rem print err$(err%) :beep 3,1000
		rem get
	endif
endp


REM End of tWFunc.tpl