home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
magazine
/
dbms_mag
/
9101
/
nebel1.jan
< prev
next >
Wrap
Text File
|
1990-11-13
|
7KB
|
263 lines
Listing 1.
«TS14»
1 * == Maintenance Routines Module for Program ==
2
3 PROCEDURE maitproc
4
5 * ----- set up environment -----
6 SET TALK OFF
7 SET ECHO OFF
8 SET BELL OFF
9 SET STATUS OFF
10 * ----- enter selection loop -----
11 DO WHILE .T.
12 * ---
13 CLEAR
14 mv_choice = 0
15 * ----- do menu caption -----
16 @5, 31 SAY "System Maintenance"
17 @ROW()-1, 29 TO ROW()+1, 50
18 * --
19 TEXT
20
21 1. Reindex and Pack Databases
22
23 2. Prepare Data Dictionary
24
25 3. Return to Prior Menu
26 ENDTEXT
27 * ----- call routine to offer select prompt -----
28 @ROW()+2, 27 SAY "Select by Number ===>"
29 @ROW(), COL()+2 GET mv_choice FUNCTION "Z" PICTURE "9"
30 * --
31 READ
32 * --
33 DO CASE
34 * -----
35 CASE mv_choice = 1
36 * -- call routine for reindexing and packing --
37 DO sys_rndx
38 * -----
39 CASE mv_choice = 2
40 * --- call routine for data dictionary --
41 DO sys_data
42 * -----
43 CASE mv_choice = 3
44 * ----- return to calling menu -----
45 EXIT
46 * --
47 OTHERWISE
48 * ----- invalid key -----
49 ?? CHR(7)
50 * -----
51 ENDCASE
52 * -----
53 ENDDO
54 * ----
55 RETURN
56
57 * ====== Routine to Reindex Selected Databases =====
58
59 PROCEDURE sys_rndx
60
61 CLEAR
62 CLOSE ALL
63 * ----- initialize pack switch defaulted to no -----
64 mv_pack = "N"
65 * ----- present pack option -----
66 @10, 18 SAY "Do You Want to Pack During Reindexing? ";
67 GET mv_pack PICTURE "Y"
68 * --
69 READ
70 * ----- initialize database select switches -----
71 mv_authfil = "N"
72 mv_bookfil = "N"
73 * --- call routine to allow database selection ---
74 DO sysrsele
75 * ---
76 CLEAR
77 * ---
78 @6, 21 SAY "---- Reindexing System Databases ----"
79 * -----
80 @18, 10 SAY "Note: Override Any Error Messages " + ;
81 "with 'Proceed' or 'Ignore'"
82 * ----- window to monitor reindexing operation -----
83 DEFINE WINDOW sys_rndx FROM 8, 10 TO 16, 70
84 ACTIVATE WINDOW sys_rndx
85 * -----
86 SET TALK ON
87 SET SAFETY OFF
88 * ----- call routine to do indexing -----
89 DO sysrindx
90 * -----
91 SET SAFETY ON
92 SET TALK OFF
93 * ----- release progress monitoring window -----
94 RELEASE WINDOWS sys_rndx
95 CLOSE ALL
96 * ----
97 RETURN
98
99 * === Routine to Select Databases for Reindexing ===
100
101 PROCEDURE sysrsele
102
103 CLEAR
104 * ----- do screen caption -----
105 @6, 24 SAY "Select Databases for Reindexing"
106 @ROW()+2, 22 SAY "AUTHFILE.DBF - Authors Database:"
107 @ROW(), COL()+2 GET mv_authfil PICTURE "Y"
108 @ROW()+2, 22 SAY "BOOKFILE.DBF - Books Database :"
109 @ROW(), COL()+2 GET mv_bookfil PICTURE "Y"
110 * --
111 READ
112 * --
113 RETURN
114
115 * == Routine to Index, Optionally Pack Databases ==
116
117 PROCEDURE sysrindx
118
119 IF mv_authfil = "Y"
120 * ----- turn code execution display on -----
121 SET ECHO ON
122 * ----- authors database -----
123 USE authfile
124 * --- delete all tags for ground up rebuild ---
125 DELETE TAG authlnfn OF authfile
126 DELETE TAG authcode OF authfile
127 * ----- pack if requested -----
128 IF mv_pack = "Y"
129 PACK
130 ENDIF
131 * ----- rebuild indexes -----
132 INDEX ON UPPER(authorln) + ;
133 UPPER(authorfn) TAG authlnfn
134 INDEX ON authcode TAG authcode
135 * ----- turn code execution display off -----
136 SET ECHO OFF
137 * -
138 ENDIF
139 * ---
140 IF mv_bookfil = "Y"
141 * ----- turn code execution display on -----
142 SET ECHO ON
143 * ----- books database -----
144 USE bookfile
145 * ----- delete tag for ground up rebuild -----
146 DELETE TAG authtitl OF bookfile
147 * ----- pack if requested -----
148 IF mv_pack = "Y"
149 PACK
150 ENDIF
151 * ----- rebuild index -----
152 INDEX ON STR(authcode,4,0) + ;
153 UPPER(booktitl) TAG authtitl
154 * ----- turn code execution display off -----
155 SET ECHO OFF
156 * -
157 ENDIF
158 * ----
159 RETURN
160
161 * ======= Routine to Generate Data Dictionary =======
162
163 PROCEDURE sys_data
164
165 CLEAR
166 * ----- call routine to do in progress message -----
167 @10, 20 SAY "Preparing Data Dictionary for System"
168 * -----
169 CLOSE ALL
170 SET CONSOLE OFF
171 * ----- clear the source code spooler -----
172 SET SAFETY OFF
173 USE spooler
174 ZAP
175 SET SAFETY ON
176 * ----- spool the maintenance procedures module -----
177 APPEND FROM maitproc.prg SDF
178 * ---
179 GO TOP
180 * ----- seek to start of reindexing routines -----
181 LOCATE FOR line = "PROCEDURE sysrindx"
182 * ----- enter processing loop -----
183 DO WHILE .NOT. EOF()
184 * -----
185 DO CASE
186 * ----- check if return encountered -----
187 CASE line = UPPER("return")
188 * ----- no more databases to process -----
189 EXIT
190 * --- check if start of indexing routine ---
191 CASE line = " USE"
192 * --- get name of database to variable ---
193 mv_dbf = SUBSTR(spooler->line,8,15)
194 * --- call routine to print descriptions --
195 DO prnt_dbf
196 * -----
197 ENDCASE
198 * --
199 SKIP
200 * --
201 ENDDO
202 * ---
203 CLOSE ALL
204 SET CONSOLE ON
205 * ----
206 RETURN
207
208 * Routine to Print Database and Index Descriptions ==
209
210 PROCEDURE prnt_dbf
211
212 SET PRINT ON
213 * ----- call routine to do descriptive header -----
214 DO headdata
215 * ----- list structure of database to printer -----
216 SELECT 2
217 USE &mv_dbf
218 SET MARGIN TO 10
219 LIST STRUCTURE TO PRINT
220 SET MARGIN TO 0
221 USE
222 SELECT spooler
223 * ----- seek to first indexing command line -----
224 DO WHILE SUBSTR(spooler->line,4,5) # "INDEX"
225 * ---
226 SKIP
227 * ---
228 ENDDO
229 * --- enter loop to print all indexing commands ---
230 DO WHILE SUBSTR(spooler->line,4,1) # "*"
231 * ----- print index description line -----
232 ? SPACE(10) + TRIM(spooler->line)
233 * ---
234 SKIP
235 * --
236 ENDDO
237 * ---
238 SET PRINT OFF
239 EJECT
240 * --
241 RETURN
~242
~~~~243 * == Routine for Header for Data Directory Listings==
244
245 PROCEDURE headdata
246
247 * -----
248 ?
249 ?
250 ?
251 ? SPACE(20) + "Structure and Indexes for: " + ;
252 TRIM(UPPER(mv_dbf)) + ".DBF"
253 ?
254 ? SPACE(10) + REPLICATE("-",65)
255 ?
256 * ----
257 RETURN
258
259 * =============== End of Listing 1 =================
~