inirw.bas

KTV管理系统,实现了基本的日常操作.程序有不完善之处,请自修升级修改.

Attribute VB_Name = "ReadWrite"

Option Explicit

Declare Function GetPrivateProfileStringByKeyName& Lib "kernel32" Alias _
    "GetPrivateProfileStringA" (ByVal lpApplicationName$, ByVal lpszKey$, ByVal lpszDefault$, ByVal lpszReturnBuffer$, ByVal cchReturnBuffer&, ByVal lpszFile$)
Declare Function GetPrivateProfileStringKeys& Lib "kernel32" Alias _
    "GetPrivateProfileStringA" (ByVal lpApplicationName$, ByVal lpszKey&, ByVal lpszDefault$, ByVal lpszReturnBuffer$, ByVal cchReturnBuffer&, ByVal lpszFile$)
Declare Function GetPrivateProfileStringSections& Lib "kernel32" Alias _
    "GetPrivateProfileStringA" (ByVal lpApplicationName&, ByVal lpszKey&, ByVal lpszDefault$, ByVal lpszReturnBuffer$, ByVal cchReturnBuffer&, ByVal lpszFile$)
Declare Function WritePrivateProfileStringByKeyName& Lib "kernel32" Alias _
    "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lplFileName As String)
Declare Function WritePrivateProfileStringToDeleteKey& Lib "kernel32" Alias _
    "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As Long, ByVal lplFileName As String)

Public strMySystemFile As String
Public strSection As String
Public Const BUFF_SIZ As Long = 9160
Public Const READ_BUFF As Long = 255
'**********
Public strLoginName As String
Public strPassword As String
Public strColor As String
Public lngColor As Long
Public lngRetVal As Long

Function WriteToFile(strFileSection As String, strKey As String, strValue As String) As Long

    If Len(strKey) > READ_BUFF Or Len(strValue) > READ_BUFF Then
        MsgBox "Can't write more than " & READ_BUFF & " characters for key or value."
        WriteToFile = -1
        Exit Function
    End If
    WriteToFile = WritePrivateProfileStringByKeyName(strFileSection, strKey, strValue, strMySystemFile)
End Function

Function ReadFromFile(strFileSection As String, strKey As String) As String

    Dim strValue As String
    Dim lngRetLen As Long
    
    strValue = String(READ_BUFF + 1, Space(1))
    lngRetLen = GetPrivateProfileStringByKeyName(strFileSection, strKey, "", strValue, READ_BUFF, strMySystemFile)
    If lngRetLen > 0 Then
        ReadFromFile = Left(strValue, lngRetLen)
    Else
        ReadFromFile = "0"
    End If
End Function

Function DeleteFromFile(strFileSection As String, strKey As String) As Long

    If Len(strFileSection) = 0 Or Len(strKey) = 0 Then
        MsgBox "Null string parameter not allowed for DeleteFromFile."
        DeleteFromFile = -1
        Exit Function
    End If
    DeleteFromFile = WritePrivateProfileStringToDeleteKey(strFileSection, strKey, 0, strMySystemFile)
End Function