home *** CD-ROM | disk | FTP | other *** search
/ Jason Aller Floppy Collection / 99.img / PDOX3-09.ZIP / TOOLKIT2 / GETFILE.SC < prev    next >
Text File  |  1989-09-15  |  5KB  |  114 lines
  1. ; Copyright (c) 1987-1989 Borland International.  All Rights Reserved.
  2. ;
  3. ; General permission to re-distribute all or part of this script is granted,
  4. ; provided that this statement, including the above copyright notice, is not
  5. ; removed.  You may add your own copyright notice to secure copyright
  6. ; protection for new matter that you add to this script, but Borland
  7. ; International will not support, nor assume any legal responsibility for,
  8. ; material added or changes made to this script.
  9. ;
  10. ; Revs.:  MJP 5/20/87, DCY 12/13/88
  11. ; ****************************************************************************
  12. ; GetFile prompts a user to enter a file name in Paradox fashion.  That is, a
  13. ; user can either enter a file name or just press [Enter] for a sub-menu of
  14. ; files in the current (or otherwise specified) directory.
  15. ;
  16. ; If a user presses [Esc], GetFile returns a null ("") string.  Otherwise, it
  17. ; returns the file name selected.
  18. ;
  19. ; GetFile requires the following arguments:
  20. ;
  21. ;    Mask: File mask of acceptable file names and files to be displayed in
  22. ;          sub-menu (e.g. "??Table.DB", "*.SC")
  23. ;   Prmpt: Prompt to appear on top prompt line (e.g., "Table:", "Script:")
  24. ;     Msg: Message to display underneath prompt line
  25. ;   FName: Default file name (or null string "" for none)
  26. ;     Rqd: (Logical) If True, requires file name to already exist
  27. ;
  28. ; NOTE:  There is no way to specify that the file cannot exist, because it
  29. ;        is not clear what to do if it does.  (Put up a "Cancel/Replace"
  30. ;        menu?  Put up a Cancel/Modify/Replace menu?  Disallow the
  31. ;        selection entirely?)
  32. ;
  33. Proc GetFile(Mask,Prmpt,Msg,FName,Rqd)
  34.    Private;Mask        ;Specifies which files to display
  35.           ;Prmpt       ;Top prompt line
  36.           ;Msg         ;Second prompt line
  37.           ;FName       ;Currently selected file name
  38.           ;Rqd         ;Determines whether file must already exist
  39.            Ext,        ;Stores the file extension of the mask
  40.            OldMask,    ;Stores the original mask, as it is subject to change
  41.            OldFName,   ;Stores current FName before destroyed by show command
  42.            AWidth,     ;Maximum width for Accept, based upon length of Prmpt
  43.            X           ;General purpose scratch variable
  44.  
  45.    X = Match(Mask,"..\".\"..",X,Ext)
  46.    Ext = "." + Upper(Ext)
  47.    OldMask = Mask
  48.    AWidth = "A"+Strval(79-Len(Prmpt))
  49.  
  50.    Style Attribute SysColor(0)
  51.    While True
  52.       Canvas Off
  53.       @ 0,0             ;Display prompt information
  54.       ?? Spaces(80)+Msg+Spaces(80-Len(Msg))
  55.       @ 0,0
  56.       ?? Prmpt+" "
  57.       Canvas On
  58.       Accept AWidth                         ;Accept the file name
  59.          Default FName
  60.       To FName
  61.       Switch
  62.          Case not Retval:                   ;Esc was pressed
  63.             Style
  64.             Return ""
  65.          Case IsBlank(FName) or DirExists(FName)=1: ;Enter was pressed
  66.             If Match(FName,"..@",X,X)               ;Is FName non-blank?
  67.                Then If X <> "\\" and X <> ":"       ;Is last character "\"?
  68.                        Then FName = FName+"\\"      ;Append backslash to
  69.                     Endif                           ; directory name
  70.                     X = Search(".",Mask)-1          ;Remove dirname from mask
  71.                     While Substr(Mask,X,1) <> "\\" and Substr(Mask,X,1) <> ":"
  72.                           and X > 0
  73.                        X = X-1
  74.                     Endwhile
  75.                     Mask = FName+Substr(Mask,X+1,255);Ignore specified
  76.             Endif                                   ; directory name since the
  77.             OldFName = FName                        ; user specified one
  78.             ShowFiles                         ;Show specified files
  79.                NoExt
  80.                Mask
  81.                Prmpt+" "+FName
  82.             To FName
  83.             If FName = "None"                 ;No files were selected by Mask
  84.                Then Message "None found"
  85.             Endif
  86.             If FName = "Esc" or FName = "None"  ;User did not select a file
  87.                Then FName = OldFName        ;Restore user-specified file name
  88.                     Mask = OldMask          ;Restore original mask value
  89.                Else Style
  90.                     Return OldFName+FName   ;Attach path name to file name
  91.             Endif
  92.          Case Rqd:                          ;File must already exist
  93.             Switch
  94.                Case DirExists(FName) = -1:  ;Assumes valid directory names
  95.                   Message "Invalid file name"  ; are valid file names
  96.                Case IsFile(FName+Ext):
  97.                   Style
  98.                   Return FName
  99.                Otherwise:
  100.                   Message FName+" does not exist"
  101.             Endswitch
  102.          Otherwise:                         ;We don't care if file name exists
  103.             If DirExists(FName) = -1        ;Make sure it's a valid name
  104.                Then Message "Invalid file name"
  105.                Else If Substr(FName,Len(FName),1) = "\\"
  106.                        Then Message FName+" does not exist"
  107.                        Else Style
  108.                             Return FName
  109.                     Endif
  110.             Endif
  111.       Endswitch
  112.    Endwhile
  113. Endproc
  114.