WinBatch Tech Support Home

Database Search

If you can't find the information using the categories below, post a question over in our WinBatch Tech Support Forum.

TechHome

UDF - UDS Library
plus
plus
plus
plus
plus
plus
plus
plus
plus
plus
plus
plus
plus
plus
plus
plus
plus
plus
plus
plus
plus
plus
plus

Can't find the information you are looking for here? Then leave a message over on our WinBatch Tech Support Forum.

Sample UDFs from Stan Littlefield

Keywords: 	 UDFs

;=========== Winbatch 2001 UDF's and Samples =======================
; submitted by Stan Littlefield
; used for Beta Testing of WB2001a
;
;=======================================================================

;section1
;=========== Date and Time Routines =====================================
; illustrates use of User Defined Functions to manipulate
; date values. Just cut out this section until you see the
; End of Routine comment, paste it into something like Dates.Wbt
;=======================================================================

#DefineFunction TimeVars()
today         = formatd(TimeYmdHms())
localArray    = ArrDimension(4,0,0,0,0)
localArray[0] = strsub( Timedate(),1,3 )
localArray[1] = int ( strsub(today,1,2)  )  ; month
localArray[2] = int ( strsub(today,4,2)  )  ; day
localArray[2] = int ( strsub(today,7,4)  )  ; year
Return(localArray)
#EndFunction

#DefineFunction formatd(date)
Return(strcat( strsub(date,6,2),"/",strsub(date,9,2),"/",strsub(date,1,4)  ))
#EndFunction

#DefineFunction bom(date)
;date must be in format mm/dd/yyyy as a string
Return( strcat( strsub(date,1,3),"01",strsub(date,6,5) ) )
#EndFunction

#DefineFunction bonm(date)
;date must be in format mm/dd/yyyy as a string
curmon = int( strsub(date,1,2) )
If curmon==12
   nextmon='01'
Else
   If curmon==9
      nextmon='01'
   Endif
   If curmon<=8
      nextmon = strcat("0",curmon+1)
   Else
      nextmon = strcat("",curmon+1)
   Endif
Endif
Return( strcat( nextmon,"/01",strsub(date,6,5) ) )
#EndFunction

#DefineFunction eom(date)
;date must be in format mm/dd/yyyy as a string
mend = int( strsub(date,1,2) )
year = int( strsub(date,7,4) )
Switch mend
   case 1
      em="31"
      break
   case 2
      If year mod 4 = 0
         em="29"
      Else
         em="28"
      Endif
      break
   case 3
      em="31"
      break
   case 4
      em="30"
      break
   case 5
      em="31"
      break
   case 6
      em="30"
      break
   case 7
      em="31"
      break
   case 8
      em="31"
      break
   case 9
      em="30"
      break
   case 10
      em="31"
      break
   case 11
      em="30"
      break
   case 12
      em="31"
      break

EndSwitch
Return( strcat( strsub(date,1,3),em,strsub(date,6,5) ) )
#EndFunction


;first, test out the functions
today = formatd(TimeYmdHms())
message( "Todays Date",today )

message( "Beginning Of This Month",bom(today) )

message( "Beginning Of Next Month",bonm(today))

message( "End of This Month",eom(today))

;now test out modifying an array element
Array = TimeVars()
message ( "Current Day",Array[0] )
NewArray = Array
NewArray[0] = "April Fools!"
message ( NewArray[0],Array[0] )

exit

;================= End of Routine ======================================


;section2
; ///////////////////////////////////////////////////////
; Tests a UDF to build an Array from a Text File
; added test for new Arrinfo() function, and the
; Stan Littlefield 09/30/2000
; ///////////////////////////////////////////////////////
#DefineFunction formatd(date)
Return(strcat( strsub(date,6,2),"/",strsub(date,9,2),"/",strsub(date,1,4)  ))
#EndFunction

#DefineFunction TimeVars()
today         = formatd(TimeYmdHms())
localArray    = ArrDimension(4,0,0,0,0)
localArray[0] = strsub( Timedate(),1,3 )
localArray[1] = int ( strsub(today,1,2)  )  ; month
localArray[2] = int ( strsub(today,4,2)  )  ; day
localArray[3] = int ( strsub(today,7,4)  )  ; year
Return(localArray)
#EndFunction


#DefineFunction getinfo(PassedArray)
aInfo    = ArrDimension(7,0,0,0,0)
aInfo[0] = ArrInfo(PassedArray,0)
aInfo[1] = ArrInfo(PassedArray,1)
aInfo[2] = ArrInfo(PassedArray,2)
aInfo[3] = ArrInfo(PassedArray,3)
aInfo[4] = ArrInfo(PassedArray,4)
aInfo[5] = ArrInfo(PassedArray,5)
aInfo[6] = ArrInfo(PassedArray,6)
Return(aInfo)
#EndFunction

#DefineFunction aFileRead(file)
IF FileExist(file) == @FALSE
  Return(0)
Endif
localArray = ArrDimension(20,0,0,0,0)
i=0
cFile      = FileOpen(file,"READ")
While @TRUE
   x = FileRead(cFile)
   If x == "*EOF*" Then Break
   localArray[i]=x
   i = i+1
EndWhile
FileClose(cFile)
Return(localArray)
#EndFunction


aTime  = TimeVars()

; try renaming months.dat to months.sav to test this next code sequence
aArray = aFileRead("months.dat")
If ! ( VarType( aArray ) == 256 )
   message("Error Occured","File Missing To Read into Array")
Else
   aInfo  = getinfo(aArray)
   message("The Results",strcat("The Array Contains ",aInfo[1]," elements") )
   message("The Current Month Is",aArray[ aTime[1] ]  )
Endif

exit


; paste the lines below into a file called months.dat
; in order to run this
;
January
February
March
April
May
June
July
August
September
October
November
December

; end of paste

;================= End of Routine ======================================


;section3
; ///////////////////////////////////////////////////////
; this next routine illustrates passing OLE Objects
; to a UDF. Useful for creating generic OLE UDF's to
; handle data processing,
; ///////////////////////////////////////////////////////
#DefineFunction ExcelArray(DB,nSheet)
aArray    = ArrDimension(10,0,0,0,0) ; assigns array to Objects
aArray[0] = DB.Visible
aArray[1] = DB.UserControl
aArray[2] = DB.Workbooks
aArray[2].Add()
aArray[3] = DB.ActiveWorkbook
aArray[4] = DB.Worksheets(1)
Return(aArray)
#EndFunction


DB        = ObjectOpen("Excel.Application")
eArray    = ExcelArray(DB,1)

eArray[0] = @TRUE    ;now reference a generic array element
eArray[1] = @TRUE
eArray[4].Activate

oCell       = eArray[4].Range("A1")
oCell.Value = 20.25
oCell       = eArray[4].Range("B1")
oCell.Value = 10.75
oCell       = eArray[4].Range("C1")
oCell.Formula = "=A1*B1"

oCell       = eArray[4].Range("A1:C1")
oFont       = oCell.Font
oFont.Size  = 14
oFont.Bold  = @TRUE
oFont.Italic = @TRUE
oFont       = oCell.Interior
oFont.ColorIndex = 6
oFont       = oCell.Borders
oFont.LineStyle = 12
oFont.Weight = 3

ObjectClose(DB)
exit

;================= End of Routine ======================================


;section4
; ///////////////////////////////////////////////////////
; Test Script for Working with JET Provider 4.0.
; And using the new arrays in Winbatch to hold
; Table Type and Table Names
;
; NOTE: even though Tbls = cat.Tables is defined in the script
;       pass cat to the udf, not Tbls
;
; Stan Littlefield 09/24/2000
; ///////////////////////////////////////////////////////

#DefineFunction GetTables(nCount,cat)
lArray  = ArrDimension(nCount,2,0,0,0)
For i=0 To nCount-1
   tbl = cat.Tables(i)
   lArray[i,0]  = tbl.Name
   lArray[i,1]  = tbl.Type
Next
Return(lArray)
#EndFunction


cat = ObjectOpen("ADOX.Catalog")

;change the Source= to fir your own situation
cat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=E:\WBDEMO\BLANK.MDB;"

Tbls   = cat.Tables
nCount = Tbls.count()

aOle = GetTables(nCount,cat)

ObjectClose(cat)

For i=0 To nCount-1
    message("Table %i%",strcat("NAME: ",aOle[i,0]," TYPE: ",aOle[i,1]) )
Next


exit

;================= End of Routine ======================================

;section5
; ///////////////////////////////////////////////////////
; Winbatch UDF to test impproved capabilities of the
; 2001 OLE Extender.
;
; The previous Extender had problems with Excel cells formatted
; as currency and date.
;
; Passing a cell to the UDF checks for these and formats accordingly
;
; Stan Littlefield 10/15/2000
; ///////////////////////////////////////////////////////

#DefineFunction GetValue(value,format)
Ret_Val = value

; determine if Cell Formated as Currency
If StrIndex(format,"$",1,@FWDSCAN) <> 0
   Ret_Val = StrSub(value,11,-1)
Endif

; determine if Cell Formated as Date
If StrIndex(format,"yy",1,@FWDSCAN) <> 0
   Ret_Val = Strcat( StrSub(value,6,2),"/",StrSub(value,9,2),"/",StrSub(value,1,4)  )
Endif

Return(Ret_Val)
#EndFunction

;usage
;   oCell   = oWS.Cells(i,2)
;   cFormat = oCell.NumberFormat
;   cValue  = GetValue( oCell.Value, cFormat )

;================= End of Routine ======================================

Article ID:   W14996
File Created: 2001:11:08:12:41:18
Last Updated: 2001:11:08:12:41:18