PC Plus SuperCD (UK) 1995 October/SUPERCD.BIN/PCPLUS/VBWK/VBSPY/FILEIO.BAS

BASIC Source File | 1994-12-04 | 5.7 KB | 149 lines

Option Explicit
DefInt A-Z
'---This is a general module for file IO and INI functions
Declare Function writeprivateprofilestring% Lib "kernel" (ByVal lpAppName$, ByVal lpKeyName$, ByVal lpString$, ByVal lpFileName$)
Declare Function GetPrivateProfileString Lib "Kernel" (ByVal AppName As String, ByVal KeyName As String, ByVal Default As String, ByVal ReturnedString As String, ByVal MaxSize, ByVal FileName As String)
Declare Function GetPrivateProfileInt Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Integer, ByVal lpFileName As String) As Integer

Function FileErrors (errVal As Integer) As Integer
'---This covers the most common file IO errors.
'---It also has a option for sweadish messages
' Return Value  Meaning             Return Value    Meaning
' 0             Resume              2               Unrecoverable error
' 1             Resume Next         3               Unrecognized error
Dim MsgType As Integer
Dim Response As Integer
Dim Action As Integer
Dim msg As String
Dim smsg As String

Const Err_DeviceUnavailable = 68
Const Err_DiskNotReady = 71, Err_FileAlreadyExists = 58
Const Err_TooManyFiles = 67, Err_RenameAcrossDisks = 74
Const Err_Path_FileAccessError = 75, Err_DeviceIO = 57
Const Err_DiskFull = 61, Err_BadFileName = 64
Const Err_BadFileNameOrNumber = 52, Err_FileNotFound = 53
Const Err_PathDoesNotExist = 76, Err_BadFileMode = 54
Const Err_FileAlreadyOpen = 55, Err_InputPastEndOfFile = 62
Const MB_EXCLAIM = 48, MB_STOP = 16

MsgType = MB_EXCLAIM
Select Case errVal
    Case Err_DeviceUnavailable  ' Error #68
        msg = "That device appears to be unavailable."
        smsg = "Kan inte lΣsa frσn denna enhet"
        MsgType = MB_EXCLAIM + 5
    Case Err_DiskNotReady       ' Error #71
        msg = "The disk is not ready."
        smsg = "Disken Σr inte fΣrdig att anvΣnda."
    Case Err_DeviceIO
        msg = "The disk is full."
        smsg = "Disken Σr full."
    Case Err_BadFileName, Err_BadFileNameOrNumber   ' Errors #64 & 52
        msg = "That file name is illegal."
        smsg = "Ogiltigt filnamn"
    Case Err_PathDoesNotExist                        ' Error #76
        msg = "That path doesn't exist."
        smsg = "S÷kvΣgen finns inte."
    Case Err_BadFileMode                            ' Error #54
        msg = "Can't open your file for that type of access."
        smsg = "Kan inte ÷ppna filen f÷r denna typ av access"
    Case Err_FileAlreadyOpen                        ' Error #55
        msg = "That file is already open."
        smsg = "Denna fil Σr redan ÷ppnen."
    Case Err_InputPastEndOfFile                     ' Error #62
          msg = "This file has a nonstandard end-of-file marker,"
          msg = msg + "or an attempt was made to read beyond "
          msg = msg + "the end-of-file marker. This is NOT a text file."
          smsg = "Denna fil har en icke standard end-of-file tecken,"
          smsg = smsg + "eller ett f÷rs÷k gjordes att lΣsa f÷rbi"
          smsg = smsg + "end-off-file tecknet"
    '---Common dialog canecelbutton
    Case CDERR_CANCEL
          FileErrors = 3
          Exit Function
    Case Else
           FileErrors = 3
           msg = "Unknown file I/O error"
           smsg = "OkΣnt fil I/O fel"
           Exit Function
    End Select
    Response = MsgBox(msg, MsgType, "File error")
    Select Case Response
        Case 4          ' Retry button.
            FileErrors = 0
        Case 5          ' Ignore button.
            FileErrors = 1
        Case 1, 2, 3    ' Ok and Cancel buttons.
            FileErrors = 2
        Case Else
            FileErrors = 3
    End Select
End Function

Sub ReadFromIni_Window_Pos (Frm As Form)
'---Reading window positions
'---Taking the argument Frm for general use
Frm.WindowState = ReadIni_Int("WindowState", 0)
If Frm.WindowState = NORMAL Then
   Frm.Left = ReadIni_Int("left", 1)
   Frm.Top = ReadIni_Int("top", 1)
   Frm.Width = ReadIni_Int("width", screen.Width \ 2)
   Frm.Height = ReadIni_Int("height", screen.Height \ 2)
End If
End Sub

Function ReadIni (KeyName$, Default$) As String
'---Reading ini files (strings)
'---Just to avoid the "mastodont" API call notation
'---RETURN: String (Answer$) or Default$
Dim AppName$, FileName$, length%, Answer$, Size%

'---Change this according to Your application----------------
AppName$ = "VB SPY 1.0"
FileName$ = app.Path & "\vbspy.ini"
'------------------------------------------------------------
Answer$ = Space$(250)
Size% = Len(Answer$)

length% = GetPrivateProfileString(AppName$, KeyName$, Trim(Default$), Answer$, Size%, FileName$)
ReadIni = Left$(Answer$, length%)
End Function

Function ReadIni_Int (KeyName$, Default%) As Integer
'---Reading INI file (Integers)
Dim AppName$, FileName$
'-----------------------------------
AppName$ = "VB SPY 1.0"
FileName$ = app.Path & "\vbspy.ini"
'------------------------------------
ReadIni_Int = GetPrivateProfileInt(AppName$, KeyName$, Default%, FileName$)
End Function

Sub writeIni (KeyName$, Param$)
'---Writing to the INI file
Dim success, AppName$, FileName$
'--------------------------------------
AppName$ = "VB SPY 1.0"
FileName$ = app.Path & "\vbspy.ini"
'--------------------------------------
success = writeprivateprofilestring(AppName$, KeyName$, Param$, FileName$)
End Sub

Sub writeToIni_Window_pos (Frm As Form)
'---29.10.94
'
'---Window positions & state
If Frm.WindowState = MINIMIZED Then
   Frm.WindowState = NORMAL
End If
writeIni "WindowState", Str$(Frm.WindowState)
If Frm.WindowState = NORMAL Then
   writeIni "left", Str$(Frm.Left)
   writeIni "top", Str$(Frm.Top)
   writeIni "width", Str$(Frm.Width)
   writeIni "height", Str$(Frm.Height)
End If
End Sub