cinifile.bas

来自「用于ERP系统和PLC控制器之间的数据交互」· BAS 代码 · 共 65 行

Attribute VB_Name = "CIniFile"
Private Declare Function GetPrivateProfileInt Lib "kernel32" Alias "GetPrivateProfileIntA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Long, ByVal lpFileName As String) As Long
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long

Private IniFileName As String
Public ErrorMsg As String

Private Sub Class_Initialize()
  IniFileName = vbNullString
  ErrorMsg = vbNullString
End Sub

Public Sub SpecifyIni(FilePathName)
  IniFileName = Trim(FilePathName)
End Sub

Private Function NoIniFile() As Boolean
  NoIniFile = True
  If IniFileName = vbNullString Then
    ErrorMsg = "没有指定 INI 文件"
    Exit Function
  End If
  ErrorMsg = vbNullString
  NoIniFile = False
End Function

Public Function WriteString(Section As String, key As String, Value As String) As Boolean
  WriteString = False
  If NoIniFile() Then
  Exit Function
  End If
  If WritePrivateProfileString(Section, key, Value, IniFileName) = 0 Then
  ErrorMsg = "写入失败"
  Exit Function
  End If
  WriteString = True
End Function

Public Function ReadString(Section As String, key As String, Size As Long) As String
  Dim ReturnStr As String
  Dim ReturnLng As Long
  ReadString = vbNullString
  If NoIniFile() Then
  Exit Function
  End If
  ReturnStr = Space(Size)
  ReturnLng = GetPrivateProfileString(Section, key, vbNullString, ReturnStr, Size, IniFileName)
  ReadString = Left(ReturnStr, ReturnLng)
End Function

Public Function ReadInt(Section As String, key As String) As Long
  Dim ReturnLng As Long
  ReadInt = 0
  ReturnLng = GetPrivateProfileInt(Section, key, 0, IniFileName)
  If ReturnLng = 0 Then
  ReturnLng = GetPrivateProfileInt(Section, key, 1, IniFileName)
  If ReturnLng = 1 Then
  ErrorMsg = "不能读取"
  Exit Function
  End If
  End If
  ReadInt = ReturnLng
End Function