*/ Procedure illustrates creating a view on an Oracle DB dynamically, then
*/ processing the view with VFP code, as if it were a native table
PROCEDURE synchTran
*/ Synchronize the RTRAN table so that VFP version
*/ and Oracle version are consistent */
*/ Connect to Oracle DB via ODBC name, with valid user/password
iConnection = SQLCONNECT('opr1', 'vfpuser', 'vfpuser')
*/ Create view of Oracle table, assign to VFP alias OraVuRTran
iResult = SQLEXEC(iConnection, "SELECT * FROM developer.VFPRTran",
"OraVuRTran")
*/ If the Oracle view is not empty
IF RECCOUNT("OraVuTran") > 0
*/ Open VFP table
USE RTran AGAIN ALIAS UPD_RTran ORDER TAG pair SHARED IN 0
*/ Create array of rows in the VFP table but not in the Oracle View
SELECT rstenid + enid FROM UPD_RTran ;
WHERE NOT DELETED() AND ;
rstenid + enid NOT IN (SELECT rstenid + enid FROM OraVuTran) ;
INTO ARRAY laXEntry
*/ If there are any items in the resulting array,
*/ delete the corresponding row
IF _TALLY > 0
nALen = ALEN(laXEntry,1)
SELECT UPD_RTran
FOR I = 1 TO nALen
IF SEEK(laXEnid[I])
DELETE
ENDIF
ENDFOR
ENDIF
*/ Scan through the Oracle view,
*/ and add the row to the VFP table if its not there
SELECT OraVuTran
SCAN
SELECT UPD_RTran
IF !SEEK(OraVuTran.rstenid + OraVuTran.enid)
*/ Add a new entry
=NewStamp()
REPLACE rstenid WITH OraVuTran.rstenid, ;
enid WITH OraVuTran.enid, ;
tpdate WITH OraVuTran.Origdate
ENDIF
ENDSCAN
*-- Close VFP Table and Oracle View
USE IN UPD_RTran
USE IN OraVuTran
ENDIF
*/ Close the connection to the server
iResult = SQLDISCONNECT(iConnection)
RETURN
Figure 6 Documented Genhtml Code
LOCAL ii,rv,mt,mAllFields,nFields
*-- Determine whether the grid was formatted with specific fields
mAllFields = THIS.COLUMNCOUNT = -1
*-- Initialize HTML string
rv = '<table border = "10">' + CHR(13)
*-- Select the table or view that supplies the data
SELECT (THIS.RECORDSOURCE)
IF CURSORGETPROP("sourcetype") = 3 && it's a table, not a view
LOCATE
ENDIF
*-- Determine how many fields to process
nFields = IIF(m.mAllFields, FCOUNT(),THIS.COLUMNCOUNT)
*-- Process each of the fields to generate table headings
FOR ii = 1 TO m.nFields
IF m.mAllFields
IF TYPE("EVAL(FIELD(m.ii))") = 'G'
LOOP && don't proc general fields
ENDIF
*-- Use field name for heading
rv = rv + "<th>" + PROPER(FIELD(m.ii)) + "</th>" + CHR(13)
ELSE
*-- Use defined field name for heading
rv = rv + "<th>" + THIS.COLUMNS[m.ii].header1.CAPTION + "</th>" + CHR(13)
ENDIF
ENDFOR
rv = rv + "</tr>" + CHR(13)
SCAN
*-- Process values for each row in recordsource
rv = rv + "<tr>"
FOR ii = 1 TO m.nFields
IF m.mAllFields
IF TYPE("EVAL(FIELD(m.ii))") = 'G'
LOOP && don't proc general fields
ENDIF
*-- Read value of field into variable
mt = EVAL(FIELD(m.ii))
ELSE
*-- Read value of column into variable
mt = EVAL(THIS.COLUMNS[m.ii].text1.CONTROLSOURCE)
ENDIF
*-- Convert noncharacter values to strings and add to HTML
DO CASE
CASE TYPE("mt") = 'C'
rv = rv + "<td>" + mt + "</td>"
CASE TYPE("mt") = 'T'
rv = rv + "<td>" + TTOC(mt) + "</td>"
CASE TYPE("mt") $ 'NY'
rv = rv + "<td align=right>" + STR(mt,8) + "</td>"
CASE TYPE("mt") = 'D'
rv = rv + "<td>" + DTOC(mt) + "</td>"
ENDCASE
rv = rv + CHR(13)
ENDFOR
rv = rv + "</tr>"
ENDSCAN
*-- Close table tag and return the generated string
rv = rv +"</table>"
RETURN rv
Figure 7 Loading an ActiveDoc App
**************************************************
*-- Class: clsrunbsr (q:\sbtpro50\spitzer\sbtactivedocs.vcx)
*-- ParentClass: activedoc
*-- BaseClass: activedoc
*
DEFINE CLASS clsrunbsr AS activedoc
Height = 37
Width = 37
Caption = "Activedoc1"
ContainerReleaseType = 1
Name = "clsrunbsr"
PROCEDURE Run
LPARAMETERS cHyperLinkTarget
DO FORM tsbsr WITH .t.
READ EVENTS
ENDPROC
ENDDEFINE
*
*-- EndDefine: clsrunbsr
Figure 8 INIT Method for a Form
*-- Method: frmBSR:init
*-- Parameters: none
*-- Returns: logical, indicating successful creation of object
*-- Call new VFP function to determine if form is hosted
IF IsHosted()
*-- Set form property indicating that its running in an ActiveDoc
Thisform.ll_ActiveForm = .t.
*-- Turn off local titlebar
Thisform.Titlebar = 0
*-- Maximize the window
Thisform.WindowState = 2
*-- Display both horizontal and vertical scrollbars
Thisform.Scrollbars = 3
ELSE
*-- Form is not running in an ActiveDoc
Thisform.ll_activeform = .f.
ENDIF
*-- Load data into textboxes
= Thisform.l_setbsr()
RETURN .t.
Figure 10 VFPActiveX Class Code
*-- Class: vfpactivex (d:\wip\vfp_article\jgle\vfpactivex.vcx)
*-- ParentClass: custom
*-- BaseClass: custom
*-- Payroll calculations intended to be accessed from Web page.
*
DEFINE CLASS vfpactivex AS custom OLEPUBLIC
Name = "vfpactivex"
payamount = .F.
payperiod = .F.
exemptions = .F.
maritalstatus = .F.
socialsecuritytax = .F.
medicaretax = .F.
federalincometax = .F.
stateincometax = .F.
statedisabilitytax = .F.
*-- Calculate Net Pay
PROCEDURE netpay
#DEFINE DATA_PATH "c:\projects\jfoxis\"
LOCAL nNetPay, ;
nSocialSecurity, ;
nMedicare, ;
nFederalIncomeTax, ;
nStateIncomeTax, ;
nStateDisability
LOCAL lcTaxid, ;
lcFilingStatus
This.SocialSecurityTax = ROUND(This.PayAmount * .062, 2)
This.MedicareTax = ROUND(This.PayAmount * .0145, 2)
nNetPay = (This.PayAmount - This.SocialSecurityTax - This.MedicareTax)
*-- Defensive programming - verify that tables are available before opening
IF FILE(DATA_PATH + "prtxfs01.dbf") ;
AND FILE(DATA_PATH + "prtxfs01.cdx")
USE (DATA_PATH + "prtxfs01") ALIAS a_prtxfs ;
ORDER taxid1 IN 0
ENDIF
IF FILE(DATA_PATH + "prtabl01.dbf") AND ;
FILE(DATA_PATH + "prtabl01.cdx")
USE (DATA_PATH + "prtabl01") ALIAS a_prtabl ORDER taxid1 IN 0
ENDIF
IF USED("a_prtabl") AND USED("a_prtxfs")
*-- Call Federal Tax Calc method
This.FederalIncomeTax = This.CalcFederalIncomeTax(This.PayAmount)
IF This.FederalIncomeTax >= 0
nNetPay = nNetPay - This.FederalIncomeTax
ENDIF
*-- Call State Tax Calc method
This.StateIncomeTax = This.CalcStateIncomeTax(This.PayAmount)
IF This.StateIncomeTax >= 0
nNetPay = nNetPay - This.StateIncomeTax
ENDIF
USE IN a_prtxfs
USE IN a_prtabl
ENDIF
This.StateDisabilityTax = ROUND(This.PayAmount * .012, 2)
nNetPay = nNetPay - This.StateDisabilityTax
RETURN ALLTRIM(STR(nNetPay))
ENDPROC
*-- Calculate amount withheld
PROCEDURE amtwithheld
Local nAmtWithHeld
nAmtWithHeld = This.SocialSecurityTax + ;
This.MedicareTax + ;
This.FederalIncomeTax + ;
This.StateIncomeTax + ;
This.StateDisabilityTax
RETURN ALLTRIM(STR(nAmtWithHeld))
ENDPROC
*-- Assign method for payamount, executed when property assigned on ASP
PROCEDURE payamount_assign
LPARAMETERS vNewVal
*-- Transform amount passed as string to number
THIS.payamount = VAL(m.vNewVal)
ENDPROC
*-- Federal tax calc method
HIDDEN PROCEDURE calcfederalincometax
LPARAMETERS pnWage
LOCAL lnAnnualWage, lnAnnualTax, lnTax, lcMaritalStatus
lcTaxid = PADR("FWT", LEN(a_prtxfs.taxid))
lcFilingStatus = IIF(UPPER(ALLTRIM(This.MaritalStatus)) = ;
"SINGLE", "S ", "M ")
IF SEEK(lcTaxid + lcFilingStatus, "a_prtxfs") AND ;
SEEK(lcTaxid + a_prtxfs->tableid, "a_prtabl")
lnAnnualWage = This.Annualize(pnWage, UPPER(This.PayPeriod))
lnAnnualWage = lnAnnualWage - ;
(a_prtxfs.pxamt * IIF(lcFilingStatus = "S ", 1, 2))
lnAnnualTax = This.TaxTable(lcTaxid, a_prtxfs.tableid, ;
lnAnnualWage)
lnTax = ROUND(This.Deannualize(lnAnnualTax, ; UPPER(This.PayPeriod)), 2)
ELSE
lnTax = -1
ENDIF
RETURN lnTax
ENDPROC
*-- Method for state tax calculation
HIDDEN PROCEDURE calcstateincometax
LPARAMETERS pnWage
LOCAL lnAnnualWage, lnAnnualTax, lnTax
lcTaxid = PADR("SWTCA", LEN(a_prtxfs.taxid))
lcFilingStatus = IIF(UPPER(ALLTRIM(This.MaritalStatus)) = ;
"SINGLE", "S ", "M2")
IF SEEK(lcTaxid + lcFilingStatus, "a_prtxfs") AND ;
SEEK(lcTaxid + a_prtxfs->tableid, "a_prtabl")
lnAnnualWage = This.Annualize(pnWage, ;
UPPER(ALLTRIM(This.PayPeriod)))
IF lnAnnualWage > a_prtxfs.lowinc
lnAnnualWage = lnAnnualWage - (a_prtxfs.dxamt * ;
This.Exemptions)
lnAnnualWage = lnAnnualWage - a_prtxfs.stdamt
lnAnnualTax = This.TaxTable(lcTaxid, ;
a_prtxfs.tableid, lnAnnualWage)
lnAnnualTax = lnAnnualTax - (a_prtxfs.pxamt * ;
IIF(UPPER(This.MaritalStatus) = "SINGLE", 1, 2))
lnTax = ROUND(This.Deannualize(lnAnnualTax, ;
UPPER(ALLTRIM(This.PayPeriod))), 2)
ELSE
lnTax = 0.00
ENDIF
ELSE
lnTax = -1
ENDIF
RETURN lnTax
ENDPROC
*-- Method performs tax table lookups, services both fed, state calcs
HIDDEN PROCEDURE taxtable
LPARAMETERS pcTaxID, pcTableID, pnCompAmt
LOCAL lcTaxID, lcTableID, lnTax
SELECT a_prtabl
SET ORDER TO TAG taxid1 DESCENDING IN a_prtabl
lcTaxID = PADR(pcTaxID, LEN(a_prtabl.taxid))
lcTableID = PADR(pcTableID, LEN(a_prtabl.tableid))
IF SEEK(lcTaxID + lcTableID)
LOCATE FOR pnCompAmt >= a_prtabl.baseinc ;
WHILE a_prtabl.taxid + a_prtabl.tableid = ;
lcTaxID + lcTableID
IF FOUND()
*-- Calculate the tax
lnTax = a_prtabl.basetax + ;
ROUND(a_prtabl.taxrate * (pnCompAmt - a_prtabl.baseinc), 2)
ENDIF
ELSE
lnTax = 0
ENDIF
RETURN lnTax
ENDPROC
*-- Method annualizes entered pay amount, based on pay period
HIDDEN PROCEDURE annualize
LPARAMETERS pnPeriodicAmt, pcPeriod
LOCAL lnAnnualized
DO CASE
CASE pcPeriod = "WEEKLY"
lnAnnualized = pnPeriodicAmt * 52
CASE pcPeriod = "BIWEEKLY"
lnAnnualized = pnPeriodicAmt * 26
CASE pcPeriod = "SEMIMONTHLY"
lnAnnualized = pnPeriodicAmt * 24
CASE pcPeriod = "MONTHLY"
lnAnnualized = pnPeriodicAmt * 12
CASE pcPeriod = "ANNUAL"
lnAnnualized = pnPeriodicAmt
ENDCASE
RETURN lnAnnualized
ENDPROC
*-- Method converts amount based on entered pay frequency
HIDDEN PROCEDURE deannualize
LPARAMETERS pnPeriodicAmt, pcPeriod
LOCAL lnDeannualized
DO CASE
CASE pcPeriod = "WEEKLY"
lnDeannualized = ROUND(pnPeriodicAmt / 52, 2)
CASE pcPeriod = "BIWEEKLY"
lnDeannualized = ROUND(pnPeriodicAmt / 26, 2)
CASE pcPeriod = "SEMIMONTHLY"
lnDeannualized = ROUND(pnPeriodicAmt / 24, 2)
CASE pcPeriod = "MONTHLY"
lnDeannualized = ROUND(pnPeriodicAmt / 12, 2)
CASE pcPeriod = "ANNUAL"
lnDeannualized = pnPeriodicAmt
OTHERWISE
lnDeannualized = -1
ENDCASE
RETURN lnDeannualized
ENDPROC
*-- Assign method transforms data type when property assigned on ASP
PROCEDURE exemptions_assign
LPARAMETERS vNewVal
*-- Transform Exemptions to number
THIS.exemptions = VAL(m.vNewVal)
ENDPROC
ENDDEFINE
*
*-- EndDefine: vfpactivex
Figure 12 ASP Page Generation
<%@ Language=VBScript %>
<HTML>
<HEAD>
<META NAME="GENERATOR" Content="Microsoft Visual Studio 6.0">
</HEAD>
<BODY>
<%
‘ Create instance of VFP ActiveX Server
Set oVFPActiveX = Server.CreateObject("vfpactivex.vfpactivex")
DIM cPay, cNetPay, cWithheld, nWithHeld
cPay = Request.QueryString("PayAmount")
‘ Set the properties of the object
oVFPActiveX.payamount = Cstr(cPay)
oVFPActiveX.exemptions = cStr(cExempt)
oVFPActiveX.maritalstatus = cStr(cMarital)
oVFPActiveX.payperiod = cStr(cPeriod)
‘ Calculate the Net Pay
cNetPay = oVfpActiveX.netpay()
nWithHeld = cLng(cPay) - cLng(cNetpay)
cWithHeld = cStr(nWithHeld)
%>
<P style="FONT-FAMILY: sans-serif; FONT-SIZE: medium">Here's the info you requested</P>
<P>
<LABEL>
Pay Amount:</LABEL>
<%= Request.QueryString("PayAmount")%>
Period:<LABEL></LABEL> <%= Request.QueryString("cmbPeriod")%>
</P>
<P>
<LABEL>Marital
Status:</LABEL> <%= Request.QueryString("Radio1")%>
<LABEL>Exemptions:</LABEL> <%= Request.QueryString("cmbExempt")%>
</P>
<P>
<LABEL><STRONG>Amount withheld:</LABEL> $ <% = Response.Write (cWithHeld) %> </STRONG></P>
<P><STRONG>
<LABEL>Net Pay</LABEL> $
<% = Response.Write (cNetPay) %>
</STRONG></P>
</BODY>
</HTML>