Text Only | Text with Attachments

QB64.org Forum

Active Forums => QB64 Discussion => Topic started by: SpriggsySpriggs on May 05, 2020, 09:58:22 am

Title: Get Variable Name as string
Post by: SpriggsySpriggs on May 05, 2020, 09:58:22 am
Hello. I was trying to get the name of the variables used in QB64 as they appear in the source code. I tried using the stringify method from C++ but of course it gives me the C++ interpretation that QB64 does which gives it an entirely new name. Is there a way to get the name of the variable used in the QB64 source in a similar fashion as to how it is done in C++ using the stringify preprocessor? It would be quite an amazing thing if so.

Code: QB64: [Select]
  1. DECLARE LIBRARY "getvariablename"
  2.     FUNCTION GET_VARIABLE_NAME$ (variable AS STRING)
  4. PRINT GET_VARIABLE_NAME(test$)  

Output of code: (char*)(__STRING_TEST)->chr
 [ This attachment cannot be displayed inline in 'Print Page' view ]  
Title: Re: Get Variable Name as string
Post by: FellippeHeitor on May 05, 2020, 10:37:19 am
I don't know if there is way, I'm just curious about your motivation. What do you intend to accomplish?

Also: For the final binary, the BASIC code never existed, so __STRING_TEST is as close as I think you'll get.
Title: Re: Get Variable Name as string
Post by: SpriggsySpriggs on May 05, 2020, 10:47:42 am
Quote from: FellippeHeitor on May 05, 2020, 10:37:19 am
I don't know if there is way, I'm just curious about your motivation. What do you intend to accomplish?
What I'm hoping to do is match MySQL column names to local variable names. For example:
Code: QB64: [Select]
  1. IF DB_RESULT(1,1) = GET_VARIABLE_NAME(customerId) THEN
  2. 'do stuff
This might help me to make my code more accurate in database queries. Perhaps. Maybe not. I do something similar in C# when using a dataset and accessing it like this:
string customerId = EdiCustomers["customerId"].ToString()
Doing so grabs the data at the column name customerId and assigns it to the local variable of the same name. I was thinking that if I at least had the ability to access the name of the local variable then I could do something along the same lines.
Title: Re: Get Variable Name as string
Post by: bplus on May 05, 2020, 11:05:11 am
Maybe something like this?
https://www.qb64.org/forum/index.php?topic=2553.msg117861#msg117861
Title: Re: Get Variable Name as string
Post by: Pete on May 05, 2020, 02:32:56 pm
@Mark: Okay, now after reading this thread I understand the post you linked from here.

To me, reading the variables in the source code means opening the source file, and parsing out things like A$, x!,type variable names, etc. So not the values represented, but the actual variable names used. That's what I'm getting from this thread, but I'm not going to go in depth with how to do it, because my spidey sense tells me I may be barking up the wrong programing tree.

Pete
Title: Re: Get Variable Name as string
Post by: SpriggsySpriggs on May 05, 2020, 02:40:15 pm
Quote from: Pete on May 05, 2020, 02:32:56 pm
...opening the source file, and parsing out things like A$, x!,type variable names, etc. So not the values represented, but the actual variable names used.

Exactly, Pete. I'm wanting to get the actual name as represented before compilation. Something that can get the value as how QB64 sees it in the IDE rather than during the compilation process when it gets converted to C++ code. I saw B+'s idea but it doesn't really do what I'm looking for. I suppose hard coding a variable with the name of another variable (what B+ showed) is a way of doing it.
Title: Re: Get Variable Name as string
Post by: Pete on May 05, 2020, 03:04:53 pm
To do that:

1) In your program, open the source code for BINARY or INPUT. BINARY read is a lot faster.

2) In your code, write a sub-routine that parses out all the variables and then eliminates the duplicates. That will leave you with an array filled with unique variables, to compare to your database.

Now writing the code to parse out variables is easy for strings that end in $, or numeric variables that end in %, !, etc. If you have types, DIM variables as strings, or don't use numeric identifiers like %,!, etc., that code gets a lot more complicated to write.

I made a rudimentary variable retrieving routine to help me keep up with the variable names I had in really large programs. It didn't do some of the more complicated stuff I mentioned, so I never published it. Without the more complicated parsing abilities, it just wouldn't be all purpose enough for everyone.

I'm out for a bit, but I'll return to this thread tonight. If it helps, I can dig up what I have, I think I know what computer I have it on, and if you could understand it, you could build on it, if needed.

Of course by posting what I did above, when I come back tonight there will be at least one post with a variable detection routine here, but hey, that's a good thing. I'm not the only genius here.... just the best looking one. :D

Pete
Title: Re: Get Variable Name as string
Post by: bplus on May 05, 2020, 03:12:31 pm
Well I can see how you can get a list of variable names and the task would be made easier with OPTION _EXPLICIT where you are forced to DIM everything, UDT's might be tricky.

I am curious how you will connect the variable names to ... what? after complied.
Title: Re: Get Variable Name as string
Post by: STxAxTIC on May 05, 2020, 05:10:56 pm
Half- followed this thread so forgive me but what about vwatch?
Title: Re: Get Variable Name as string
Post by: Pete on May 05, 2020, 08:48:28 pm
Dig some digging and found a couple. Wow, way back to 2000!

Code: QB64: [Select]
  1. ' It doesn't account for variables that are arrays or those that are found in the LINE() command.
  2. ' >No solution so far.
  3.  
  4. ' It cannot yet differentiate the following: 4! * abc... only picks up 4! as a variable.
  5.  
  6. ' Finally, there was a request for a comma separation output. This would not be difficult. Just adjust the way the data is added to the file.
  7. ' PRINT #F1, A$,
  8.  
  9. ' The variables and strings can be printed in all caps with the ucase$(A$) or A$ = Ucase$(A$).
  10.  
  11. '============================================================================
  12.  
  13. 'Pete's String and Variable finder.
  14.  
  15. 'Finds marked %#!& and unmarked variables as well as strings in any program.
  16.  
  17. 'Opens a table of the findings in Notepad.
  18.  
  19. 'WARNING >>> This program makes a file called 'STRVAR.DAT' in the current
  20. ' directory. If, by coincidence, a file with this name already
  21. ' exits in the current directory, it will be overwritten. Take
  22. ' any necessary precautions to prevent this before running the
  23. ' program.
  24.  
  25. ' A second file called 'TEMPDIR.TMP" is also created if a long-
  26. ' pathway name is input such as Program Files instead of progra~1.
  27.  
  28. ' Remove one of the SHELL commands. One is for Win 95-98, the other 2000/NT/XP
  29. ' If both lines remain, the program will run. A 'bad command or file name'
  30. ' comment will be the only result.
  31.  
  32. ' The program supports searching modules joined by a .MAK file. Input the .MAK
  33. ' file name at the input line and the program will automatically search each
  34. ' of the modules in the .MAK file.
  35.  
  36. '============================================================================
  37. DECLARE SUB LONGPATH (DRIVEX$, PATHWAY$, ORIGDIR$)
  39. COLOR 0, 0
  40. ON ERROR GOTO RESNXT
  41. FILES "XXX.~~~"
  43. LOCATE 1, 1
  44. FOR I = 1 TO 80
  45.     A$ = A$ + CHR$(SCREEN(1, I))
  47. A$ = RTRIM$(A$)
  48. COLOR 7, 0
  49.  
  50. DRIVEX$ = MID$(A$, 1, 3)
  51. PATHWAY$ = MID$(A$, 4)
  52. ORIGDIR$ = DRIVEX$ + PATHWAY$
  53.  
  54. REDIM X$(1000), Y$(1000), Z$(1000)
  57. F1 = FREEFILE: OPEN ORIGDIR$ + "\STRVAR.DAT" FOR INPUT AS F1: CLOSE #F1
  59.  
  60. IF ER1% = 0 THEN
  61.     PRINT " ALERT >>> THIS DIRECTORY CONTAINS A FILE NAMED 'STRVAR.DAT' THIS FILE"
  62.     PRINT " WILL BE OVERWRITTEN. DO NOT CONTINUE IF THIS IS NOT OK. - INPUT: EXIT"
  64.     PRINT " THE 'STRVAR.DAT' FILE WILL BE CREATED IN THIS DIRECTORY: "; ORIGDIR$
  65.     PRINT " NO FILE CONFLICT WAS FOUND."
  67. ER1% = 0
  68.  
  70. PRINT " TYPE 'EXIT' TO QUIT AT ANY INPUT PROMPT"
  72. PRINT " INPUT THE DRIVE THE FILE IS IN [A:\, B:\, C:\]: ";: XX% = CSRLIN: YY% = POS(1)
  73. COLOR 15, 0: LOCATE XX%, YY%: PRINT DRIVEX$: LOCATE XX%, YY%
  74. GOSUB READSCREEN
  75. DRIVEX$ = UCASE$(A1$)
  76.  
  77. IF UCASE$(A1$) = "EXIT" OR UCASE$(A1$) = "'EXIT'" THEN SYSTEM
  78.  
  80.  
  81. PRINT " INPUT THE DIRECTORY THE FILE IS IN: ";: XX% = CSRLIN: YY% = POS(1)
  82. COLOR 15, 0: LOCATE XX%, YY%: PRINT PATHWAY$: LOCATE XX%, YY%
  83. GOSUB READSCREEN
  84. PATHWAY$ = UCASE$(A1$)
  85.  
  86. IF UCASE$(A1$) = "EXIT" OR UCASE$(A1$) = "'EXIT'" THEN SYSTEM
  87.  
  88. REM CHECKS FOR LONG-PATHWAY NAMES
  89. IF INSTR(PATHWAY$, "\") <> 0 THEN
  90.     HOLDPATH$ = PATHWAY$: MODPATH$ = PATHWAY$ + "\": J% = 1
  91.     DO
  92.         PATHWAY$ = MID$(MODPATH$, J%, INSTR(J%, MODPATH$, "\") - J%)
  93.         J% = J% + LEN(PATHWAY$) + 1
  94.         GOSUB CKPATH
  95.         IF MSDOSPATH$ <> "" THEN MSDOSPATH$ = MSDOSPATH$ + "\" + PATHWAY$ ELSE MSDOSPATH$ = PATHWAY$
  96.         IF J% > LEN(HOLDPATH$) THEN EXIT DO
  97.     LOOP
  98.     PATHWAY$ = MSDOSPATH$
  100.     GOSUB CKPATH
  102.  
  104.  
  105. PRINT " INPUT THE .BAS FILE OR INPUT THE .MAK FILE: ";: XX% = CSRLIN: YY% = POS(1)
  106. COLOR 15, 0: LOCATE XX%, YY%
  107. GOSUB READSCREEN
  108.  
  109. IF UCASE$(A1$) = "EXIT" OR UCASE$(A1$) = "'EXIT'" THEN SYSTEM
  110.  
  111. IF INSTR(A1$, ".") = 0 THEN A1$ = A1$ + ".BAS": REM ADDS A BASIC EXTENSION IF LEFT OFF.
  112.  
  113. LOCATE 13, 1
  114.  
  115. ORIGFILENAME$ = UCASE$(A1$)
  116. FILENAME$ = DRIVEX$ + PATHWAY$ + "\" + UCASE$(A1$)
  117.  
  118. ON ERROR GOTO CHECKFILE
  119. REM CHECK FOR FILE
  120. F2 = FREEFILE: OPEN FILENAME$ FOR INPUT AS #F2: CLOSE #2
  122.  
  123. IF MID$(FILENAME$, LEN(FILENAME$) - 3, 4) = ".MAK" THEN
  124.     F2 = FREEFILE: OPEN FILENAME$ FOR INPUT AS #F2
  125.     MAK% = 1
  127.  
  129.     IF MAK% = 1 THEN
  130.         IF NOT EOF(F2) THEN
  131.             LINE INPUT #F2, FILENAME$
  132.             FILENAME$ = DRIVEX$ + PATHWAY$ + "\" + UCASE$(FILENAME$)
  133.         ELSE
  134.             EXIT DO
  135.         END IF
  136.     END IF
  137.  
  138.     PRINT " SEARCHING FILE: "; FILENAME$
  139.  
  140.     F1 = FREEFILE
  141.     OPEN FILENAME$ FOR INPUT AS #F1
  142.     DO
  143.         LINE INPUT #F1, A$
  144.         REM - REMOVE ALL QUOTED SEGMENTS
  145.         DO
  146.             IF INSTR(A$, CHR$(34)) <> 0 THEN
  147.                 AX1$ = MID$(A$, 1, INSTR(A$, CHR$(34)) - 1)
  148.                 AX2$ = MID$(A$, INSTR(LEN(AX1$) + 2, A$, CHR$(34)) + 1)
  149.                 A$ = AX1$ + AX2$
  150.                 K% = INSTR(A$, CHR$(34)): IF K% = 0 THEN EXIT DO ELSE IF INSTR(K% + 1, A$, CHR$(34)) = 0 THEN EXIT DO: REM ONLY ON QUOTE MARK.
  151.             ELSE
  152.                 EXIT DO
  153.             END IF
  154.         LOOP
  155.  
  156.         IF INSTR(A$, "=") OR INSTR(A$, "$") OR INSTR(A$, "%") OR INSTR(A$, "!") OR INSTR(A$, "#") OR INSTR(A$, "&") THEN
  157.             A2$ = LTRIM$(RTRIM$(A$))
  158.             DO
  159.                 IF INSTR(A2$, " ") = 0 THEN A1$ = A2$ ELSE A1$ = MID$(A2$, 1, INSTR(A2$, " "))
  160.                 IF INSTR(A1$, "$") <> 0 THEN
  161.                     IF MID$(A1$, 1, 4) <> "MID$" AND MID$(A1$, 1, 6) <> "LTRIM$" AND MID$(A1$, 1, 6) <> "RTRIM$" AND MID$(A1$, 1, 6) <> "RIGHT$" AND MID$(A1$, 1, 5) <> "LEFT$" AND MID$(A1$, 1, 6) <> "SPACE$" AND MID$(A1$, 1, 7) <> "STRING$" THEN
  162.                         IF MID$(A1$, 1, 6) <> "LCASE$" AND MID$(A1$, 1, 6) <> "UCASE$" AND MID$(A1$, 1, 5) <> "INSTR" AND MID$(A1$, 1, 6) <> "INKEY$" AND MID$(A1$, 1, 6) <> "IOCTL$" AND MID$(A1$, 1, 5) <> "TIME$" AND MID$(A1$, 1, 4) <> "CHR$" THEN
  163.                             IF MID$(A1$, 1, 7) <> "VARPTR$" AND MID$(A1$, 1, 4) <> "MKD$" AND MID$(A1$, 1, 7) <> "MKDMBF$" AND MID$(A1$, 1, 4) <> "MKI$" AND MID$(A1$, 1, 4) <> "MKL$" AND MID$(A1$, 1, 4) <> "MKS$" AND MID$(A1$, 1, 4) <> "STR$" THEN
  164.                                 IF MID$(A1$, 1, 7) <> "MKSMBF$" AND MID$(A1$, 1, 4) <> "OCT$" AND MID$(A1$, 1, 4) <> "HEX$" AND MID$(A1$, 1, 9) <> "'$DYNAMIC" AND MID$(A1$, 1, 8) <> "'$STATIC" AND MID$(A1$, 1, 9) <> "'$INCLUDE" AND MID$(A1$, 1, 3) <> "LEN" THEN
  165.                                     IF MID$(A1$, 1, 8) <> "$DYNAMIC" AND MID$(A1$, 1, 8) <> "$STATIC" AND MID$(A1$, 1, 8) <> "$INCLUDE" THEN
  166.                                         A3$ = A1$
  167.                                         IF MID$(A3$, 1, 1) <> CHR$(34) THEN
  168.                                             IF INSTR(A3$, "$") < LEN(A3$) THEN A3$ = MID$(A3$, 1, INSTR(A3$, "$"))
  169.                                             IF MID$(A3$, 1, 1) = "(" THEN A3$ = MID$(A3$, 2)
  170.                                             IF INSTR(A3$, "(") <> 0 AND INSTR(A3$, ")") = 0 OR INSTR(A3$, "'") <> 0 THEN
  171.                                             ELSE
  172.                                                 A3$ = RTRIM$(LTRIM$(UCASE$(A3$)))
  173.                                                 I = 0
  174.                                                 DO
  175.                                                     I = I + 1
  176.                                                     IF X$(I) = A3$ THEN J% = -1: EXIT DO
  177.                                                     IF X$(I) = "" THEN X$(I) = A3$: EXIT DO
  178.                                                 LOOP
  179.                                             END IF
  180.                                         END IF
  181.                                     END IF
  182.                                 END IF
  183.                             END IF
  184.                         END IF
  185.                     END IF
  186.                 END IF
  187.  
  188.                 REM VARIABLES !#%&
  189.                 RESTORE VARIABLES
  190.                 DO
  191.                     READ VAR1$
  192.                     IF VAR1$ = "EOF" THEN EXIT DO
  193.                     IF INSTR(A1$, VAR1$) <> 0 THEN
  194.                         A3$ = A1$
  195.                         A3$ = RTRIM$(LTRIM$(UCASE$(A3$)))
  196.                         IF MID$(A3$, LEN(A3$), 1) = "," THEN A3$ = MID$(A3$, 1, LEN(A3$) - 1)
  197.                         IF MID$(A3$, 1, 1) = "(" THEN A3$ = MID$(A3$, 2)
  198.                         IF MID$(A3$, 1, 1) = VAR1$ OR INSTR(A3$, VAR1$) < LEN(A3$) AND MID$(A3$, INSTR(A3$, VAR1$) + 1, 1) <> "(" THEN
  199.                         ELSE
  200.                             IF INSTR(A3$, "(") <> 0 AND INSTR(A3$, ")") = 0 OR INSTR(A3$, "'") <> 0 THEN
  201.                             ELSE
  202.                                 I = 0
  203.                                 DO
  204.                                     I = I + 1
  205.                                     IF Y$(I) = A3$ THEN J% = -1: EXIT DO
  206.                                     IF Y$(I) = "" THEN Y$(I) = A3$: EXIT DO
  207.                                 LOOP
  208.                             END IF
  209.                         END IF
  210.                     END IF
  211.                 LOOP
  212.  
  213.                 REM UNMARKED VARIABLES
  214.                 VAR1$ = "="
  215.                 IF INSTR(A1$, VAR1$) <> 0 THEN
  216.                     A3$ = OLDA3$
  217.                     A3$ = RTRIM$(LTRIM$(UCASE$(A3$)))
  218.  
  219.                     IF MID$(A3$, 1, 4) <> "MID$" AND MID$(A3$, 1, 6) <> "LTRIM$" AND MID$(A3$, 1, 6) <> "RTRIM$" AND MID$(A3$, 1, 6) <> "RIGHT$" AND MID$(A3$, 1, 5) <> "LEFT$" AND MID$(A3$, 1, 6) <> "SPACE$" AND MID$(A3$, 1, 7) <> "STRING$" THEN
  220.                         IF MID$(A3$, 1, 6) <> "LCASE$" AND MID$(A3$, 1, 6) <> "UCASE$" AND MID$(A3$, 1, 5) <> "INSTR" AND MID$(A3$, 1, 6) <> "INKEY$" AND MID$(A3$, 1, 6) <> "IOCTL$" AND MID$(A3$, 1, 5) <> "TIME$" AND MID$(A3$, 1, 4) <> "CHR$" THEN
  221.                             IF MID$(A3$, 1, 7) <> "VARPTR$" AND MID$(A3$, 1, 4) <> "MKD$" AND MID$(A3$, 1, 7) <> "MKDMBF$" AND MID$(A3$, 1, 4) <> "MKI$" AND MID$(A3$, 1, 4) <> "MKL$" AND MID$(A3$, 1, 4) <> "MKS$" AND MID$(A3$, 1, 4) <> "STR$" THEN
  222.                                 IF MID$(A3$, 1, 7) <> "MKSMBF$" AND MID$(A3$, 1, 4) <> "OCT$" AND MID$(A3$, 1, 4) <> "HEX$" AND MID$(A3$, 1, 9) <> "'$DYNAMIC" AND MID$(A3$, 1, 8) <> "'$STATIC" AND MID$(A3$, 1, 9) <> "'$INCLUDE" AND MID$(A3$, 1, 3) <> "LEN" THEN
  223.                                     IF MID$(A3$, 1, 8) <> "$DYNAMIC" AND MID$(A3$, 1, 8) <> "$STATIC" AND MID$(A3$, 1, 8) <> "$INCLUDE" THEN
  224.  
  225.                                         IF A3$ <> "" THEN
  226.                                             IF MID$(A3$, LEN(A3$), 1) <> "$" AND A3$ <> "LEN" AND MID$(A3$, LEN(A3$), 1) > "A" AND MID$(A3$, LEN(A3$), 1) < "Z" THEN
  227.                                                 IF INSTR(A3$, "'") = 0 THEN
  228.                                                     I = 0
  229.                                                     DO
  230.                                                         I = I + 1
  231.                                                         IF Z$(I) = A3$ THEN J% = -1: EXIT DO
  232.                                                         IF Z$(I) = "" THEN Z$(I) = A3$: EXIT DO
  233.                                                     LOOP
  234.                                                 END IF
  235.                                             END IF
  236.                                         END IF
  237.                                     END IF
  238.                                 END IF
  239.                             END IF
  240.                         END IF
  241.                     END IF
  242.                 END IF
  243.  
  244.                 OLDA3$ = A1$
  245.                 A2$ = MID$(A2$, LEN(A1$) + 1)
  246.                 IF A2$ = "" THEN EXIT DO
  247.             LOOP
  248.         END IF
  249.     LOOP UNTIL EOF(F1)
  250.     CLOSE F1
  251.     IF MAK% = 0 THEN EXIT DO
  253.  
  254. F1 = FREEFILE: OPEN ORIGDIR$ + "\STRVAR.DAT" FOR OUTPUT AS F1
  255.  
  256. A$ = "TABLE OF VARIABLES AND STRINGS FOR: " + ORIGFILENAME$
  257. PRINT #F1, A$
  258. PRINT #F1, ""
  259.  
  260. I = 0
  262.     I = I + 1
  263.     IF X$(I) = "" THEN I = I - 1: EXIT DO
  264.     NUM$ = LTRIM$(STR$(I))
  265.     SELECT CASE LEN(NUM$)
  266.         CASE 1: NUM$ = "00" + NUM$
  267.         CASE 2: NUM$ = "0" + NUM$
  268.     END SELECT
  269.     PRINT #F1, "STRING NAME " + NUM$ + " = "; X$(I)
  271.  
  272. IF I <> 0 THEN PRINT #F1, ""
  273.  
  274. I = 0
  276.     I = I + 1
  277.     IF Y$(I) = "" THEN I = I - 1: EXIT DO
  278.     NUM2$ = LTRIM$(STR$(I))
  279.     SELECT CASE LEN(NUM2$)
  280.         CASE 1: NUM2$ = "00" + NUM2$
  281.         CASE 2: NUM2$ = "0" + NUM2$
  282.     END SELECT
  283.     PRINT #F1, "VARIABLES MARKED " + NUM2$ + " = "; Y$(I)
  285.  
  286. IF I <> 0 THEN PRINT #F1, ""
  287.  
  288. I = 0
  290.     I = I + 1
  291.     IF Z$(I) = "" THEN EXIT DO
  292.     NUM3$ = LTRIM$(STR$(I))
  293.     SELECT CASE LEN(NUM3$)
  294.         CASE 1: NUM3$ = "00" + NUM3$
  295.         CASE 2: NUM3$ = "0" + NUM3$
  296.     END SELECT
  297.     PRINT #F1, "VARIABLES UNMARKED " + NUM3$ + " = "; Z$(I)
  299. CLOSE #F1
  300.  
  302. A$ = INKEY$
  304. LOCATE 22, 1
  305.  
  306. REM - FOR WIN 95-98
  307. CHDIR ORIGDIR$
  308. REM SHELL "COMMAND /C START NOTEPAD " + ORIGDIR$ + "\STRVAR.DAT"
  309.  
  310. REM - FOR WIN 2000\NT\XP\Win 7 and 8
  311. SHELL "CMD /C START NOTEPAD " + ORIGDIR$ + "\STRVAR.DAT"
  312.  
  313. A$ = INKEY$
  316.  
  317. READSCREEN:
  318. LINE INPUT ; A$: COLOR 7, 0
  319. A1$ = ""
  320. LOCATE XX%, YY%
  321. FOR I = 1 TO 81 - POS(1)
  322.     A1$ = A1$ + CHR$(SCREEN(XX%, YY% + I - 1))
  324. A1$ = RTRIM$(A1$)
  326.  
  327. CKPATH:
  328. IF MSDOSPATH$ = "" THEN CHDIR DRIVEX$ ELSE CHDIR MSDOSPATH$
  329. IF LEN(PATHWAY$) > 8 AND INSTR(PATHWAY$, "\") = 0 THEN
  330.     IF INSTR(PATHWAY$, ".") <> 0 THEN
  331.         IF LEN(PATHWAY$) > 12 THEN CALL LONGPATH(DRIVEX$, PATHWAY$, ORIGDIR$)
  332.     ELSE
  333.         CALL LONGPATH(DRIVEX$, PATHWAY$, ORIGDIR$)
  334.     END IF
  337.  
  338. RESNXT:
  340.  
  341. ERH:
  342. ER1% = ERR
  344.  
  345. CHECKFILE:
  346. IF ERR = 53 THEN PRINT " FILE NOT FOUND. RESETTING PROGRAM...": SLEEP 3: RESUME RUNPRO
  347. GOTO ER1
  348.  
  349. ER1:
  350. PRINT " ERROR"; ERR; "CANNOT CONTINUE. RESETTING PROGRAM...": SLEEP 3: RESUME RUNPRO
  351. RESUME RUNPRO
  352.  
  353. RUNPRO:
  355. CHDIR ORIGDIR$
  357.  
  358. VARIABLES:
  359. DATA %,!,#,&,EOF
  360.  
  361. SUB LONGPATH (DRIVEX$, PATHWAY$, ORIGDIR$)
  362.  
  363.     DIRSEARCH:
  364.     SHELL "DIR /A:D /O:N > " + ORIGDIR$ + "\TEMPDIR.TMP"
  365.  
  366.     GOSUB FXN1
  367.  
  368.     REM - CONVERTS LONG-FILE WINDOWS PATHWAY NAME TO MS-DOS 8.3 FORMAT.
  369.     IF A2$ <> "" THEN PATHWAY$ = A2$
  370.  
  371.     CHDIR ORIGDIR$
  372.     GOTO ENDSRCHDIRPF
  373.  
  374.     FXN1:
  375.     F1 = FREEFILE
  376.     OPEN ORIGDIR$ + "\TEMPDIR.TMP" FOR INPUT AS #F1
  377.     DO
  378.         IF EOF(F1) THEN EXIT DO
  379.         LINE INPUT #F1, A$
  380.         A1$ = RTRIM$(MID$(UCASE$(A$), 45))
  381.         IF A1$ = PATHWAY$ THEN A2$ = RTRIM$(MID$(A$, 1, 12)): EXIT DO
  382.     LOOP UNTIL EOF(F1)
  383.     CLOSE #F1
  384.     KILL ORIGDIR$ + "\TEMPDIR.TMP"
  385.     RETURN
  386.  
  387.     ENDSRCHDIRPF:
  389.  
  390.  

And a slightly updated and smaller utility...

Code: QB64: [Select]
  1. WIDTH 80, 43
  2. ' Variables
  3. DIM variable$(10000)
  4. DIM FileEntry$(10000)
  5. '
  6. vp1 = 4
  7. vp2 = 40
  8. fcoloxr = 7
  9. bcoloxr = 0
  10. hfcoloxr = 0
  11. hbcoloxr = 7
  12. menutop1 = 1
  13. menuleft1 = 1
  14. menuwidtxh1 = 80
  15. menuheight1 = 2
  16. menutop2 = 4
  17. menuleft2 = 2
  18. menuwidtxh2 = 80
  19. menuheight2 = vp2 - vp1 + 1
  20. rprompt = 1
  21. promptwidtxh = 80
  22. marginleft = 2
  23.  
  25. SHELL _HIDE "dir /b *.bas > tmp.tmp"
  26. SHELL _DONTWAIT "notepad tmp.tmp"
  27. OPEN "tmp.tmp" FOR INPUT AS #1
  28. OPEN "tmp.txt" FOR OUTPUT AS #2
  30.     LINE INPUT #1, a$
  31.     i = i + 1
  32.     FileEntry$(i) = a$
  34. indexmenumax = i
  35. indexmenu = 1
  37. prompt$ = "Highlight and Select a File to Get a List of Variables"
  38. LOCATE 2, 40 - LEN(prompt$) \ 2: PRINT prompt$;
  39. VIEW PRINT vp1 TO vp2
  40. ' Make Selection Menu
  41. GOSUB menu
  42.  
  43. OPEN FileEntry$(indexmenu) FOR INPUT AS #1
  46. prompt$ = "Variables for File: " + FileEntry$(indexmenu)
  47. LOCATE 2, 40 - LEN(prompt$) \ 2: PRINT prompt$;
  48. VIEW PRINT vp1 TO vp2
  49.  
  51.     LINE INPUT #1, a$
  52.     REM GOSUB temp
  53.     GOSUB rewrite
  54.     IF INSTR(a$, "=") THEN
  55.         GOSUB analysis
  56.     END IF
  58. CLOSE #1, #2
  59. SHELL _DONTWAIT "NOTEPAD tmp.txt"
  60.  
  62. prompt$ = "Run Again? Y/N"
  63. LOCATE 3, 40 - LEN(prompt$) \ 2: PRINT prompt$;
  65.     GOSUB keyroutine
  66.     SELECT CASE UCASE$(keyboard$)
  67.         CASE "Y"
  68.             RUN
  69.         CASE "N"
  70.             EXIT WHILE
  71.         CASE CHR$(27)
  72.             SYSTEM
  73.     END SELECT
  76.  
  77. analysis:
  78. x$ = ""
  79. a$ = " " + a$
  80. flag = -1
  81. FOR i = 1 TO LEN(a$)
  82.     IF MID$(UCASE$(a$), i, 5) = " CHR$" THEN flag = 0
  83.     IF MID$(UCASE$(a$), i, 8) = " CSRLIN " THEN flag = 0
  84.     IF MID$(UCASE$(a$), i, 6) = " DATA " THEN flag = 0
  85.     IF MID$(UCASE$(a$), i, 6) = " DATE$" THEN flag = 0
  86.     IF MID$(UCASE$(a$), i, 5) = " POS(" THEN flag = 0
  87.     IF MID$(UCASE$(a$), i, 5) = " LEN(" THEN flag = 0
  88.     IF MID$(UCASE$(a$), i, 4) = " IS " THEN flag = 0
  89.     IF MID$(UCASE$(a$), i, 9) = " ENVIRON " THEN flag = 0
  90.     IF MID$(UCASE$(a$), i, 9) = " ENVIRON$(" THEN flag = 0
  91.     IF MID$(UCASE$(a$), i, 5) = " EOF(" THEN flag = 0
  92.     IF MID$(UCASE$(a$), i, 6) = " HEX$(" THEN flag = 0
  93.     IF MID$(UCASE$(a$), i, 7) = " INKEY$" THEN flag = 0
  94.     IF MID$(UCASE$(a$), i, 7) = " INSTR(" THEN flag = 0
  95.     IF MID$(UCASE$(a$), i, 5) = " NOT " THEN flag = 0
  96.     IF MID$(UCASE$(a$), i, 6) = " OCT$(" THEN flag = 0
  97.     IF MID$(UCASE$(a$), i, 5) = " REM " THEN flag = 0
  98.     IF MID$(UCASE$(a$), i, 6) = " TIME$" THEN flag = 0
  99.  
  100.     SELECT CASE flag
  101.         CASE 0
  102.             IF MID$(a$, i, 1) = ":" THEN flag = -1
  103.         CASE 1
  104.             IF MID$(a$, i, 1) = CHR$(34) THEN flag = -1
  105.         CASE -1
  106.             SELECT CASE MID$(a$, i, 1)
  107.                 CASE " "
  108.                     x1$ = LTRIM$(RTRIM$(x$))
  109.                     x$ = ""
  110.                     variable$ = x1$
  111.                 CASE CHR$(34)
  112.                     flag = 1
  113.                 CASE "'"
  114.                     flag = 0
  115.                 CASE "="
  116.                     IF INSTR(variable$, "(") THEN
  117.                         variable$ = MID$(variable$, 1, INSTR(variable$, "(") - 1) + "()"
  118.                     END IF
  119.                     GOSUB unique
  120.                     IF unique THEN
  121.                         LOCATE CSRLIN, marginleft
  122.                         PRINT variable$
  123.                         PRINT #2, variable$
  124.                         cnt = cnt + 1
  125.                         variable$(cnt) = variable$
  126.                         unique = 0
  127.                     END IF
  128.             END SELECT
  129.     END SELECT
  130.     IF flag = -1 THEN x$ = x$ + MID$(a$, i, 1)
  133.  
  134. unique:
  135. FOR j = 1 TO cnt
  136.     IF LCASE$(variable$(j)) = LCASE$(variable$) THEN EXIT FOR
  138. IF j > cnt THEN unique = -1
  140.  
  141. temp:
  142. ' Only used to experiment with no spaces in an entry.
  143. x1$ = ""
  144. FOR i = 1 TO LEN(a$)
  145.     IF MID$(a$, i, 1) <> " " THEN
  146.         x1$ = x1$ + MID$(a$, i, 1)
  147.     END IF
  149. a$ = x1$
  151.  
  152. rewrite:
  153. qflag = 0
  154. a1$ = ""
  155. FOR i = 1 TO LEN(a$)
  156.     x$ = MID$(a$, i, 1)
  157.     IF x$ = CHR$(34) THEN qflag = ABS(qflag) - 1
  158.     IF qlag = 0 THEN
  159.         SELECT CASE ASC(UCASE$(x$))
  160.             CASE 32, 33, 35 TO 38, 40, 41, 48 TO 57, 65 TO 90
  161.                 a1$ = a1$ + x$
  162.             CASE ELSE
  163.                 IF MID$(a$, i - 1, 1) <> " " THEN a1$ = a1$ + " "
  164.                 a1$ = a1$ + x$
  165.                 IF MID$(a$, i + 1, 1) <> " " THEN a1$ = a1$ + " "
  166.         END SELECT
  167.     END IF
  169. a$ = a1$
  171.  
  172. menu:
  173. FOR i = 1 TO menuheight2
  174.     LOCATE menutop2 + i - 1, menuleft2
  175.     PRINT FileEntry$(i);
  177. LOCATE menutop2, menuleft2
  178. COLOR hfcoloxr, hbcoloxr
  179. PRINT FileEntry$(indexmenu);
  180. COLOR fcoloxr, bcoloxr
  182.     GOSUB keyroutine
  183.     GOSUB MainSelect
  184.     IF keyboard$ = CHR$(13) THEN EXIT WHILE
  187.  
  188.  
  189. keyroutine:
  191. keyboard$ = INKEY$
  193.  
  194.  
  195. MainSelect:
  196. IF keyboard$ <> "" THEN
  197.     IF keyboard$ = CHR$(27) THEN SYSTEM
  198.     SELECT CASE keyboard$
  199.         CASE CHR$(0) + "H"
  200.             GOSUB highlightmenu
  201.         CASE CHR$(0) + "P"
  202.             GOSUB highlightmenu
  203.         CASE CHR$(13)
  204.  
  205.     END SELECT
  208.  
  209.  
  210. highlightmenu:
  211. SELECT CASE keyboard$
  212.     CASE CHR$(0) + "H"
  213.         IF indexmenu > 1 THEN
  214.             IF CSRLIN = vp1 THEN
  215.                 CLS 2
  216.                 FOR i = 1 TO menuheight2
  217.                     LOCATE menutop2 + i - 1, menuleft2
  218.                     IF indexmenu > menuheight2 THEN
  219.                         PRINT FileEntry$(indexmenu - menuheight2 + i - 1);
  220.                     END IF
  221.                 NEXT
  222.                 indexmenu = indexmenu - 1
  223.                 IF indexmenu < 1 THEN indexmenu = 1
  224.                 LOCATE menutop2 + menuheight2 - 1, menuleft2
  225.                 COLOR hfcoloxr, hbcoloxr
  226.                 PRINT FileEntry$(indexmenu);
  227.                 COLOR fcoloxr, bcoloxr
  228.             ELSE
  229.                 COLOR fcoloxr, bcoloxr
  230.                 LOCATE CSRLIN, menuleft2
  231.                 PRINT FileEntry$(indexmenu);
  232.                 indexmenu = indexmenu - 1
  233.                 LOCATE CSRLIN - 1, menuleft2
  234.                 COLOR hfcoloxr, hbcoloxr
  235.                 PRINT FileEntry$(indexmenu);
  236.                 COLOR fcoloxr, bcoloxr
  237.             END IF
  238.         END IF
  239.     CASE CHR$(0) + "P"
  240.         IF CSRLIN = vp2 THEN
  241.             IF indexmenu < indexmenumax THEN
  242.                 CLS 2
  243.                 FOR i = 1 TO menuheight2
  244.                     LOCATE menutop2 + i - 1, menuleft2
  245.                     PRINT FileEntry$(indexmenu + i);
  246.                 NEXT
  247.                 indexmenu = indexmenu + 1
  248.                 LOCATE menutop2, menuleft2
  249.                 COLOR hfcoloxr, hbcoloxr
  250.                 PRINT FileEntry$(indexmenu);
  251.                 COLOR fcoloxr, bcoloxr
  252.             END IF
  253.         ELSE
  254.             IF indexmenu < indexmenumax THEN
  255.                 COLOR fcoloxr, bcoloxr
  256.                 LOCATE CSRLIN, menuleft2
  257.                 PRINT FileEntry$(indexmenu);
  258.                 indexmenu = indexmenu + 1
  259.                 LOCATE CSRLIN + 1, menuleft2
  260.                 COLOR hfcoloxr, hbcoloxr
  261.                 PRINT FileEntry$(indexmenu);
  262.                 COLOR fcoloxr, bcoloxr
  263.             END IF
  264.         END IF
  267.  

Note, these were made prior to qb64, qb64 keyword differentiation is not present in these code examples.

Pete
Title: Re: Get Variable Name as string
Post by: bplus on May 06, 2020, 10:49:44 am
@Pete, do you remember why you wanted a list of variable names?

I confess not understanding SpriggsySpriggs  (< opps mispelled sorry!) answer to Fellippe.

The only 2 apps I can think of for needing a list of variable names is color highlighting for bas editor or for an interpreter.

Does anyone else know of application?

It does sound like a Rosetta Code Challenge kind of thing.
Title: Re: Get Variable Name as string
Post by: Dimster on May 06, 2020, 03:25:44 pm
Perhaps an AI might want to create a variable to it's own program.
Title: Re: Get Variable Name as string
Post by: bplus on May 06, 2020, 03:49:46 pm
Quote from: Dimster on May 06, 2020, 03:25:44 pm
Perhaps an AI might want to create a variable to it's own program.

Ah yes! An AI that modifies bas files, say to automatically improve code, we may be at edge of Code Fiction territory :)
Title: Re: Get Variable Name as string
Post by: SMcNeill on May 06, 2020, 06:47:26 pm
Quote from: bplus on May 06, 2020, 03:49:46 pm
Ah yes! An AI that modifies bas files, say to automatically improve code, we may be at edge of Code Fiction territory :)

Before I added our precompiler into QB64, I used external AI to improve code and add functionality.   (I still do, for some things...)

For example, I can write a program like this:


Code: [Select]
'#WB:ME
'#LICENSE:WTFPL
'#CD:DATE$
'#UD:DATE$
None of that means anything to QB64 itself -- it just reads it as comments -- but instead of using QB64.EXE to compile that program, I'll use QB64-Precomp.EXE.

QB64-Precomp will then read that and translate those lines as needed into a different BAS file. 

'WB:will generate a series of lines similar to:
Code: [Select]
Center, 10, "Written By"
Center, 11, "Steven McNeill"
Center, 12, "230 McNeil Hill RD, Pilot, VA"
Center, 13, "(smcneill@swva.net)"
Pause, 15
CLS
'LICENSE: will insert the appropriate license into my code, to display to the end user.

'CD: is the concept/creation date.  It replaces DATE$ with the current date when compiled the first time.

'UD: is the Updated Date, which remains and appends a series of current date/time when compiled.

By parsing those 4 little unique variable names from the code, it saves me a lot of repeative writing in my programs and improves readability/scrollability for the rest of the program which does whatever I'm trying to do with my code.
Title: Re: Get Variable Name as string
Post by: Pete on May 07, 2020, 12:56:55 am
Quote from: bplus on May 06, 2020, 10:49:44 am
@Pete, do you remember why you wanted a list of variable names?

I confess not understanding SpriggsySpiggs answer to Fellippe.

The only 2 apps I can think of for needing a list of variable names is color highlighting for bas editor or for an interpreter.

Does anyone else know of application?

It does sound like a Rosetta Code Challenge kind of thing.

I may have put the first program together as a response to someone asking for such a program at QBF, many years ago. The second one, I believe I used once or twice, myself. Why? Probably to get a better handle on the programs, to rename certain variables without duplicating a name already in use,  etc. While many programmers completely plan out their projects before they code it, I simply code as I go. That holds true for the small stuff as well as the largest apps I've made over the years.

Pete
Text Only | Text with Attachments