home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
windows
/
sqllink.zip
/
VAUTH.PRG
< prev
Wrap
Text File
|
1990-08-09
|
9KB
|
326 lines
SET PROCEDURE TO vauth
SET PROCEDURE TO ssldemo
DECLARE fld[8]
xBatch=.F.
USE Auth
ZAP
INDEX ON UPPER(au_lname+au_fname) TO Co1
DO WHILE .T.
IF xBatch
xau_lname=yau_lname
xau_fname=yau_fname
ELSE
CREATE WINDOW "Input Author" FROM 10,25 TO 14,55
xAu_lname=SPACE(40)
xAu_fname=SPACE(20)
@ 1, 0 SAY " Enter Last Name -" GET xAu_lname
@ 2, 0 SAY "Enter First Name -" GET xAu_fname
READ
CLOSE WINDOW "Input Author"
ENDIF
DO say_msg1 WITH "Getting primary key from SQL Server..."
xs="select au_id,au_lname,au_fname from authors where "
xs=xs+"Substring(au_lname+space(40),1,40)+"
xs=xs+"Substring(au_fname+space(20),1,20) >= "+q+xAu_lname+xAu_fname+q
xs=xs+" order by au_lname,au_fname"
IF .NOT. fdbcmd(xs)
DO say_msg2
RETURN
ENDIF
IF fresults("")
ZAP
DO WHILE .T.
xline=REQUEST("Row")
IF xline=CHR(26)
EXIT
ENDIF
parse_row(3)
APPEND BLANK
REPLACE Au_id WITH fld[1]
REPLACE Au_lname WITH fld[2]
REPLACE Au_fname WITH fld[3]
ENDDO
ELSE
DO say_msg2
RETURN
ENDIF
IF EOF()
WARNING("","No Author records available.",1)
DO say_msg2
RETURN
ELSE
yau_lname=au_lname
yau_fname=au_fname
ENDIF
GOTO TOP
DO say_msg2
xwin="Edit Authors"
DO WHILE .T.
CLEAR
BROWSE FIELDS Au_id,Au_lname,Au_fname WIDTH 30 ;
TITLE "Select Author;ID #;Last Name;First Name"
CREATE WINDOW xwin FROM 5,0 TO 18,79
DO sh_text
sh_but("Next Rec;Prev Rec;Browse;Next Batch;New Batch;Delete;Add;Exit;",11,0)
DO WHILE .T.
xAu_lname=Au_lname
xAu_fname=Au_fname
xAu_id=Au_id
xs="select au_id,au_lname,au_fname,phone,address,city,state,zip "
xs=xs+"from authors where au_id="+q+xAu_id+q
IF .NOT. fdbcmd(xs)
CLOSE WINDOW xwin
RETURN
ENDIF
IF fresults("")
DO WHILE .T.
xline=REQUEST("Row")
IF xline=CHR(26)
EXIT
ENDIF
parse_row(8)
ENDDO
ELSE
CLOSE WINDOW xwin
RETURN
ENDIF
@ 1,24 CLEAR TO 3,79
@ 1,24 SAY TRANSFORM(fld[1],"99999999999")
fld[2]=SUBSTR(fld[2]+SPACE(40),1,40)
@ 2,24 GET fld[2] VALID .NOT. CHR(34) $ fld[2] ERROR e
fld[3]=SUBSTR(fld[3]+SPACE(20),1,20)
@ 3,24 GET fld[3] VALID .NOT. CHR(34) $ fld[3] ERROR e
fld[4]=SUBSTR(fld[4]+SPACE(12),1,12)
@ 5,24 GET fld[4] VALID .NOT. CHR(34) $ fld[4] ERROR e
fld[5]=SUBSTR(fld[5]+SPACE(40),1,40)
@ 6,24 GET fld[5] VALID .NOT. CHR(34) $ fld[5] ERROR e
fld[6]=SUBSTR(fld[6]+SPACE(20),1,20)
@ 7,24 GET fld[6] VALID .NOT. CHR(34) $ fld[6] ERROR e
fld[7]=SUBSTR(fld[7]+SPACE(2),1,2)
@ 8,24 GET fld[7] VALID .NOT. CHR(34) $ fld[7] ERROR e
fld[8]=SUBSTR(fld[8]+SPACE(5),1,5)
@ 9,24 GET fld[8] VALID .NOT. CHR(34) $ fld[8] ERROR e
READ
CLEAR GETS
IF UPDATED()
error=.F.
fdbcmd("update authors ")
fdbcmd("set Au_lname="+ALLTRIM(STR(fld[1]))+",")
fdbcmd("set Au_id="+q+fld[1]))+q+",")
fdbcmd(" Au_lname="+q+fld[2]+q+",")
fdbcmd(" Au_fname="+q+fld[3]+q+",")
fdbcmd(" Phone="+q+fld[4]+q+",")
fdbcmd(" Address="+q+fld[5]+q+",")
fdbcmd(" City="+q+fld[6]+q+",")
fdbcmd(" State="+q+fld[7]+q+",")
fdbcmd(" Zip="+q+fld[8]+q+" ")
fdbcmd(" where Au_id="+q+xAu_id+q)
IF .NOT. error
IF REQUEST("Dbsqlexec")="T"
REPLACE Au_lname WITH fld[2]
REPLACE Au_fname WITH fld[3]
REPLACE Phone WITH fld[4]
REPLACE Address WITH fld[5]
REPLACE City WITH fld[6]
REPLACE State WITH fld[7]
REPLACE Zip WITH fld[8]
ELSE
WARNING("","Cannot update with new data.",1)
disp_msgs()
SELECT WINDOW xwin
ENDIF
ENDIF
ENDIF
IF EVENT()=6
xbutton=BUTTON()
DO CASE
CASE xbutton="Next Rec"
SKIP
IF EOF()
DO say_msg1 WITH "Last record in batch..."
INKEY(2)
DO say_msg2
SELECT WINDOW xwin
SKIP -1
ENDIF
CASE xbutton="Prev Rec"
SKIP -1
IF BOF()
DO say_msg1 WITH "First record in batch..."
INKEY(2)
DO say_msg2
SELECT WINDOW xwin
SKIP
ENDIF
CASE xbutton="Browse"
CLEAR
EXIT
CASE xbutton="New Batch"
xBatch=.F.
CLEAR
EXIT
CASE xbutton="Next Batch"
xBatch=.T.
CLEAR
EXIT
CASE xbutton="Delete"
IF CONFIRM("Delete current record?")
REQUEST("MsgMsg")
fdbcmd("delete from authors ")
fdbcmd("where Au_id="+q+xAu_id+q)
IF fresults("")
xmsg=REQUEST("MsgMsg")
IF LEN(TRIM(xmsg))>0
WARNING("",TRIM(xmsg),1)
ELSE
xrec=RECNO()
GOTO TOP
xtop=RECNO()
GOTO BOTTOM
xbot=RECNO()
GOTO xrec
DELETE
IF xtop=xbot
xbutton="New Batch"
xBatch=.F.
EXIT
ELSE
SKIP -1
IF BOF()
SKIP
ENDIF
ENDIF
LOOP
ENDIF
ENDIF
ENDIF
WARNING("","Record not deleted",1)
CASE xbutton="Add"
IF CONFIRM("Add another Author?")
xAu_id=SPACE(11)
xAu_lname=SPACE(40)
xAu_fname=SPACE(20)
xPhone=SPACE(12)
xAddress=SPACE(40)
xCity=SPACE(20)
xState=SPACE(2)
xZip="99999"
CLEAR
DO sh_text
@ 1,24 CLEAR TO 3,79
@ 1,24 GET xAu_id PICTURE "999-99-9999"
@ 2,24 GET xAu_lname VALID .NOT. CHR(34) $ xAu_lname ERROR e
@ 3,24 GET xAu_fname VALID .NOT. CHR(34) $ xAu_fname ERROR e
@ 5,24 GET xPhone VALID .NOT. CHR(34) $ xPhone ERROR e
@ 6,24 GET xAddress VALID .NOT. CHR(34) $ xAddress ERROR e
@ 7,24 GET xCity VALID .NOT. CHR(34) $ xCity ERROR e
@ 8,24 GET xState VALID .NOT. CHR(34) $ xState ERROR e
@ 9,24 GET xZip VALID .NOT. CHR(34) $ xZip ERROR e PICTURE "99999"
READ
error=.F.
fdbcmd("insert authors values")
fdbcmd(" ("+q+xAu_id+q+","+q+xAu_lname+q+","+q+xAu_fname+q+",")
fdbcmd(" "+q+xPhone+q+","+q+xAddress+q+","+q+xCity+q+",")
fdbcmd(" "+q+xState+q+","+q+xZip+q+",1)")
IF .NOT. error
IF REQUEST("Dbsqlexec")="T"
APPEND BLANK
REPLACE Au_id WITH xAu_id
REPLACE Au_lname WITH xAu_lname
REPLACE Au_fname WITH xAu_fname
REPLACE Phone WITH xPhone
REPLACE Address WITH xAddress
REPLACE City WITH xCity
REPLACE State WITH xState
REPLACE Zip WITH xZip
ELSE
WARNING("","Cannot add record.",1)
disp_msgs()
SELECT WINDOW xwin
ENDIF
ENDIF
sh_but("Next Rec;Prev Rec;Browse;Next Batch;New Batch;Delete;Add;Exit;",11,0)
ENDIF
CASE xbutton="Exit"
CLOSE WINDOW xwin
RETURN
ENDCASE
ENDIF
ENDDO
CLOSE WINDOW xwin
IF xbutton="New Batch" .OR. xbutton="Next Batch" .OR. xbutton="Exit"
EXIT
ENDIF
ENDDO
IF xbutton="Exit"
EXIT
ENDIF
ENDDO
RETURN
*----------------------------------------
PROCEDURE sh_text
CLEAR
*******************************************************************************
TEXT
Author ID: -----------
Author Last Name: ----------------------------------------
Author First Name: --------------------
Phone: ------------
Address: ----------------------------------------
City: --------------------
State: --
Zip: -----
ENDTEXT
RETURN