QB64.org Forum

Active Forums => QB64 Discussion => Topic started by: Pete on January 22, 2021, 12:51:53 pm

Title: Playing around with a SAVE/OPEN routine...
Post by: Pete on January 22, 2021, 12:51:53 pm

I mostly hard coded names for files, and I know I did something like this decades ago, but for now, I'm just writing new code. What I intend to do is create a method to open and save files from a menu selection, which is easy, but also from user typed input. The code below is my attempt at idiot proofing the later. It roots out illegal file characters, separates drive, directory, and file name, adds .txt to a text file, etc. At present, it allows something other than a .txt extension. Notepad would take a .bas extension, and make it .bas.txt, if the .txt default fils type selection was left in place. I don't know if I want to copy that format, or not.

Oh, don't worry, the code will not write anything to your drive(s). It's just a mock routine to get the construct down. I hope that's the proper use of the term, construct, as in how the program flows through the process coded.

Code: QB64: [Select]

1. operation$ = "save"
2.  
3. PRINT "/ \ : * ? < > | " + CHR$(34): PRINT
4.  
5. LINE INPUT a$
6.  
7. doctype$ = "text"
8.  
9. drive$ = "": dir$ = ""
10. illegal_file_symbols$ = "/\:*?<>|" + CHR$(34)
11. ifs$ = illegal_file_symbols$ ' I just used this to shorten the name until I do a universal replacement.
12.  
13. ' Determine if there is a drive and/or directory in the input.
14. IF MID$(a$, 2, 2) = ":\" THEN
15.     IF LEFT$(UCASE$(a$), 1) >= "A" AND LEFT$(UCASE$(a$), 1) <= "Z" THEN
16.         drive$ = MID$(a$, 1, 3)
17.         a$ = MID$(a$, 4)
18.     ELSE
19.         BEEP
20.     END IF
21. END IF
22.  
23. IF INSTR(a$, "\") THEN
24.     dir$ = MID$(a$, 1, _INSTRREV(a$, "\"))
25.     a$ = MID$(a$, LEN(dir$) + 1)
26. END IF
27.  
28. DO
29.     IF LEN(drive$) THEN
30.         IF _DIREXISTS(drive$) THEN
31.         ELSE
32.             flag% = 1
33.         END IF
34.     END IF
35.     IF flag% THEN EXIT DO
36.  
37.     IF LEN(dir$) THEN
38.         IF _DIREXISTS(drive$ + dir$) THEN
39.         ELSE
40.             flag% = 2
41.         END IF
42.     END IF
43.     IF flag% THEN EXIT DO
44.  
45.     FOR i% = 1 TO LEN(ifs$)
46.         IF INSTR(a$, MID$(ifs$, i%, 1)) THEN flag% = 3: EXIT FOR
47.     NEXT
48.  
49.     IF _FILEEXISTS(a$) THEN
50.         IF operation$ = "save" THEN
51.             flag% = 4
52.         END IF
53.     END IF
54.  
55.     EXIT DO
56. LOOP
57.  
58. IF drive$ = "" THEN drive$ = MID$(_CWD$, 1, 3)
59. IF dir$ = "" THEN dir$ = MID$(_CWD$, 4) ' Note: no traling backslash.
60.  
61. PRINT: PRINT "Drive = "; drive$; " Dir = "; dir$; " File = "; a$: PRINT
62.  
63. SELECT CASE flag%
64.     CASE 0
65.         IF doctype$ = "text" THEN ' Check for text extension.
66.             IF INSTR(a$, ".") = 0 THEN a$ = a$ + ".txt"
67.         END IF
68.  
69.         ' Okay to save.
70.         PRINT "Saving file as: "; a$: PRINT
71.     CASE 1
72.         PRINT "Drive not found.": PRINT
73.     CASE 2
74.         PRINT "Directory not found.": PRINT
75.     CASE 3
76.         ' Illegal symbols in file name.
77.         PRINT "Illegal file name."
78.     CASE 4
79.         IF operation$ = "save" THEN
80.             PRINT "File Already Exists. Overwrite?": PRINT
81.         END IF
82. END SELECT
83.  
84. RUN
85.  

Pete

Title: Re: Playing around with a SAVE/OPEN routine...
Post by: FellippeHeitor on January 22, 2021, 01:04:39 pm

Nice to see _INSTRREV put to good use.

Title: Re: Playing around with a SAVE/OPEN routine...
Post by: Pete on January 22, 2021, 01:17:58 pm

Yeah, _INSTRREV. I love that one. I had to make my own function for it, prior to its existence, so thanks for that.

I hope I'm not missing anything on this files routine. I hate to add stuff that can mess up files if there is some "bug" or mistake in the code. My present concern is TheBOB is trying out my WP at the QBasic Forum, and I want to make sure his stuff is protected when it reaches this level. I made a promise to Mac, long before he handed the forum over to me, that no matter how much kidding around I did or arguments I got into, never, never "piss off TheBOB!" So right now, my WP he is testing out just loads files, but doesn't save them. I told Bob about my concerns, and he shared with me a time when Mac tried one of his routines, and it did wipe out one of Mac's files, which he had no back up for. I don't know about the rest of you guys, but I always try to remember to search the text of any one's code before running it. I look for keywords like KILL, OUTPUT, and BINARY.

Pete

Title: Re: Playing around with a SAVE/OPEN routine...
Post by: FellippeHeitor on January 22, 2021, 01:21:12 pm

Quote from: Pete on January 22, 2021, 01:17:58 pm

I look for keywords like KILL, OUTPUT, and BINARY.

Better safe than sorry. However, with API calls and external C procedures, there's quite a bit more that could put you in danger if someone decided to get naughty.

Title: Re: Playing around with a SAVE/OPEN routine...
Post by: Dav on January 22, 2021, 05:46:18 pm

(edited out double post...)

Title: Re: Playing around with a SAVE/OPEN routine...
Post by: Dav on January 22, 2021, 05:47:01 pm

_INSTRREV flew under my radar until Steve pointed it out to me recently.  Great to have!

Quote from: Pete on January 22, 2021, 12:51:53 pm

Notepad would take a .bas extension, and make it .bas.txt, if the .txt default fils type selection was left in place. I don't know if I want to copy that format, or not.

I didn't know this for a long while, but If you surround the filename in quotes notepad will save it as typed, and won't add the .txt extension.  At least not my notepad version.  "screen0hero.bas"  will be saved as screen0hero.bas, no .txt added.

EDIT: Sorry about the double post up there....I don't know what happened.  How do I delete it?

- Dav

Title: Re: Playing around with a SAVE/OPEN routine...
Post by: Pete on January 22, 2021, 10:39:56 pm

Well here's basically the same routine; mock only, so it won't change a thing on your computer. Just some bells and whistles added. Try it in your local directory, and type in a file name that already exists.

Pete

Code: QB64: [Select]

1. DIM SHARED mb.l AS INTEGER, action$
2. DIM button$(4)
3.  
4. COLOR 0, 7
5. CLS
6. _SCREENMOVE 40, 20
7. enl% = 13: CALL windowscreen(enl%)
8. _DELAY .3
9.  
10. button$(1) = "Yes": button$(2) = "No!"
11. button$(3) = "Retry": button$(4) = "Cancel"
12. operation$ = "save"
13.  
14. LOCATE 5, 1
15. LINE INPUT "Save File As: "; a$
16.  
17. doctype$ = "text"
18.  
19. drive$ = "": dir$ = ""
20. illegal_file_symbols$ = "/\:*?<>|" + CHR$(34)
21. ifs$ = illegal_file_symbols$
22.  
23. ' Determine if there is a drive and/or directory in input.
24. IF MID$(a$, 2, 2) = ":\" THEN
25.     IF LEFT$(UCASE$(a$), 1) >= "A" AND LEFT$(UCASE$(a$), 1) <= "Z" THEN
26.         drive$ = MID$(a$, 1, 3)
27.         a$ = MID$(a$, 4)
28.     ELSE
29.         BEEP
30.     END IF
31. END IF
32.  
33. IF INSTR(a$, "\") THEN
34.     dir$ = MID$(a$, 1, _INSTRREV(a$, "\"))
35.     a$ = MID$(a$, LEN(dir$) + 1)
36. END IF
37.  
38. DO
39.     IF LEN(drive$) THEN
40.         IF _DIREXISTS(drive$) THEN
41.         ELSE
42.             flag% = 1
43.         END IF
44.     END IF
45.     IF flag% THEN EXIT DO
46.  
47.     IF LEN(dir$) THEN
48.         IF _DIREXISTS(drive$ + dir$) THEN
49.         ELSE
50.             flag% = 2
51.         END IF
52.     END IF
53.     IF flag% THEN EXIT DO
54.  
55.     FOR i% = 1 TO LEN(ifs$)
56.         IF INSTR(a$, MID$(ifs$, i%, 1)) THEN flag% = 3: EXIT FOR
57.     NEXT
58.  
59.     IF _FILEEXISTS(a$) THEN
60.         IF operation$ = "save" THEN
61.             flag% = 4
62.         END IF
63.     END IF
64.  
65.     EXIT DO
66. LOOP
67.  
68. IF drive$ = "" THEN drive$ = MID$(_CWD$, 1, 3)
69. IF dir$ = "" THEN dir$ = MID$(_CWD$, 4) ' Note: no traling backslash.
70.  
71. PRINT: PRINT "Drive = "; drive$; " Dir = "; dir$; " File = "; a$: PRINT
72.  
73. SELECT CASE flag%
74.     CASE 0
75.         IF doctype$ = "text" THEN ' Check for text extension.
76.             IF INSTR(a$, ".") = 0 THEN a$ = a$ + ".txt"
77.         END IF
78.  
79.         ' Okay to save.
80.         PRINT "Saving file as: "; a$: PRINT
81.     CASE 1
82.         PRINT "Drive not found.": PRINT
83.     CASE 2
84.         PRINT "Directory not found.": PRINT
85.     CASE 3
86.         ' Illegal symbols in file name.
87.         PRINT "Illegal file name."
88.     CASE 4
89.         IF operation$ = "save" THEN
90.             msg$ = "File Already Exists. Overwrite?"
91.             button% = 2: button_index% = 0
92.  
93.             _DELAY .75: CALL popup(msg$, msg%, button$(), button%, button_index%)
94.  
95.             COLOR 0, 7
96.  
97.             SELECT CASE action$
98.                 CASE "yes"
99.                     PRINT "Overwriting file: "; a$: PRINT
100.                 CASE "no", "close"
101.                     PRINT "Save aborted.": PRINT
102.             END SELECT
103.         END IF
104. END SELECT
105.  
106. _DELAY 2
107. RUN
108.  
109. SUB popup (msg$, msg%, button$(), button%, button_index%)
110.     STATIC doctype%
111.     iyy% = CSRLIN: ixx% = POS(0)
112.     IF W3% = 0 THEN W3% = 5 ' Min.
113.     IF W4% = 0 THEN W4% = LEN(msg$) + 4 ' Min
114.  
115.     IF W1% = 0 THEN
116.         ' Auto-Center
117.         W1% = _HEIGHT \ 2 - W3% \ 2 + .5
118.         W2% = _WIDTH \ 2 - W4% \ 2 + .5
119.     END IF
120.  
121.     oldsmode = smode: PCOPY 0, 1: SCREEN 0, 0, 1, 1: smode = 1
122.  
123.     LOCATE W1%, W2%, 0 ' Cursor hide
124.     FOR I = 1 TO W3%
125.         A$ = ""
126.         COLOR 15, 1
127.         LOCATE , W2%
128.         A$ = A$ + SPACE$(W4% - LEN(A$))
129.         PRINT A$;
130.         IF I <> 1 THEN
131.             COLOR 1, 0: PRINT CHR$(176)
132.         ELSE PRINT
133.         END IF
134.     NEXT I
135.     LOCATE , W2% + 1
136.     COLOR 1, 0: PRINT STRING$(W4%, CHR$(176));
137.     COLOR 14, 1
138.     LOCATE W1%, W2%
139.     PRINT CHR$(218); STRING$(W4% - 2, CHR$(196)); CHR$(191);
140.     LOCATE W1% + W3% - 1, W2%
141.     PRINT CHR$(192); STRING$(W4% - 2, CHR$(196)); CHR$(217);
142.     FOR I = 1 TO W3% - 2
143.         LOCATE W1% + I, W2%: PRINT CHR$(179);: LOCATE W1% + I, W2% + W4% - 1: PRINT CHR$(179);
144.     NEXT I
145.     LOCATE W1%, W2% + W4% - 2: COLOR 15, 1: PRINT "x";
146.  
147.     IF LEN(msg$) THEN
148.         SELECT CASE msg%
149.             CASE -1
150.                 LOCATE W1% + 1, W2% + W4% \ 2 - LEN(msg$) \ 2
151.                 PRINT msg$;
152.             CASE 0
153.                 COLOR 15, 1
154.                 IF button% THEN
155.                     LOCATE W1% + W3% \ 2 - 1, W2% + W4% \ 2 - LEN(msg$) \ 2
156.                     PRINT msg$;
157.                     j% = 0
158.                     FOR i% = 1 TO button%
159.                         j% = j% + LEN(button$(button_index% + i%)) + 2
160.                     NEXT
161.                     LOCATE W1% + W3% \ 2 + 1, W2% + W4% \ 2 - j% \ 2 - 1
162.                     COLOR 0, 7
163.                     mouselocator$ = STRING$(_WIDTH, "0"): mouselocator% = W1% + W3% \ 2 + 1
164.                     k% = 0
165.                     FOR i% = button_index% + 1 TO button_index% + button%
166.                         IF k% THEN LOCATE , POS(0) + 2
167.                         k% = k% + 1
168.                         MID$(mouselocator$, POS(0)) = STRING$(LEN(button$(i%)) + 2, LTRIM$(STR$(k%)))
169.                         PRINT SPACE$(LEN(button$(i%)) + 2);
170.                     NEXT
171.                     LOCATE W1% + W3% \ 2 + 1, W2% + W4% \ 2 - j% \ 2
172.                     COLOR 0, 7
173.                     k% = 0
174.                     FOR i% = button_index% + 1 TO button_index% + button%
175.                         IF k% THEN LOCATE , POS(0) + 4
176.                         PRINT button$(button_index% + i%);
177.                         k% = k% + 1
178.                     NEXT
179.                     tabx% = 0
180.                     DO
181.                         CALL user(b$, mx%, my%, alt%, altoff%, shift%, ctrl%, ctrlshift%)
182.  
183.                         IF LEN(b$) THEN
184.                             SELECT CASE b$
185.                                 CASE CHR$(13)
186.                                     SELECT CASE tabx%
187.                                         CASE 1
188.                                             action$ = "yes"
189.                                         CASE 2
190.                                             action$ = "no"
191.                                     END SELECT
192.                                 CASE CHR$(27)
193.                                     action$ = "close"
194.                             END SELECT
195.                         END IF
196.  
197.                         IF my% = W1% AND mx% = W2% + W4% - 2 THEN
198.                             IF closex% = 0 THEN closex% = -1: LOCATE my%, mx%: COLOR 15, 4: PRINT "x";
199.                         ELSE
200.                             IF closex% THEN closex% = 0: LOCATE W1%, W2% + W4% - 2: COLOR 7, 1: PRINT "x";
201.                         END IF
202.  
203.                         IF bhl% THEN IF bhl% = 1 AND my% <> mouselocator% OR bhl% = 1 AND MID$(mouselocator$, mx%, 1) = "0" THEN tabx% = 0: bhl% = 0
204.                         IF b$ = CHR$(9) THEN tabx% = tabx% + 1: IF tabx% > button% THEN tabx% = 1
205.                         IF oldmx% = mx% AND oldmy% = my% THEN i% = 0 ELSE i% = -1
206.                         IF b$ = CHR$(9) OR my% = mouselocator% AND MID$(mouselocator$, mx%, 1) <> "0" AND i% THEN
207.                             IF b$ = CHR$(9) THEN k% = tabx%: bhl% = 9 ELSE k% = VAL(MID$(mouselocator$, mx%, 1)): tabx% = k%: bhl% = 1
208.  
209.                             IF h% AND h% <> tabx% THEN
210.                                 COLOR 0, 7
211.                                 LOCATE W1% + W3% \ 2 + 1, INSTR(mouselocator$, LTRIM$(STR$(h%)))
212.                                 PRINT SPACE$(1) + button$(h%) + SPACE$(1);
213.                             END IF
214.  
215.                             h% = k%: tabx% = h%
216.  
217.                             COLOR 0, 3
218.                             LOCATE W1% + W3% \ 2 + 1, INSTR(mouselocator$, LTRIM$(STR$(h%)))
219.                             PRINT SPACE$(1) + button$(h%) + SPACE$(1);
220.                             _DELAY .15
221.                         ELSE
222.                             IF h% AND tabx% = 0 THEN
223.                                 COLOR 0, 7
224.                                 LOCATE W1% + W3% \ 2 + 1, INSTR(mouselocator$, LTRIM$(STR$(h%)))
225.                                 PRINT SPACE$(1) + button$(h%) + SPACE$(1);
226.                                 h% = 0: tabx% = 0
227.                             END IF
228.                         END IF
229.  
230.                         IF mb.l THEN
231.                             IF closex% THEN SOUND 1000, .1: closex% = 0: action$ = "close"
232.                             IF my% = mouselocator% AND MID$(mouselocator$, mx%, 1) <> "0" THEN
233.                                 SOUND 1000, .1
234.                                 SELECT CASE VAL(MID$(mouselocator$, mx%, 1))
235.                                     CASE 1
236.                                         action$ = "yes"
237.                                     CASE 2
238.                                         action$ = "no"
239.                                 END SELECT
240.                             END IF
241.                         END IF
242.  
243.                         IF b$ = CHR$(9) THEN b$ = ""
244.                         oldmy% = my%: oldmx% = mx%
245.                     LOOP UNTIL LEN(action$)
246.                     smode = oldsmode: SCREEN 0, 0, smode, smode
247.                 ELSE
248.                     LOCATE W1% + W3% \ 2, W2% + W4% \ 2 - LEN(msg$) \ 2
249.                     PRINT msg$;
250.                 END IF
251.  
252.         END SELECT
253.     END IF
254.     LOCATE iyy%, ixx%
255. END SUB
256.  
257. SUB user (b$, mx%, my%, alt%, altoff%, shift%, ctrl%, ctrlshift%)
258.  
259.     DEF SEG = 0
260.     IF PEEK(1047) MOD 16 = 1 OR PEEK(1047) MOD 16 = 2 THEN shift% = -1 ELSE shift% = 0
261.     IF PEEK(1047) MOD 16 = 3 OR PEEK(1047) MOD 16 = 4 THEN ctrl% = -1 ELSE ctrl% = 0
262.     IF PEEK(1047) MOD 16 = 5 OR PEEK(1047) MOD 16 = 6 THEN ctrlshift% = -1 ELSE ctrlshift% = 0
263.  
264.     IF PEEK(1047) MOD 16 = 7 OR PEEK(1047) MOD 16 = 8 THEN
265.         alt% = -1
266.     ELSE
267.         IF alt% THEN altoff% = -1: alt% = 0 ELSE altoff% = 0: alt% = 0
268.     END IF
269.     DEF SEG
270.  
271.     b$ = INKEY$
272.  
273.     mb.w = 0
274.     WHILE _MOUSEINPUT
275.         mb.w = mb.w + _MOUSEWHEEL
276.     WEND
277.  
278.     mb.l% = _MOUSEBUTTON(1)
279.     mb.r% = _MOUSEBUTTON(2)
280.     mx% = _MOUSEX
281.     my% = _MOUSEY
282. END SUB
283.  
284. SUB windowscreen (ENL%)
285.     IF displayfullscreen% = -1 THEN EXIT SUB
286.     WINXX1% = CSRLIN: WINYY1% = POS(1)
287.     winmode$ = "2"
288.  
289.     IF ENL% <> 0 THEN
290.         full = _FULLSCREEN
291.         IF full = 0 THEN
292.             SELECT CASE ENL%
293.                 CASE -1: IF SCRNSIZE% > 0 THEN ELSE EXIT SUB
294.                 CASE 1: IF SCRNSIZE% < 14 THEN ELSE EXIT SUB
295.             END SELECT
296.         ELSE
297.             EXIT SUB
298.         END IF
299.     END IF
300.  
301.     SCRNSIZE% = SCRNSIZE% + ENL%
302.  
303.     SELECT CASE winmode$
304.         CASE "1"
305.             full = _FULLSCREEN
306.             IF full <> 0 THEN _FULLSCREEN _OFF
307.             GOSUB ChangeFont
308.         CASE "2"
309.             full = _FULLSCREEN
310.             IF full <> 0 THEN _FULLSCREEN _OFF
311.             style$ = "MONOSPACE"
312.             fontsize% = SCRNSIZE% + 13
313.             IF fontsize% < 14 THEN winmode$ = ""
314.             IF fontsize% < 18 THEN style$ = style$ + ", BOLD"
315.             fontpath$ = ENVIRON$("SYSTEMROOT") + "\fonts\lucon.ttf" 'Find Windows Folder Path.
316.             GOSUB ChangeFont
317.         CASE "3"
318.             GOSUB ChangeFont
319.             _FULLSCREEN _SQUAREPIXELS
320.             full = _FULLSCREEN
321.             IF full = 0 THEN GOSUB nofull
322.         CASE "4"
323.             GOSUB ChangeFont
324.             _FULLSCREEN _STRETCH
325.             full = _FULLSCREEN
326.             IF full = 0 THEN GOSUB nofull
327.     END SELECT
328.  
329.     LOCATE WINXX1%, WINYY1%
330.     EXIT SUB
331.  
332.     nofull:
333.     _FULLSCREEN _OFF
334.     RETURN
335.  
336.     ChangeFont:
337.     IF winmode$ <> "2" THEN
338.         _FONT 16 'select inbuilt 8x16 default font
339.         currentf& = _FONT
340.     ELSE
341.         currentf& = _LOADFONT(fontpath$, fontsize%, style$)
342.         _FONT currentf&
343.     END IF
344.  
345.     IF currentf& <> f& AND f& <> defaultf& THEN _FREEFONT f&
346.     f& = currentf&
347.     RETURN
348.  
349. END SUB
350.  

@Dav, you can't delete the whole post, but you could remove the contents. The double post probably happened because you held down that shi*t + arrow key when you posted! :D

Title: Re: Playing around with a SAVE/OPEN routine...
Post by: euklides on January 23, 2021, 05:12:47 am

Some hidden symbols can be used in file names...
I remember a case where I was unable to open a file.I made a lost of tests to understand. I don't remember what hidden symbol it was [ chr$(0) ??? ]

So testing each character of the file name to be sure that there is no symbol under value 32 could be a additional control ? 

Title: Re: Playing around with a SAVE/OPEN routine...
Post by: SMcNeill on January 23, 2021, 07:49:56 am

Quote from: euklides on January 23, 2021, 05:12:47 am

Some hidden symbols can be used in file names...
I remember a case where I was unable to open a file.I made a lost of tests to understand. I don't remember what hidden symbol it was [ chr$(0) ??? ]

So testing each character of the file name to be sure that there is no symbol under value 32 could be a additional control ?

Those used to work back in the days of DOS, but nobody bothers with them any longer, thanks to the graphical file explorers.  CHR$(0) wasn’t allowed, I don’t believe, but CHR$(255) was.  All you had to do is hold down ALT, and then type 2,5,5 sequentially on the numpad, before releasing ALT. ;)

Title: Re: Playing around with a SAVE/OPEN routine...
Post by: Pete on January 23, 2021, 11:31:59 am

You know on Mac machines, most of those excluded characters in the code are accepted. I'm not sure about Linux, I'd have to decide if I want to add an OS detection function, and further define my unaccepted character parameters. Of course there is always the easy way out, which works for ascii characters requiring special alt key inputs. Tha's to make an error handler. If QB64 can't create the file, the error handler does the work!

Pete 

Text Only | Text with Attachments