home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / windows / sqllink.zip / SSLDEMO.PRG < prev    next >
Text File  |  1990-08-09  |  10KB  |  582 lines
  1. * SQL SERVER SQL Softlink Demo
  2. * (c) 1990 SQLSoft
  3. * ....
  4.  
  5. SET PROCEDURE TO ssldemo
  6.  
  7. CLEAR
  8.  
  9. SET CONFIRM ON
  10. SET DELETED ON
  11. SET MESSAGE LINE TO 0
  12. SET EVENTMSK TO 31
  13.  
  14. SET READ VIDEO TO 159
  15. SET GET VIDEO TO 185
  16. SET EXIT VIDEO TO 143
  17. SET ERASE VIDEO TO 240
  18. xset_say=240
  19.  
  20. SET BOX OFF
  21.  
  22. xT="SQL Softlink Demo (c) 1990 SQLSoft"
  23. q=CHR(34)
  24. e="Field cannot contain quotes."
  25.  
  26. SET WINDOW TITLE TO xT
  27.  
  28. SET WINDOW TYPE TO 1
  29.  
  30. xSay_vid=249
  31.  
  32. SET SAY VIDEO TO xSay_vid
  33.  
  34. CLEAR
  35.  
  36. xconnect=.F.
  37.  
  38. IF .NOT. connect()
  39.   QUIT
  40. ENDIF
  41.  
  42. DO WHILE .T.
  43.   DO rows_lim
  44.  
  45.   CLOSE DATABASES
  46.   
  47.   xmenu="Authors Table;"
  48.   CREATE POPUP MENU "Edit" xmenu AT 1,1
  49.  
  50.   xmenu="Demo Reports;"
  51.   CREATE POPUP MENU "Reports" xmenu AT 1,1
  52.  
  53.   xmenu="Edit SQL Server Parameters;"
  54.   xmenu=xmenu+"Work Station Memory;"
  55.   xmenu=xmenu+"Server Database Memory;;"
  56.   xmenu=xmenu+"Dump Pubs Database;"
  57.   xmenu=xmenu+"Load Pubs Database;"
  58.   xmenu=xmenu+"Dump Master Database;"
  59.   CREATE POPUP MENU "Utilities" xmenu AT 1,1
  60.  
  61.   xmenu="Quit Demo;"
  62.   CREATE POPUP MENU "Exit" xmenu AT 1,1
  63.  
  64.   xmenu="Access System Help;"
  65.   CREATE POPUP MENU "Help" xmenu AT 1,1
  66.  
  67.   CREATE PULLDOWN MENU "menu" FROM "Edit","Reports","Utilities","Exit","Help"
  68.   
  69.   SET MENU TO "menu"
  70.   SET BOX OFF
  71.   DO scrn
  72.   
  73.   WAIT ""
  74.   CLOSE MENU "menu"
  75.   
  76.   CLEAR
  77.   
  78.   option=EVENT()
  79.  
  80.   DO CASE
  81.     CASE option=2
  82.       menu_h=HMENU()
  83.       menu_v=VMENU()
  84.  
  85.       DO CASE
  86.         CASE menu_h=1
  87.           DO CASE
  88.             CASE menu_v=1
  89.               CHAIN vauth
  90.           ENDCASE
  91.         CASE menu_h=2
  92.           CONFIRM("Use R"+CHR(38)+"R Report Writer.  Contact SQLSoft for details.")
  93.         CASE menu_h=3
  94.           CHAIN util
  95.         CASE menu_h=4
  96.           IF CONFIRM("Quit SQL Softlink Demo?")
  97.             IF .NOT. xconnect
  98.               QUIT
  99.             ENDIF
  100.             disconnect()
  101.             QUIT
  102.           ENDIF
  103.         CASE menu_h=5
  104.           DO help WITH "main.hlp"
  105.       ENDCASE
  106.     CASE option=6
  107.       EXIT
  108.   ENDCASE
  109. ENDDO
  110. QUIT
  111. *----------------------------------------
  112. FUNCTION sh_but
  113. PARAMETERS xstr,xrow,xoffset
  114.  
  115. DECLARE xbut[10]
  116.  
  117. j=0
  118.  
  119. tlen=0
  120.  
  121. DO WHILE .T.
  122.   j=j+1
  123.   xbut[j]=SUBSTR(xstr,1,AT(";",xstr)-1)
  124.  
  125.   xlen=LEN(TRIM(xbut[j]))
  126.   tlen=tlen+xlen
  127.  
  128.   xstr=SUBSTR(xstr,AT(";",xstr)+1,100)
  129.  
  130.   xlen=LEN(TRIM(xstr))
  131.   
  132.   IF xlen=0
  133.     EXIT
  134.   ENDIF
  135.   
  136. ENDDO
  137.  
  138. ylen=tlen+(j-1)*3
  139.  
  140. ycol=39-ROUND(ylen/2,0)
  141.  
  142. FOR i=1 TO j
  143.   CREATE BUTTON xbut[i] AT xrow,ycol+xoffset
  144.  
  145.   ycol=ycol+LEN(TRIM(xbut[i]))+3
  146. NEXT i
  147.  
  148. RETURN(.T.)
  149. *----------------------------------------
  150. PROCEDURE say_msg1
  151. PARAMETERS xstr
  152.  
  153. xlen=LEN(TRIM(xstr))
  154. l=ROUND(39-xlen/2,0)
  155. r=l+xlen
  156.  
  157. CREATE WINDOW "Message" FROM  10,l TO 13,r
  158.  
  159. @ 1,0 SAY xstr
  160.  
  161. RETURN
  162. *----------------------------------------
  163. PROCEDURE say_msg2
  164.  
  165. CLOSE WINDOW "Message"
  166.  
  167. RETURN
  168. *----------------------------------------
  169. FUNCTION pwait
  170. PARAMETERS xstr
  171.  
  172. @ 0,0 say xstr
  173.  
  174. value=0
  175. DO WHILE value=0
  176.   value=INKEY()
  177. ENDDO
  178.  
  179. IF value=27
  180.   QUIT
  181. ENDIF
  182.  
  183. RETURN(.T.)
  184. *----------------------------------------
  185. PROCEDURE show_mem
  186.  
  187. WARNING("Message","Available Memory - "+ALLTRIM(STR(MEMORY())),1)
  188.  
  189. RETURN
  190. *----------------------------------------
  191. PROCEDURE scrn
  192.  
  193. SET SAY VIDEO TO xSay_vid
  194. CLEAR
  195. LOAD BITMAP ssldemo.bmp INTO xpict
  196. @ 2,7 SAY xpict
  197. RELEASE xpict
  198. SET SAY VIDEO TO xset_say
  199.  
  200. RETURN
  201. *----------------------------------------
  202. PROCEDURE help
  203. PARAMETERS xfile
  204.  
  205. xhand=FOPEN(xfile,1)
  206.  
  207. IF xhand=-1
  208.   WARNING("","No help available",1)
  209.   RETURN
  210. ELSE
  211.   SELECT 1
  212.   USE Help
  213.  
  214.   ZAP
  215.  
  216.   xmax=90
  217.   xline=SPACE(xmax)
  218.  
  219.   xcnt=0
  220.   DO WHILE FGETS(@xline,xmax,xhand)>0
  221.     IF LEN(TRIM(xline))<>0
  222.       APPEND BLANK
  223.       REPLACE Hline WITH xline
  224.       xcnt=xcnt+1
  225.     ENDIF
  226.   ENDDO
  227.  
  228.   xscrpg=1000*10/xcnt
  229.   xscrln=1000/xcnt
  230.   
  231.   SET WINDOW TYPE TO 97
  232.  
  233.   xtop=1
  234.  
  235.   GOTO TOP
  236.  
  237.   CREATE WINDOW "Help" FROM 5,0 TO 17,80
  238.     DO WHILE .T.
  239.       CLEAR
  240.  
  241.       IF xtop<=1
  242.         xtop=1
  243.       ENDIF
  244.       IF xtop>xcnt
  245.         xtop=xcnt
  246.       ENDIF
  247.  
  248.       IF (xtop+9)>xcnt
  249.         xend=xcnt
  250.       ELSE
  251.         xend=xtop+9
  252.       ENDIF
  253.  
  254.       IF xend>xcnt
  255.         xend=xcnt
  256.       ENDIF
  257.  
  258.       xline=2
  259.       i=xtop
  260.  
  261.       GOTO xtop
  262.       IF xtop=xcnt
  263.         SETSCROLL(1,1000)
  264.       ELSE
  265.         SETSCROLL(1,(xtop-1)*1000/xcnt+1)
  266.       ENDIF
  267.  
  268.       DO WHILE i<=xend
  269.         @ xline,0 SAY Hline
  270.         xline=xline+1
  271.         i=i+1
  272.         SKIP
  273.       ENDDO
  274.  
  275.       WAIT ""
  276.  
  277.       IF EVENT()=5
  278.         CLOSE WINDOW "Help"
  279.         RETURN
  280.       ENDIF
  281.  
  282.       IF EVENT()=7
  283.         DO CASE
  284.           CASE VMENU()=1
  285.             xtop=xtop-1
  286.           CASE VMENU()=2
  287.             xtop=xtop+1
  288.           CASE VMENU()=3
  289.             xtop=xtop-10
  290.           CASE VMENU()=4
  291.             xtop=xtop+10
  292.           CASE VMENU()=5
  293.             xtop=ROUND(xcnt*MROW()/1000,0)
  294.         ENDCASE
  295.       ENDIF
  296.     ENDDO
  297.   CLOSE WINDOW "Help"
  298.  
  299.   SET WINDOW TYPE TO 1
  300. ENDIF
  301. RETURN
  302. *----------------------------------------
  303. FUNCTION connect
  304.  
  305. IF .NOT. CONFIRM("Connect to SQL Server?")
  306.   RETURN(.F.)
  307. ENDIF
  308.  
  309. TALK TO "SQL_SoftLink" ABOUT "SQL"
  310. IF .NOT. CONTACT()
  311.   WARNING("","SQLSoft SQL SoftLink not loaded.",1)
  312.   RETURN(.F.)
  313. ENDIF
  314.  
  315. CREATE WINDOW "Connect to SQL Server" FROM 10,28 TO 17,52
  316.  
  317. error=.T.
  318.  
  319. SELECT 1
  320. USE Sysparms
  321. xU=U
  322. xP=P
  323. xS=S
  324. xD=D
  325. xMax_rows=Max_rows
  326. USE
  327.  
  328. TEXT
  329.   User Name: ----------
  330.    Password:
  331. Server Name:
  332.    Database:
  333. ENDTEXT
  334.  
  335. @  1,13 GET xU PICTURE REPLICATE("!",10)
  336. @  2,13 GET xP PICTURE REPLICATE("!",10)
  337. @  3,13 GET xS PICTURE REPLICATE("!",10)
  338. @  4,13 GET xD PICTURE REPLICATE("!",10)
  339.  
  340. CREATE BUTTON "OK" AT 6,6
  341. CREATE BUTTON "Cancel" AT 6,11
  342.  
  343. READ
  344.  
  345. IF EVENT()=6
  346.   IF BUTTON()="Cancel"
  347.     CLOSE WINDOW "Connect to SQL Server"
  348.     QUIT
  349.   ENDIF
  350. ENDIF
  351.  
  352. IF .NOT. ( SENDDATA("Server",TRIM(xS)) .AND.;
  353.   SENDDATA("UserName",TRIM(xU)) .AND.;
  354.   SENDDATA("Pswd",TRIM(xP)) .AND.;
  355.   SENDDATA("Dbase",TRIM(xD)) )
  356.  
  357.   WARNING("","Problem with log in parameters.",1)
  358. ELSE
  359.   x=REQUEST("Connect")
  360.   IF x="F"
  361.     WARNING("","Cannot connect to SQL Server.",1)
  362.     xconnect=.F.
  363.     RETURN(.F.)
  364.   ELSE
  365.     error1=.T.
  366.     IF SENDDATA("Xstr1","16")
  367.       IF SENDDATA("Xstr2",ALLTRIM(STR(xMax_rows,6,0)))
  368.         IF REQUEST("SetOpt")="T"
  369.           xconnect=.T.
  370.           error=.F.
  371.           error1=.F.
  372.         ENDIF
  373.       ENDIF
  374.     ENDIF
  375.   ENDIF
  376. ENDIF
  377.  
  378. CLOSE WINDOW "Connect to SQL Server"
  379.  
  380. IF error1
  381.   WARNING("","Problem with SetOpt",1)
  382.   RETURN(.F.)
  383. ENDIF 
  384.  
  385. IF error
  386.   RETURN(.F.)
  387. ELSE
  388.   WARNING("Message","Successful connection to SQL Server.",3)
  389.   RETURN(.T.)
  390. ENDIF
  391. *----------------------------------------
  392. FUNCTION disconnect
  393.  
  394. REQUEST("Dbexit")
  395. TERMINATE
  396.   
  397. WARNING("Message","Disconnected from SQL Server",3)
  398.  
  399. xconnect=.T.
  400. RETURN(.T.)
  401. *----------------------------------------
  402. FUNCTION fsenddata
  403. PARAMETERS str1,str2
  404.  
  405. IF .NOT. SENDDATA(str1,str2)
  406.   disp_msgs()
  407.   WARNING("","SENDDATA problem - "+str1,1)
  408.   RETURN(.F.)
  409. ENDIF
  410.  
  411. RETURN(.T.)
  412. *----------------------------------------
  413. FUNCTION fdbcmd
  414. PARAMETERS str1
  415.  
  416. IF SENDDATA("Xstr1",str1)
  417.   IF REQUEST("Dbcmd")="T"
  418.     RETURN(.T.)
  419.   ELSE
  420.     WARNING("","Dbcmd problem - "+str1,1)
  421.     disp_msgs()
  422.     RETURN(.F.)
  423.   ENDIF
  424. ELSE
  425.   WARNING("","SENDDATA problem - "+str1,1)
  426.   disp_msgs()
  427.   RETURN(.F.)
  428. ENDIF
  429.  
  430. RETURN(.T.)
  431. *----------------------------------------
  432. FUNCTION fresults
  433. PARAMETERS str1
  434.  
  435. DO WHILE REQUEST("Dbresults")<>"2"
  436. ENDDO  
  437.  
  438. IF REQUEST("Dbsqlexec")="T"
  439.   xreq=REQUEST("Dbresults")
  440.   
  441.   IF xreq="1" .OR. xreq="2"
  442.     RETURN(.T.)
  443.   ENDIF
  444.   
  445.   WARNING("",str1+" -  Dbresults error",1)
  446.   disp_msgs()
  447.   
  448.   RETURN(.F.)
  449. ELSE
  450.   WARNING("",str1+" -  Dbsqlexec error",1)
  451.   disp_msgs()
  452.   RETURN(.F.)
  453. ENDIF
  454.  
  455. RETURN(.T.)
  456. *----------------------------------------
  457. FUNCTION all_res
  458. PARAMETERS str1
  459.  
  460. IF REQUEST("Dbsqlexec")="T"
  461.   DO WHILE .T.
  462.     xreq=REQUEST("Dbresults")
  463.     DO CASE
  464.       CASE xreq="0"
  465.         WARNING("",str1+" -  Dbresults error",1)
  466.         disp_msgs()
  467.         RETURN(.F.)
  468.       CASE xreq="1"
  469.         LOOP
  470.       CASE xreq="2"
  471.         RETURN(.T.)
  472.       OTHERWISE
  473.         WARNING("",str1+" -  Dbresults error",1)
  474.         disp_msgs()
  475.         RETURN(.F.)
  476.     ENDCASE
  477.   ENDDO
  478. ELSE
  479.   WARNING("",str1+" -  Dbsqlexec error",1)
  480.   disp_msgs()
  481.   RETURN(.F.)
  482. ENDIF
  483.  
  484. RETURN(.T.)
  485. *----------------------------------------
  486. FUNCTION disp_msgs
  487.  
  488. xmsg=REQUEST("Msgmsg")+SPACE(250)
  489. xdbl=REQUEST("Dblmsg")+SPACE(250)
  490. xsys=REQUEST("Sysmsg")+SPACE(250)
  491.  
  492. CREATE WINDOW "SQL Server Messages" FROM 2,1 TO 22,78
  493.  
  494. @ 1,0 SAY "SQL Server Message -"
  495. @ 2,0 SAY SUBSTR(xmsg,1,76)
  496. @ 3,0 SAY SUBSTR(xmsg,77,76)
  497. @ 4,0 SAY SUBSTR(xmsg,153,76)
  498.  
  499. @ 6,0 SAY "DB Lib Message -"
  500. @ 7,0 SAY SUBSTR(xdbl,1,76)
  501. @ 8,0 SAY SUBSTR(xdbl,77,76)
  502. @ 9,0 SAY SUBSTR(xdbl,153,76)
  503.  
  504. @ 11,0 SAY "System Message -"
  505. @ 12,0 SAY SUBSTR(xsys,1,76)
  506. @ 13,0 SAY SUBSTR(xsys,77,76)
  507. @ 14,0 SAY SUBSTR(xsys,153,76)
  508.  
  509. WAIT
  510.  
  511. CLOSE WINDOW "SQL Server Messages"
  512.  
  513. RETURN(.T.)
  514. *--------------------------------------
  515. FUNCTION parse_row
  516. PARAMETERS xcnt
  517.  
  518. xlen=LEN(xline)
  519.  
  520. i=1
  521. DO WHILE i<=xcnt
  522.   fld[i]=""
  523.   i=i+1
  524. ENDDO
  525.  
  526. ifld=1
  527. i=1
  528. DO WHILE i<=xlen
  529.   xchar=SUBSTR(xline,i,1)
  530.   IF xchar=CHR(9)
  531.     ifld=ifld+1
  532.   ELSE
  533.     fld[ifld]=fld[ifld]+xchar
  534.   ENDIF
  535.   i=i+1
  536. ENDDO
  537.   
  538. RETURN(ifld-1)
  539. *--------------------------------------
  540. FUNCTION do_cmd
  541. PARAMETERS xstr
  542.  
  543. IF .NOT. SENDDATA("Xstr1",xstr)
  544.   WARNING("","Problem with SENDDATA",1)
  545.   disp_msgs()
  546.   error=.T.
  547.   RETURN(.F.)
  548. ENDIF
  549.  
  550. IF REQUEST("Fastins")="T"
  551.   RETURN(.T.)
  552. ELSE
  553.   WARNING("","Problem with Fastins",1)
  554.   disp_msgs()
  555.   error=.T.
  556.   RETURN(.F.)
  557. ENDIF
  558.  
  559. RETURN(.F.)
  560. *--------------------------------------
  561. PROCEDURE rows_all
  562.  
  563. IF SENDDATA("Xstr1","16")
  564.   IF SENDDATA("Xstr2","0")
  565.     REQUEST("SetOpt")="T"
  566.   ENDIF
  567. ENDIF
  568.  
  569. RETURN
  570. *--------------------------------------
  571. PROCEDURE rows_lim
  572.  
  573. USE Sysparms
  574. IF SENDDATA("Xstr1","16")
  575.   IF SENDDATA("Xstr2",STR(Max_rows,3,0))
  576.     REQUEST("SetOpt")="T"
  577.   ENDIF
  578. ENDIF
  579. USE
  580.  
  581. RETURN
  582.