QB64.org Forum

Active Forums => QB64 Discussion => Topic started by: badger on October 01, 2020, 04:59:13 pm

Title: random file puts only one record in file
Post by: badger on October 01, 2020, 04:59:13 pm

Hello

i am banging my head on the desk LOL i cant get this random file to insert more than one record

i use a lot of rem statements i am disabled and need this system to help me look at the code.

i use gosubs and goto a lot need to get this done will rewrite later after it is being use so i can use subs and
functions
with that said here is the code

Code: QB64: [Select]

1. REM ***************************************************************************
2. REM **** Program Bridal Store *************************************************
3. REM ***************************************************************************
4. REM ***************************************************************************
5. REM **** Author Philip King  **************************************************
6. REM ***************************************************************************
7. REM ***************************************************************************
8. REM ***************************************************************************
9. REM **** Includes go here *****************************************************
10. REM ***************************************************************************
11.  
12. REM ***************************************************************************
13. REM ***************************************************************************
14. REM **** Sreen statements here ************************************************
15. REM ***************************************************************************
16.  
17. $COLOR:32
18.  
19. REM ***************************************************************************
20.  
21. REM ***************************************************************************
22. REM **** defines for quick use data types *************************************
23. REM ***************************************************************************
24. _DEFINE I AS INTEGER : _DEFINE S AS STRING : _DEFINE D AS DOUBLE :
25. _DEFINE F AS _FLOAT : _DEFINE L AS LONG : _DEFINE Z AS _INTEGER64
26.  
27. REM ***************************************************************************
28.  
29. REM ***************************************************************************
30. REM **** Listing of subs and funtions *****************************************
31. REM ***************************************************************************
32.  
33. REM ***************************************************************************
34.  
35. REM ***************************************************************************
36. REM **** arrays decleared here ************************************************
37. REM ***************************************************************************
38. imenu = 4
39. DIM SHARED smenu(imenu) AS STRING
40.  
41. REM ***************************************************************************
42.  
43. REM ***************************************************************************
44. REM **** arrays set to data here **********************************************
45. REM ***************************************************************************
46.  
47. smenu(1) = "1) Edit Customer Info": smenu(2) = "3) Edit Inventory Data "
48. smenu(3) = "2) Edit Sales ": smenu(4) = "4) System Maintenance "
49.  
50. REM ***************************************************************************
51. REM **** variables declares go here *******************************************
52. REM ***************************************************************************
53. DIM SHARED sr AS STRING
54. CONST null = ""
55. REM ***************************************************************************
56.  
57. REM ***************************************************************************
58. REM **** customer info record type ********************************************
59. REM ***************************************************************************
60. TYPE customer
61.         id AS STRING * 10
62.         sfirst_name AS STRING * 25
63.         slast_name AS STRING * 25
64.         saddress AS STRING * 30
65.         scity AS STRING * 25
66.         sstate AS STRING * 2
67.         szip AS STRING * 5
68.         sphone AS STRING * 10
69.         sfiller AS STRING * 124
70. END TYPE
71. REM ***************************************************************************
72.  
73. REM ***************************************************************************
74. REM **** inventory record type ************************************************
75. REM ***************************************************************************
76. TYPE inventory
77.         ienventory AS STRING * 10
78.         sdesc AS STRING * 250
79.         sdate_bought AS STRING * 8
80.         sdate_sold AS STRING * 8
81.         fcost AS _FLOAT
82.         fretail AS _FLOAT
83.         ssize AS STRING * 2
84.         ssold AS STRING * 1
85. END TYPE
86.  
87. REM ***************************************************************************
88.  
89. REM ***************************************************************************
90. REM **** system data file record **********************************************
91. REM ***************************************************************************
92. TYPE systemdat
93.         last_rec AS STRING * 9
94.         system_data_path AS STRING * 25
95.         customer_db AS STRING * 25
96.         inventory_db AS STRING * 25
97.         invoice_db AS STRING * 25
98.         sfiller AS STRING * 148
99. END TYPE
100.  
101. REM ***************************************************************************
102. REM **** point of sale type ***************************************************
103. REM ***************************************************************************
104. TYPE spos
105.         lposid AS LONG
106. END TYPE
107. REM ***************************************************************************
108. DIM SHARED custinforec AS customer
109. DIM SHARED systemrec AS systemdat
110. lcustreclen = LEN(custinforec)
111. lsystemreclen = LEN(systemrec)
112.  
113. 'PRINT lsystemreclen
114.  
115. 'END
116. CLS
117.  
118. GOTO main
119.  
120.  
121. REM ***************************************************************************
122. REM **** main menu loop *******************************************************
123. REM ***************************************************************************
124.  
125. menuloop:
126. GOSUB systemheader
127. GOSUB printmain
128. GOSUB mainmenuchoice
129. IF sr = "" OR sr = CHR$(13) THEN GOTO menuloop
130. IF sr = "X" THEN END
131. IF sr = "1" THEN
132.         CLS
133.         GOSUB systemheader
134.         GOSUB s0
135. END IF
136. 'if sr="2" then gosub iv1
137. RETURN
138.  
139. REM ***************************************************************************
140.  
141.  
142.  
143.  
144. REM ***************************************************************************
145. REM **** Sytem Header *********************************************************
146. REM ***************************************************************************
147. systemheader:
148. CLS
149. COLOR White, Blue
150. CLS
151. LOCATE 1, 1: PRINT CHR$(201): LOCATE 1, 80: PRINT CHR$(187)
152. LOCATE 1, 2: PRINT STRING$(78, 205):
153. FOR ix = 2 TO 7
154.         LOCATE ix, 1: PRINT CHR$(186)
155.         LOCATE ix, 80: PRINT CHR$(186)
156. NEXT ix
157. LOCATE 7, 2: PRINT STRING$(78, 205)
158. LOCATE 7, 1: PRINT CHR$(200): LOCATE 7, 80: PRINT CHR$(188)
159. LOCATE 4, 30: PRINT "Main System Menu"
160. LOCATE 4, 63: PRINT "Date ": LOCATE 4, 68: PRINT DATE$
161. LOCATE 4, 4: PRINT "Virsion 1.0"
162. RETURN
163.  
164.  
165. REM ***************************************************************************
166. REM **** printes in system erros **********************************************
167. REM ***************************************************************************
168. sprintserrors:
169. CLS
170. SCREEN 0
171. IF se = "" THEN se = "INVALID RESPONSE"
172. itemp = LEN(se)
173. itemp1 = 40 - (itemp / 2)
174. BEEP
175. COLOR 16, 7
176. 'COLOR Yellow, Blue
177. LOCATE 25, itemp1: _BLINK ON: PRINT se;
178. idelay = 1.5
179. CALL Delay(1.5)
180. _BLINK OFF
181. iflag2 = 1
182.  
183. REM ***************************************************************************
184.  
185. REM *****************************************************************************
186. REM **** numeric input sub ******************************************************
187. REM *****************************************************************************
188. snumeric:
189.  
190. ftemp = VAL(sr)
191. IF ftemp < ilow OR ftemp > ihigh THEN
192.         se = "INPUT OUT OF BOUNDS"
193.         GOSUB sprintserrors
194. END IF
195.  
196.  
197. REM ***************************************************************************
198.  
199. REM ***************************************************************************
200. REM **** alpha input sub ******************************************************
201. REM ***************************************************************************
202. salphainput:
203.  
204. iflag2 = 0
205. ilength1 = LEN(sr)
206. ilength2 = LEN(saction) + 2
207.  
208. LOCATE 23, 1: PRINT saction; '               prints action menu
209. LOCATE 23, ilength2 '                        set prompt one space after action menu print
210. COLOR Yellow, Black: PRINT SPC(ib); '                changes color and prints ib spaces to screen for input lenght
211. LOCATE 23, ilength2 '                        sets curser at the begining of input space from previouse line
212. LINE INPUT sr: sr = UCASE$(sr) '             inputs data from user changes it to upper case
213.  
214. IF LEN(sr) > ib THEN
215.         se = "ENVALID INPUT LENGTH"
216.         GOSUB sprintserrors
217.         sr = ""
218.         iflag2 = 1
219.         RETURN
220. END IF
221. IF sr = "X" AND iflag1 = 1 THEN iflag1 = 0
222.  
223. IF iflag1 = 1 AND VAL(sr) < ilow AND VAL(sr) > ihigh THEN GOSUB snumeric
224.  
225. COLOR White, Blue
226.  
227. RETURN
228.  
229. REM ***************************************************************************
230. REM **** main menu to the screen **********************************************
231. REM ***************************************************************************
232. printmain:
233. COLOR White, Blue
234. FOR ix = 11 TO imenu
235.         READ smenu(ix): LOCATE ix, 20: PRINT smenu(ix)
236. NEXT ix
237.  
238. LOCATE 11, 15: PRINT smenu(1)
239. LOCATE 11, 40: PRINT smenu(2)
240. LOCATE 13, 15: PRINT smenu(3)
241. LOCATE 13, 40: PRINT smenu(4)
242. RETURN
243.  
244. REM ***************************************************************************
245.  
246. REM ***************************************************************************
247. REM **** menu prompts start here **********************************************
248. REM ***************************************************************************
249. mainmenuchoice:
250. ib = 1
251. ihigh = 99
252. ilow = 1
253. saction = "Choose Menu Option or X to Quit "
254. GOSUB salphainput
255. RETURN
256.  
257. REM ***************************************************************************
258.  
259. REM ***************************************************************************
260. REM **** clean up the prompt area *********************************************
261. REM ***************************************************************************
262.  
263. clearprompt:
264. LOCATE 23, 1: PRINT STRING$(79, 32)
265. RETURN
266.  
267. REM ***************************************************************************
268.  
269. REM ***************************************************************************
270. REM **** customer input modual ************************************************
271. REM ***************************************************************************
272. s0:
273.  
274. LOCATE 10, 1: PRINT "Customer ID           ";: PRINT custinforec.id
275. LOCATE 11, 1: PRINT "Customer First Name   ";: PRINT custinforec.sfirst_name
276. LOCATE 12, 1: PRINT "customer Last Name    ";: PRINT custinforec.slast_name
277. LOCATE 13, 1: PRINT "Customer Address      ";: PRINT custinforec.saddress
278. LOCATE 14, 1: PRINT "Customer City         ";: PRINT custinforec.scity
279. LOCATE 15, 1: PRINT "customer State        ";: PRINT custinforec.sstate
280. LOCATE 16, 1: PRINT "customer Zip          ";: PRINT custinforec.szip
281. LOCATE 17, 1: PRINT "Customer Phone Number ";
282. PRINT LEFT$(custinforec.sphone, 3) + "/"; MID$(custinforec.sphone, 4, 3) + "/"; RIGHT$(custinforec.sphone, 4)
283. RETURN
284. REM ********************************************************************
285. s1: saction = "Enter Customer ID X to Exit "
286. ib = 10
287. ilow = 1
288. ihigh = 999999999
289. iflag1 = 0
290. IF iflag2 = 1 THEN
291.         GOSUB clearprompt
292.         GOSUB salphainput
293. ELSE
294.         GOSUB clearprompt
295.         GOSUB salphainput
296. END IF
297.  
298. IF sr = "X" THEN RETURN
299. IF sr = "" OR sr = CHR$(13) GOTO s2
300. GOSUB dupidsearch
301. custinforec.id = sr: GOSUB s0: GOTO s2
302.  
303.  
304. REM ********************************************************************
305. s2:
306. saction = "Enter First Name X to Exit - To Backup "
307. ib = 25
308. ilow = 99
309. ihigh = 99
310. iflag1 = 0
311. IF iflag2 = 1 THEN
312.         GOSUB clearprompt
313.         GOSUB salphainput
314. ELSE
315.         GOSUB clearprompt
316.         GOSUB salphainput
317. END IF
318. IF sr = "-" THEN GOTO s1
319.  
320. IF sr = "X" THEN RETURN
321. IF sr = "" OR sr = CHR$(13) GOTO s3
322. custinforec.sfirst_name = sr: GOSUB s0
323.  
324. REM ***************************************************************************
325. s3:
326. saction = "Enter Last Name X to Exit - To Back up "
327. ib = 25
328. ilow = 99
329. ihigh = 99
330. iflag1 = 0
331. IF iflag2 = 1 THEN
332.         GOSUB clearprompt
333.         GOSUB salphainput
334. ELSE
335.         GOSUB clearprompt
336.         GOSUB salphainput
337. END IF
338.  
339. IF sr = "-" THEN GOTO s2
340. IF sr = "X" THEN RETURN
341. IF sr = "" OR sr = CHR$(13) GOTO s4
342.  
343. custinforec.slast_name = sr: GOSUB s0
344.  
345.  
346. REM ***************************************************************************
347. s4:
348. saction = "Enter Address X to Exit - To Back up "
349. ib = 30
350. ilow = 99
351. ihigh = 99
352. iflag1 = 0
353. IF iflag2 = 1 THEN
354.         GOSUB clearprompt
355.         GOSUB salphainput
356. ELSE
357.         GOSUB clearprompt
358.         GOSUB salphainput
359. END IF
360.  
361. IF sr = "-" THEN GOTO s3
362. IF sr = "X" THEN RETURN
363. IF sr = "" OR sr = CHR$(13) GOTO s5
364. custinforec.saddress = sr: GOSUB s0
365.  
366.  
367. REM ***************************************************************************
368. s5: saction = "Enter City Name X to Exit - To Back up "
369. ib = 25
370. ilow = 99
371. ihigh = 99
372. iflag1 = 0
373. IF iflag2 = 1 THEN
374.         GOSUB clearprompt
375.         GOSUB salphainput
376. ELSE
377.         GOSUB clearprompt
378.         GOSUB salphainput
379. END IF
380.  
381. IF sr = "-" THEN GOTO s4
382. IF sr = "X" THEN RETURN
383. IF sr = "" OR sr = CHR$(13) GOTO s6
384. custinforec.scity = sr: GOSUB s0
385.  
386. REM ***************************************************************************
387. s6:
388. saction = "Enter State X to Exit - To Back up "
389. ib = 2
390. ilow = 99
391. ihigh = 99
392. iflag1 = 0
393. IF iflag2 = 1 THEN
394.         GOSUB clearprompt
395.         GOSUB salphainput
396. ELSE
397.         GOSUB clearprompt
398.         GOSUB salphainput
399. END IF
400.  
401. IF sr = "-" THEN GOTO s5
402. IF sr = "X" THEN RETURN
403. IF sr = "" OR sr = CHR$(13) GOTO s7
404. custinforec.sstate = sr: GOSUB s0
405.  
406. REM ***************************************************************************
407. s7:
408. saction = "Enter Zip Code Name X to Exit - To Back up "
409. ib = 5
410. ilow = 99
411. ihigh = 99
412. iflag1 = 0
413. IF iflag2 = 1 THEN
414.         GOSUB clearprompt
415.         GOSUB salphainput
416. ELSE
417.         GOSUB clearprompt
418.         GOSUB salphainput
419. END IF
420.  
421. IF sr = "-" THEN GOTO s6
422. IF sr = "X" THEN RETURN
423.  
424. custinforec.szip = sr: GOSUB s0
425. REM ***************************************************************************
426. s8:
427. saction = "Enter Phone Number X to Exit - To Back up "
428. ib = 10
429. ilow = 99
430. ihigh = 99
431. iflag1 = 0
432. IF iflag2 = 1 THEN
433.         GOSUB clearprompt
434.         GOSUB salphainput
435. ELSE
436.         GOSUB clearprompt
437.         GOSUB salphainput
438. END IF
439.  
440. IF sr = "-" THEN GOTO s7
441. IF sr = "X" THEN RETURN
442. custinforec.sphone = sr: GOSUB s0
443. 'IF sr = "" OR sr = CHR$(13) goto next step
444.  
445.  
446. REM ***************************************************************************
447.  
448. REM ***************************************************************************
449. REM **** ask if you want to put data to record ********************************
450. REM ***************************************************************************
451. puttorecord:
452. saction = "Commit Data to File Y/N"
453. ib = 1
454. ilow = 99
455. ihigh = 99
456. iflag1 = 0
457. GOSUB clearprompt
458. GOSUB salphainput
459. IF sr = "-" THEN GOSUB s8
460. IF sr = "Y" THEN GOSUB insertcustrec
461. IF sr = "N" THEN RETURN
462. RETURN
463. REM ***************************************************************************
464. REM **** inventory input screen ***********************************************
465. REM ***************************************************************************
466. inv1:
467. REM ***
468. RETURN
469. REM ***************************************************************************
470. REM **** set custinforrec variables to zero or null ***************************
471. REM ***************************************************************************
472. custinforec_null:
473. custinforec.id = null
474. custinforec.sfirst_name = null
475. custinforec.slast_name = null
476. custinforec.saddress = null
477. custinforec.scity = null
478. custinforec.sstate = null
479. custinforec.szip = null
480. custinforec.sphone = null
481. RETURN
482. REM ***************************************************************************
483.  
484. REM ***************************************************************************
485. REM **** opens random files ***************************************************
486. REM ***************************************************************************
487. randomfiles:
488. OPEN "jbradal.db" FOR RANDOM AS #1 LEN = lcustreclen
489. OPEN "system.db" FOR RANDOM AS #5 LEN = lsystemreclen
490. zcustrecnum = SEEK(1)
491. 'IF zcustrecnum = 0 THEN zcustrecnum = 1 '
492. RETURN
493.  
494. REM ***************************************************************************
495.  
496. REM ***************************************************************************
497. REM **** inserts record into random file **************************************
498. REM ***************************************************************************
499. insertcustrec:
500. IF zcustrecnum = 1 OR zcustrecnum < 2 THEN
501.  
502.         PUT #1, zcustrecnum, custinforec
503. ELSE
504.         zcustrecnum = zcustrecnum + 1
505.         PUT #1, zcustrecnum, custinforec
506. END IF
507. RETURN
508. REM ***************************************************************************
509.  
510. REM ***************************************************************************
511. REM **** custinforec duplicate id search **************************************
512. REM ***************************************************************************
513. dupidsearch:
514. 'IF (LOF(1) / lcustreclen) = 0 THEN RETURN
515. 'WHILE NOT LOF(1) / lcustreclen
516. 'GET #1, zcustrecnum * lcusinforeclen, custinforec
517. 'IF custinforec.id = sr THEN BEEP
518. 'WEND
519. RETURN
520. REM ***************************************************************************
521.  
522. REM ***************************************************************************
523. REM **** main modual **********************************************************
524. REM ***************************************************************************
525. main:
526. GOSUB randomfiles '
527. 'END
528. SCREEN _NEWIMAGE(640, 400, 32)
529. COLOR LightCyan, MidnightBlue
530. iflag2 = 0
531. iflag3 = 1
532. CLS
533. 'SCREEN 12
534. _FULLSCREEN
535. IF se = "X" THEN
536.         CLOSE
537.         END
538. END IF
539. mainloop:
540. GOSUB menuloop:
541. IF saction = "X" THEN
542.         CLOSE
543.         END
544. END IF
545. IF sr = "1" THEN
546.         GOSUB custinforec_null
547.         GOSUB s1
548.         GOTO mainloop
549. END IF
550. 'if sr="C" then gosub random files thingy
551. END
552.  
553. REM **************************************************************************
554.  
555. REM **************************************************************************
556. REM **** delay loop **********************************************************
557. REM **************************************************************************
558. SUB Delay (dlay!)
559.         start! = TIMER
560.         DO WHILE start! + dlay! >= TIMER
561.                 IF start! > TIMER THEN start! = start! - 86400
562.         LOOP
563. END SUB
564. REM **************************************************************************
565.  

Title: Re: random file puts only one record in file
Post by: badger on October 01, 2020, 05:41:54 pm

Hello

I think i got it.

Badger

Title: Re: random file puts only one record in file
Post by: Pete on October 01, 2020, 08:33:18 pm

Classic case of not getting enough SLEEP.

Code: QB64: [Select]

1. IF zcustrecnum = 1 OR zcustrecnum < 2 THEN
2.  
3.         PUT #1, zcustrecnum, custinforec
4. ELSE
5.         zcustrecnum = zcustrecnum + 1
6.         PUT #1, zcustrecnum, custinforec
7. END IF

I'm glad you figured out that code wasn't allowing the zcustrecnum variable to advance past record #1.

Pete

Title: Re: random file puts only one record in file
Post by: TempodiBasic on October 02, 2020, 04:07:51 am

I think you have hit the centre of the issue

Quote

Classic case of not getting enough SLEEP.

because in this lines of code

Code: QB64: [Select]

1. IF zcustrecnum = 1 OR zcustrecnum < 2 THEN
2.  
3.         PUT #1, zcustrecnum, custinforec
4. ELSE
5.         zcustrecnum = zcustrecnum + 1
6.         PUT #1, zcustrecnum, custinforec
7. END IF

Quote

PUT #1, zcustrecnum, custinforec

is the same so the code can be srhinked in this manner

Code: QB64: [Select]

1.  IF zcustrecnum >1 THEN    zcustrecnum = zcustrecnum + 1
2. PUT #1, zcustrecnum, custinforec

  because a record number cannot be 0 or negative number, so zcustrecnum = 1  is equal to zcustrecnum <2...
and written in this other manner you can argue that as long as zcustrecnum is 1 will never become 2...

Good Shot Pete!

Title: Re: random file puts only one record in file
Post by: badger on October 02, 2020, 02:39:16 pm

hello

better yet when you open the random file you use
zcustrecnum = lof(1) /lcustreclen.. if there is not records in the file this should be 0.

when the record insertion module or sub is call all you need is

zcustrecnum = zcustrecnum +1
put #1,zcustrecnum, custinforec
it seems to work fine.

Badger

Text Only | Text with Attachments