home *** CD-ROM | disk | FTP | other *** search
/ Master 95 #1 / MASTER95_1.iso / microsof / vbasic4 / vb4-6.cab / fileproc.bas < prev    next >
Encoding:
BASIC Source File  |  1995-07-26  |  4.3 KB  |  122 lines
  1. Attribute VB_Name = "Module2"
  2. Option Explicit
  3.  
  4. Public Const conNumBoxes = 5
  5. Public Const conSaveFile = 1, conLoadFile = 2
  6. Public Const conReplaceFile = 1, conReadFile = 2, conAddToFile = 3
  7. Public Const conRandomFile = 4, conBinaryFile = 5
  8.  
  9. Public Const errDeviceUnavailable = 68
  10. Public Const errDiskNotReady = 71, errFileAlreadyExists = 58
  11. Public Const errTooManyFiles = 67, errRenameAcrossDisks = 74
  12. Public Const errPathFileAccessError = 75, errDeviceIO = 57
  13. Public Const errDiskFull = 61, errBadFileName = 64
  14. Public Const errBadFileNameOrNumber = 52, errFileNotFound = 53
  15. Public Const errPathDoesNotExist = 76, errBadFileMode = 54
  16. Public Const errFileAlreadyOpen = 55, errInputPastEndOfFile = 62
  17.  
  18. Function FileErrors(errVal As Integer) As Integer
  19. Dim MsgType As Integer
  20. Dim Response As Integer
  21. Dim Action As Integer
  22. Dim Msg As String
  23. MsgType = vbExclamation
  24. Select Case errVal
  25.     Case errDeviceUnavailable                       ' Error #68
  26.         Msg = "That device appears to be unavailable."
  27.         MsgType = vbExclamation + 5
  28.     Case errDiskNotReady                            ' Error #71
  29.         Msg = "The disk is not ready."
  30.     Case errDeviceIO
  31.         Msg = "The disk is full."
  32.     Case errBadFileName, errBadFileNameOrNumber     ' Errors #64 & 52
  33.         Msg = "That filename is illegal."
  34.     Case errPathDoesNotExist                        ' Error #76
  35.         Msg = "That path doesn't exist."
  36.     Case errBadFileMode                             ' Error #54
  37.         Msg = "Can't open your file for that type of access."
  38.     Case errFileAlreadyOpen                         ' Error #55
  39.         Msg = "That file is already open."
  40.     Case errInputPastEndOfFile                      ' Error #62
  41.     Msg = "This file has a nonstandard end-of-file marker,"
  42.     Msg = Msg + "or an attempt was made to read beyond "
  43.     Msg = Msg + "the end-of-file marker."
  44.     Case Else
  45.         FileErrors = 3
  46.         Exit Function
  47.     End Select
  48.     Response = MsgBox(Msg, MsgType, "File Error")
  49.     Select Case Response
  50.         Case 4          ' Retry button.
  51.             FileErrors = 0
  52.         Case 5          ' Ignore button.
  53.             FileErrors = 1
  54.         Case 1, 2, 3    ' OK and Cancel buttons.
  55.             FileErrors = 2
  56.         Case Else
  57.             FileErrors = 3
  58.     End Select
  59. End Function
  60.  
  61. Function FileOpener(NewFileName As String, Mode As Integer, RecordLen As Integer, Confirm As Integer) As Integer
  62.      Dim NewFileNum As Integer
  63.      Dim Action As Integer
  64.      Dim FileExists As Integer
  65.      Dim Msg As String
  66.      On Error GoTo OpenerError
  67.      If NewFileName Like "*[;-?[* ]*" Or NewFileName Like "*]*" Then Error errBadFileName
  68.      If Confirm Then
  69.         If Dir(NewFileName) = "" Then
  70.             FileExists = False
  71.         Else
  72.             FileExists = True
  73.         End If
  74.         If Mode = conReplaceFile And FileExists Then
  75.             Msg = "Replace contents of " + NewFileName + "?"
  76.             If MsgBox(Msg, 49, "Replace File?") = 2 Then
  77.                 FileOpener = 0
  78.                 Exit Function
  79.             End If
  80.         End If
  81.         If Not FileExists Then
  82.             Msg = "The file " + NewFileName + " does not exist. "
  83.             Msg = Msg + "Do you want to create it?"
  84.             If MsgBox(Msg, 1, "Create File?") = 2 Then
  85.                 FileOpener = 0
  86.                 Exit Function
  87.             End If
  88.         End If
  89.      End If
  90.      NewFileNum = FreeFile
  91.      Select Case Mode
  92.           Case conReplaceFile
  93.             Open NewFileName For Output As NewFileNum
  94.           Case conReadFile
  95.             Open NewFileName For Input As NewFileNum
  96.           Case conAddToFile
  97.             Open NewFileName For Append As NewFileNum
  98.           Case conRandomFile
  99.             Open NewFileName For Random As NewFileNum Len = RecordLen
  100.           Case conBinaryFile
  101.             Open NewFileName For Binary As NewFileNum
  102.           Case Else
  103.             Exit Function
  104.      End Select
  105.      FileOpener = NewFileNum
  106. Exit Function
  107. OpenerError:
  108.      Action = FileErrors(Err)
  109.      Select Case Action
  110.         Case 0
  111.             Resume
  112.         Case Else
  113.             FileOpener = 0
  114.             Exit Function
  115.      End Select
  116. End Function
  117.  
  118. Function GetFileName(Prompt As String) As String
  119.     GetFileName = LTrim(RTrim(UCase(InputBox(Prompt, "Enter File Name"))))
  120. End Function
  121.  
  122.