home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 10 / 10.iso / l / l406 / 1.ddi / FILEPROC.BA_ / FILEPROC.bin
Encoding:
Text File  |  1992-10-21  |  4.2 KB  |  129 lines
  1. Option Explicit
  2.  
  3. Global Const NUMBOXES = 5
  4. Global Const SAVEFILE = 1, LOADFILE = 2
  5. Global Const REPLACEFILE = 1, READFILE = 2, ADDTOFILE = 3
  6. Global Const RANDOMFILE = 4, BINARYFILE = 5
  7.  
  8. ' Define a data type to hold a record:
  9. ' Define global variables to hold the file number and record number
  10. ' of the current data file.
  11. ' Default file name to show in dialog boxes.
  12. Global Const Err_DeviceUnavailable = 68
  13. Global Const Err_DiskNotReady = 71, Err_FileAlreadyExists = 58
  14. Global Const Err_TooManyFiles = 67, Err_RenameAcrossDisks = 74
  15. Global Const Err_Path_FileAccessError = 75, Err_DeviceIO = 57
  16. Global Const Err_DiskFull = 61, Err_BadFileName = 64
  17. Global Const Err_BadFileNameOrNumber = 52, Err_FileNotFound = 53
  18. Global Const Err_PathDoesNotExist = 76, Err_BadFileMode = 54
  19. Global Const Err_FileAlreadyOpen = 55, Err_InputPastEndOfFile = 62
  20. Global Const MB_EXCLAIM = 48, MB_STOP = 16
  21.  
  22. Function FileErrors (errVal As Integer) As Integer
  23. ' Return Value  Meaning     Return Value    Meaning
  24. ' 0             Resume      2               Unrecoverable error
  25. ' 1             Resume Next 3               Unrecognized error
  26. Dim MsgType As Integer
  27. Dim Response As Integer
  28. Dim Action As Integer
  29. Dim Msg As String
  30. MsgType = MB_EXCLAIM
  31. Select Case errVal
  32.     Case Err_DeviceUnavailable  ' Error #68
  33.     Msg = "That device appears to be unavailable."
  34.     MsgType = MB_EXCLAIM + 5
  35.     Case Err_DiskNotReady       ' Error #71
  36.     Msg = "The disk is not ready."
  37.     Case Err_DeviceIO
  38.     Msg = "The disk is full."
  39.     Case Err_BadFileName, Err_BadFileNameOrNumber   ' Errors #64 & 52
  40.     Msg = "That file name is illegal."
  41.     Case Err_PathDoesNotExist                        ' Error #76
  42.     Msg = "That path doesn't exist."
  43.     Case Err_BadFileMode                            ' Error #54
  44.     Msg = "Can't open your file for that type of access."
  45.     Case Err_FileAlreadyOpen                        ' Error #55
  46.     Msg = "That file is already open."
  47.     Case Err_InputPastEndOfFile                     ' Error #62
  48.     Msg = "This file has a nonstandard end-of-file marker,"
  49.     Msg = Msg + "or an attempt was made to read beyond "
  50.     Msg = Msg + "the end-of-file marker."
  51.     Case Else
  52.     FileErrors = 3
  53.     Exit Function
  54.     End Select
  55.     Response = MsgBox(Msg, MsgType, "File Error")
  56.     Select Case Response
  57.     Case 4          ' Retry button.
  58.         FileErrors = 0
  59.     Case 5          ' Ignore button.
  60.         FileErrors = 1
  61.     Case 1, 2, 3    ' Ok and Cancel buttons.
  62.         FileErrors = 2
  63.     Case Else
  64.         FileErrors = 3
  65.     End Select
  66. End Function
  67.  
  68. Function FileOpener (NewFileName As String, Mode As Integer, RecordLen As Integer, Confirm As Integer) As Integer
  69.      Dim NewFileNum As Integer
  70.      Dim Action As Integer
  71.      Dim FileExists As Integer
  72.      Dim Msg As String
  73.      On Error GoTo OpenerError
  74.      If NewFileName Like "*[;-?[* ]*" Or NewFileName Like "*]*" Then Error Err_BadFileName
  75.      If Confirm Then
  76.     If Dir(NewFileName) = "" Then
  77.         FileExists = False
  78.     Else
  79.         FileExists = True
  80.     End If
  81.     If Mode = REPLACEFILE And FileExists Then
  82.         Msg = "Replace contents of " + NewFileName + "?"
  83.         If MsgBox(Msg, 49, "Replace File?") = 2 Then
  84.         FileOpener = 0
  85.         Exit Function
  86.         End If
  87.     End If
  88.     If Not FileExists Then
  89.         Msg = "The file " + NewFileName + " does not exist. "
  90.         Msg = Msg + "Do you want to create it?"
  91.         If MsgBox(Msg, 1, "Create File?") = 2 Then
  92.         FileOpener = 0
  93.         Exit Function
  94.         End If
  95.     End If
  96.      End If
  97.      NewFileNum = FreeFile
  98.      Select Case Mode
  99.       Case REPLACEFILE
  100.         Open NewFileName For Output As NewFileNum
  101.       Case READFILE
  102.         Open NewFileName For Input As NewFileNum
  103.       Case ADDTOFILE
  104.         Open NewFileName For Append As NewFileNum
  105.       Case RANDOMFILE
  106.         Open NewFileName For Random As NewFileNum Len = RecordLen
  107.       Case BINARYFILE
  108.         Open NewFileName For Binary As NewFileNum
  109.       Case Else
  110.         Exit Function
  111.      End Select
  112.      FileOpener = NewFileNum
  113. Exit Function
  114. OpenerError:
  115.      Action = FileErrors(Err)
  116.      Select Case Action
  117.     Case 0
  118.         Resume
  119.     Case Else
  120.         FileOpener = 0
  121.         Exit Function
  122.      End Select
  123. End Function
  124.  
  125. Function GetFileName (Prompt As String) As String
  126.     GetFileName = LTrim$(RTrim$(UCase$(InputBox$(Prompt, "Enter File Name"))))
  127. End Function
  128.  
  129.