home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / qb_pds / dos / truename / nametrue.bas < prev    next >
Encoding:
BASIC Source File  |  1994-04-09  |  11.6 KB  |  492 lines
  1. '******************************NAMETRUE.BAS*****************************
  2. '
  3. 'JRD NOTE:
  4. '
  5. 'Another little known gem. The Undocumented MS-DOS command TRUENAME!
  6. '
  7. 'If you enter a VALID file name =OF ANY KIND=, it returns that name
  8. 'and the PATH where you entered the name.
  9. '
  10. 'If you try to find out what its internal help switches are by typing:
  11. 'TRUENAME/? {Enter}
  12. '
  13. 'DOS says: "Reserved command name"
  14. '
  15. 'But that's OK, this program allows you to screen for =all= (I think) the
  16. 'illegal characters that a person may enter, and you can check them
  17. 'out one by one with this program.
  18. '
  19. 'Doesn't give you an error with the forward slash "/" or ".?/*" with
  20. 'this program using just TRUENAME, but "/" definitely will if you
  21. 'invoke TRUENAME from the command line.
  22.  
  23. 'I trapped: InValid$ = "\/?*" in the NameTrue$(InSpec$) FUNCTION
  24. 'because  though they are LEGAL PATH names, they are ILLEGAL file Names
  25. '
  26. 'Otherwise TRUENAME as used in this program does trap "all" the other
  27. 'Illegal names... TRUENAME is terrific!
  28. '
  29. 'As you enter all kinds of keys, remember that if the DRIVE is
  30. 'invalid, that will give a PATH error, that is NOT an illegal name!
  31. 'That's why I displayed the MS-DOS Error Codes.
  32. '
  33. 'TRUENAME doesn't care if the PATH DOESN'T EXIST, just as long as it
  34. 'COULD be a VALID PATH or FileName!
  35.  
  36. 'Test it out, you will surprised how effective and "smart" TRUENAME is.
  37. '
  38. '4/9/94
  39. '
  40. '
  41. ' $INCLUDE: 'QB.BI'
  42. DECLARE FUNCTION NameTrue$ (InSpec$)
  43. DIM SHARED Regs AS RegType
  44.  
  45. 'declares from JOHN_SUB.BAS
  46. DECLARE FUNCTION BufferedKeyInput$ (n%)
  47. DECLARE FUNCTION Center% (text$)
  48. DECLARE SUB ColorIt (Fgd%, Bkg%)
  49. DECLARE SUB CursorOff ()
  50. DECLARE SUB CursorOn ()
  51. DECLARE SUB LocateIt (Row%, text$)
  52. DECLARE SUB WaitKey ()
  53. DECLARE SUB TextBoxShadow (Row%, Col%, Message$, Outline%, Shadow%, Length%)
  54. DECLARE SUB Splash (BackGround%)
  55. DECLARE SUB ErrorHandler (ErrorCode%)
  56. DECLARE SUB GetColr (Fgd%, Bkg%, Colr%)
  57. DECLARE SUB TwoColrs (Fgd%, Bkg%, Colr%)
  58. DECLARE SUB SetBorder (ColrByte%)
  59.  
  60. REDIM SHARED Box$(1 TO 56)
  61.  
  62.  
  63. 'executable code follows
  64. Copyright$ = "■Copyright (c) 1994 LearnWare (c) ■ John De Palma■"
  65. Again:
  66.     CursorOff
  67.     CALL ColorIt(7, 1)
  68.     CLS
  69.     CALL SetBorder(4)
  70.     Splash (177)
  71.     Message$ = "Use the TRUENAME Undocumented MS-DOS Command"
  72.     CALL ColorIt(14, 4)
  73.     CALL TextBoxShadow(2, 0, Message$, 4, 1, 0)
  74.     CALL ColorIt(15, 1)
  75.     d$ = DATE$
  76.     t$ = TIME$
  77.     Length% = LEN(t$) + 2
  78.     Buffer$ = SPACE$(10)
  79.     Message$ = SPACE$(Length%)
  80.     CALL ColorIt(11, 3)
  81.     CALL TextBoxShadow(15, 4, Message$, 4, 1, 1)
  82.     RSET Buffer$ = d$
  83.     LOCATE 16, 7: PRINT Buffer$
  84.     RSET Buffer$ = t$
  85.     LOCATE 17, 7: PRINT Buffer$
  86.     CALL ColorIt(15, 1)
  87.     text$ = " TYPE: a FILE NAME, Legal -or- illegal "
  88.     Message$ = SPACE$(LEN(text$))
  89.     CALL TextBoxShadow(7, 0, Message$, 5, 0, 0)
  90.  
  91.  
  92.     CALL LocateIt(7, text$)
  93.  
  94.     CALL ColorIt(11, 0)
  95.     text$ = SPACE$(13)
  96.     CALL LocateIt(8, text$)
  97.     LOCATE 8, Center%(text$)
  98.     CursorOn
  99.  
  100.     InSpec$ = BufferedKeyInput(13)
  101.     CursorOff
  102.     CALL ColorIt(15, 1)
  103.         OutSpec$ = NameTrue$(InSpec$)
  104.     IF LEN(OutSpec$) THEN
  105.         Message$ = "A legal Name: " + OutSpec$
  106.         CALL TextBoxShadow(12, 0, Message$, 5, 1, 0)
  107.         CALL ColorIt(15, 7)
  108.         Message$ = "PRESS a Key to Try another Name or <Esc> to EXIT"
  109.         CALL TextBoxShadow(18, 0, Message$, 3, 0, 0)
  110.         WaitKey
  111.         GOTO Again
  112.     END IF
  113.         CALL ColorIt(11, 0)
  114.         Message$ = "PRESS a Key to Try another Name or <Esc> to EXIT"
  115.         CALL TextBoxShadow(14, 0, Message$, 6, 0, 0)
  116.     WaitKey
  117. GOTO Again
  118.  
  119. DEFINT A-Z
  120. FUNCTION BufferedKeyInput$ (n%) STATIC
  121.  
  122.      'DIM Regs AS RegType
  123.      b$ = CHR$(n% + 1) + SPACE$(n% + 1) + CHR$(13)   'see EXPLANATION
  124.  
  125.      Regs.ax = &HA00                     'BufferkeyInput MS-DOS Function
  126.      Regs.ds = VARSEG(b$)                'segment of string b$
  127.      Regs.dx = SADD(b$)                  'offset of string b$
  128.      'using qb.bi INCLUDE file
  129.      CALL INTERRUPTX(&H21, Regs, Regs)
  130.      count% = ASC(MID$(b$, 2, 1))        'length of the string b$
  131.  
  132.      'EXPLANATION of b$ command
  133.      'byte one of b$ contains the working -size- of the string.
  134.      'byte two is the -actual size- of the string that MS-DOS uses.
  135.      'last byte is a carriage return which is needed to prevent
  136.      'a STRING SPACE CORRUPT Run Time error when you use this
  137.      'so the return string starts at byte three (3), and does NOT
  138.      'include the carriage return
  139.      'see below
  140.      BufferedKeyInput$ = MID$(b$, 3, count%)
  141.  
  142. END FUNCTION
  143.  
  144. FUNCTION Center% (text$)
  145.     Center% = 41 - LEN(text$) \ 2
  146. END FUNCTION
  147.  
  148. SUB ColorIt (Fgd, Bkg)
  149.     COLOR Fgd, Bkg
  150. END SUB
  151.  
  152. SUB CursorOff
  153.     LOCATE , , 0
  154. END SUB
  155.  
  156. SUB CursorOn
  157.     LOCATE , , 1, 4, 7
  158. END SUB
  159.  
  160. SUB ErrorHandler (ErrorCode%)
  161.  
  162.     'This will trap all INTERRUPT &H21 error codes placed in AX
  163.     'for FUNCTION &H5A and &H3E
  164.     'Well... actually -all- INTERRUPT &H21 Functions use these error codes
  165.     'as defined and trapped in the MakeTempFile SUB
  166.     '
  167.     CALL GetColr(Fgd%, Bkg%, Colr%)      'saves the screen color
  168.   
  169.     SELECT CASE ErrorCode%
  170.    
  171.         CASE 0
  172.             text$ = "No ERROR FOUND: " + LTRIM$(STR$(ErrorCode%))
  173.         CASE 2
  174.             text$ = "ILLEGAL NAME!!! ERROR # " + LTRIM$(STR$(ErrorCode%))
  175.         CASE 3
  176.             text$ = "PATH Not FOUND! ERROR # " + LTRIM$(STR$(ErrorCode%))
  177.         CASE 4
  178.             text$ = "Too Many Open Files! ERROR # " + LTRIM$(STR$(ErrorCode%))
  179.         CASE 5
  180.             text$ = "Access Denied, Read only File! ERROR # " + LTRIM$(STR$(ErrorCode%))
  181.         CASE 1, 6 TO 18
  182.             'are defined, but easier to look up in a book,
  183.             'page 418, Norton's 1993 PC Programmer's Bible...
  184.             text$ = "Weird Error, Write it Down! ERROR # " + LTRIM$(STR$(ErrorCode%))
  185.         CASE ELSE
  186.             text$ = "Undefined Error, Write it Down, ERROR # " + LTRIM$(STR$(ErrorCode%))
  187.     END SELECT
  188.  
  189.         IF ErrorCode% > 0 THEN BEEP
  190.  
  191.        COLOR 14, 4
  192.        CALL TextBoxShadow(20, 0, text$, 1, 1, 0)
  193.        COLOR Fgd%, Bkg%
  194. END SUB
  195.  
  196. SUB GetColr (Fgd%, Bkg%, Colr%) STATIC
  197.  
  198.     Colr% = SCREEN(1, 1, 1)
  199.  
  200.     Fgd% = (Colr% AND 128) \ 8 + (Colr% AND 15)
  201.     Bkg% = (Colr% AND 112) \ 16
  202.  
  203. END SUB
  204.  
  205. SUB LocateIt (Row%, text$)
  206.      LOCATE Row%, Center(text$)
  207.      PRINT text$;
  208. END SUB
  209.  
  210. FUNCTION NameTrue$ (InSpec$)
  211.    
  212.     'DIM Regs AS RegType
  213.     DIM InString AS STRING * 128
  214.     DIM OutString AS STRING * 128
  215.  
  216.    
  217.    
  218.         InValid$ = " \/?*"                   'TRUENAME gets the rest, except..
  219.     Length% = LEN(InValid$)
  220.     FOR i = 1 TO Length%
  221.         IF INSTR(InSpec$, MID$(InValid$, i, 1)) THEN
  222.             ErrorCode% = 2
  223.             CALL ErrorHandler(ErrorCode%)
  224.             EXIT FUNCTION
  225.         END IF
  226.     NEXT
  227.     Dots$ = ".."                        'the one and two beginning dots
  228.     FOR i = 1 TO 2
  229.         IF INSTR(MID$(Dots$, 1, i), InSpec$) THEN
  230.             ErrorCode% = 2
  231.             CALL ErrorHandler(ErrorCode%)
  232.             EXIT FUNCTION
  233.         END IF
  234.     NEXT
  235.  
  236.     InString = InSpec$ + CHR$(0)  ' make an ASCIIZ version of input spec
  237.     Regs.ax = &H6000            ' invoke the TRUENAME DOS function
  238.     Regs.si = VARPTR(InString)
  239.     Regs.di = VARPTR(OutString)
  240.     CALL INTERRUPT(&H21, Regs, Regs)
  241.    
  242.     'Check for DOS error, if so, return no name
  243.     IF Regs.flags AND 1 THEN
  244.        
  245.         ErrorCode% = Regs.ax           'Error Code in AX
  246.         IF ErrorCode% THEN CALL ErrorHandler(ErrorCode%)
  247.         EXIT FUNCTION
  248.     ELSE
  249.                 NameTrue$ = MID$(OutString, 1, INSTR(OutString, CHR$(0)) - 1)
  250.     END IF
  251. END FUNCTION
  252.  
  253. SUB SetBorder (ColrByte%) STATIC
  254.  
  255.     'DIM Regs AS RegType
  256.     Regs.ax = &H1001
  257.     Regs.bx = ColrByte% * &H100
  258.     CALL INTERRUPT(&H10, Regs, Regs)
  259.  
  260. END SUB
  261.  
  262. SUB Splash (BackGround%) STATIC
  263.     STATIC ColrFlag%
  264.     RANDOMIZE TIMER
  265.     IF ColrFlag% AND BackGround% THEN
  266.         UpperBound = 254
  267.         LowerBound = 176
  268.         Char = INT((UpperBound - LowerBound + 1) * RND + LowerBound)
  269.     ELSEIF BackGround% THEN
  270.         Char = BackGround%
  271.     ELSE
  272.         Char = 176
  273.     END IF
  274.     CLS
  275.     FOR i = 1 TO 25
  276.         LOCATE i, 1
  277.         PRINT STRING$(80, Char);
  278.     NEXT
  279.     ColrFlag% = True
  280. END SUB
  281.  
  282. SUB TextBoxShadow (Row%, Col%, Message$, Outline%, Shadow%, Length%)
  283.     'Will put a message into a three line box -or-
  284.     'draw a box without a message using Message$=SPACE$(x)
  285.     'where "x" is the width of the box and Length%= number of lines > 3
  286.     'Boxes are centered if Col% = 0; else left side of box = Col%.
  287.     'Boxes display a true shadow if Shadow% <> 0
  288.     'True = -1: False = 0
  289.  
  290.     STATIC BoxReadFlag
  291.     Message$ = LEFT$(Message$, 60)
  292.     BoxWidth% = LEN(Message$) + 4
  293.     SELECT CASE Outline%
  294.         CASE 0
  295.             j = 8 * 6 + 1
  296.         CASE 1
  297.             j = 1
  298.         CASE 2
  299.             j = 8 + 1
  300.         CASE 3
  301.             j = 8 * 2 + 1
  302.         CASE 4
  303.             j = 8 * 3 + 1
  304.         CASE 5
  305.             j = 8 * 4 + 1
  306.         CASE 6
  307.             j = 8 * 5 + 1
  308.         CASE ELSE
  309.             j = 8 * 6 + 1
  310.     END SELECT
  311.  
  312.     IF BoxReadFlag THEN GOTO Skip
  313.     REDIM Box$(1 TO 56)
  314.     BoxReadFlag = True
  315.  
  316. 'single line box
  317.     Box$(1) = "┌"
  318.     Box$(2) = "─"
  319.     Box$(3) = "┐"
  320.     Box$(4) = "│"
  321.     Box$(5) = "│"
  322.     Box$(6) = "└"
  323.     Box$(7) = "─"
  324.     Box$(8) = "┘"
  325.  
  326. 'double top box
  327.     Box$(9) = "╒"
  328.     Box$(10) = "═"
  329.     Box$(11) = "╕"
  330.     Box$(12) = "│"
  331.     Box$(13) = "│"
  332.     Box$(14) = "╘"
  333.     Box$(15) = "═"
  334.     Box$(16) = "╛"
  335.  
  336. 'double side box
  337.     Box$(17) = "╓"
  338.     Box$(18) = "─"
  339.     Box$(19) = "╖"
  340.     Box$(20) = "║"
  341.     Box$(21) = "║"
  342.     Box$(22) = "╙"
  343.     Box$(23) = "─"
  344.     Box$(24) = "╜"
  345.  
  346. 'double box
  347.     Box$(25) = "╔"
  348.     Box$(26) = "═"
  349.     Box$(27) = "╗"
  350.     Box$(28) = "║"
  351.     Box$(29) = "║"
  352.     Box$(30) = "╚"
  353.     Box$(31) = "═"
  354.     Box$(32) = "╝"
  355.  
  356. 'bold box
  357.     Box$(33) = "█"
  358.     Box$(34) = "▀"
  359.     Box$(35) = "█"
  360.     Box$(36) = "█"
  361.     Box$(37) = "█"
  362.     Box$(38) = "█"
  363.     Box$(39) = "▄"
  364.     Box$(40) = "█"
  365.  
  366. 'bold and thick box
  367.     Box$(41) = "█"
  368.     Box$(42) = "█"
  369.     Box$(43) = "█"
  370.     Box$(44) = "█"
  371.     Box$(45) = "█"
  372.     Box$(46) = "█"
  373.     Box$(47) = "█"
  374.     Box$(48) = "█"
  375.  
  376. 'no box
  377.     Box$(49) = " "
  378.     Box$(50) = " "
  379.     Box$(51) = " "
  380.     Box$(52) = " "
  381.     Box$(53) = " "
  382.     Box$(54) = " "
  383.     Box$(55) = " "
  384.     Box$(56) = " "
  385.  
  386. Skip:
  387.  
  388.     IF Col% = 0 THEN
  389.  
  390.             BoxText$ = Box$(j) + STRING$(BoxWidth%, Box$(j + 1)) + Box$(j + 2)
  391.             CALL LocateIt(Row%, BoxText$)
  392.             Row2% = CSRLIN: Col2% = POS(0)
  393.             Colr% = SCREEN(Row2%, Col2% - 1, 1)
  394.             CALL TwoColrs(Fgd%, Bkg%, Colr%)
  395.    
  396.             FOR i = 1 TO Length% + 1
  397.             BoxText$ = Box$(j + 3) + "  " + Message$ + "  " + Box$(j + 4)
  398.             CALL LocateIt(Row% + i, BoxText$)
  399.  
  400.             IF Shadow% THEN
  401.                 COLOR 7, 0
  402.                     FOR k = 1 TO 2
  403.                         PRINT CHR$(SCREEN(CSRLIN, POS(0)));
  404.                     NEXT
  405.                 COLOR Fgd%, Bkg%
  406.             END IF
  407.             NEXT i
  408.  
  409.             BoxText$ = Box$(j + 5) + STRING$(BoxWidth%, Box$(j + 6)) + Box$(j + 7)
  410.             CALL LocateIt(Row% + i, BoxText$)
  411.      
  412.             IF Shadow% THEN
  413.                 COLOR 7, 0
  414.                 FOR k = 1 TO 2
  415.                     PRINT CHR$(SCREEN(CSRLIN, POS(0)));
  416.                 NEXT
  417.             'COLOR Fgd%, Bkg%
  418.    
  419.             COLOR 7, 0
  420.             LOCATE Row% + i + 1, Center(BoxText$) + 2
  421.      
  422.                 FOR k = 1 TO BoxWidth% + 2
  423.                     PRINT CHR$(SCREEN(CSRLIN, POS(0)));
  424.                 NEXT
  425.                 COLOR Fgd%, Bkg%
  426.             END IF
  427.     ELSE
  428.  
  429.             BoxText$ = Box$(j) + STRING$(BoxWidth%, Box$(j + 1)) + Box$(j + 2)
  430.             LOCATE Row%, Col%
  431.             PRINT BoxText$;
  432.             Row2% = CSRLIN: Col2% = POS(0)
  433.             Colr% = SCREEN(Row2%, Col2% - 1, 1)
  434.             CALL TwoColrs(Fgd%, Bkg%, Colr%)
  435.  
  436.             FOR i = 1 TO Length% + 1
  437.             BoxText$ = Box$(j + 3) + "  " + Message$ + "  " + Box$(j + 4)
  438.             LOCATE Row% + i, Col%
  439.             PRINT BoxText$;
  440.      
  441.             IF Shadow% THEN
  442.                 COLOR 7, 0
  443.                 FOR k = 1 TO 2
  444.                     PRINT CHR$(SCREEN(CSRLIN, POS(0)));
  445.                 NEXT
  446.                 COLOR Fgd%, Bkg%
  447.             END IF
  448.      
  449.             NEXT i
  450.  
  451.             BoxText$ = Box$(j + 5) + STRING$(BoxWidth%, Box$(j + 6)) + Box$(j + 7)
  452.             LOCATE Row% + i, Col%
  453.             PRINT BoxText$;
  454.      
  455.             IF Shadow% THEN
  456.                 COLOR 7, 0
  457.                 FOR k = 1 TO 2
  458.                     PRINT CHR$(SCREEN(CSRLIN, POS(0)));
  459.                 NEXT
  460.             'COLOR Fgd%, Bkg%
  461.             'COLOR 7,0
  462.                 LOCATE Row% + i + 1, Col% + 2
  463.                 FOR k = 1 TO BoxWidth% + 2
  464.                     PRINT CHR$(SCREEN(CSRLIN, POS(0)));
  465.                 NEXT
  466.                 COLOR Fgd%, Bkg%
  467.             END IF
  468.  
  469.     END IF
  470.  
  471. END SUB
  472.  
  473. SUB TwoColrs (Fgd%, Bkg%, Colr%)
  474.  
  475.     Fgd% = (Colr% AND 128) \ 8 + (Colr% AND 15)
  476.     Bkg% = (Colr% AND 112) \ 16
  477.  
  478. END SUB
  479.  
  480. SUB WaitKey
  481.  
  482.     WHILE INKEY$ <> "": WEND
  483.     DO
  484.         kee$ = INKEY$
  485.     LOOP UNTIL LEN(kee$)
  486.         IF kee$ = CHR$(27) THEN
  487.           CALL SetBorder(0)
  488.           END
  489.         END IF
  490. END SUB
  491.  
  492.