ciniopeartion.cls

设置IP地址工具

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CINIOpeartion"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

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 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 Const MAXLEN As Integer = 255
Private Const z As Integer = 0

Private pIniFileName As String
Private pSection As String

Public Sub WindowPositionRead(ByRef F As Form, Optional ByVal bResize As Boolean = True)
  Dim sSection As String
  sSection = F.Name
  
  On Error Resume Next
  F.Left = ReadInt(sSection, "X", F.Left)
  F.Top = ReadInt(sSection, "Y", F.Top)
  
  
  If bResize = True Then
    bResize = (F.BorderStyle = 2) Or (F.BorderStyle = 5)
  End If
  
  If bResize Then
    F.Width = ReadInt(sSection, "W", F.Width)
    F.Height = ReadInt(sSection, "H", F.Height)
  End If
  
  F.WindowState = ReadInt(sSection, "WindowState", vbNormal)
  
  
  If F.Left <= 0 Then F.Left = (Screen.Width - F.Width) / 2
  If F.Top <= 0 Then F.Top = (Screen.Height - F.Height) / 2
  
End Sub

Public Sub WindowPositionSave(ByRef F As Form)
  Dim sSection As String
  sSection = F.Name
  
  On Error Resume Next
  
  If F.WindowState = vbNormal Then
    WriteString sSection, "X", F.Left
    WriteString sSection, "Y", F.Top
    WriteString sSection, "W", F.Width
    WriteString sSection, "H", F.Height
  End If
  WriteString sSection, "WindowState", F.WindowState
  
  
End Sub



Public Function ReadSection(IniFile As String, sSectionName As String, ByRef sKey() As String, ByRef iCount As Long) As Boolean
Dim sSection As String
Dim iPos As Long
Dim iNextPos As Long
Dim sCur As String
    
    
    Dim sBuf As String
    Dim iSize As String
    Dim iRetCode As Integer
    Dim sDefault As String
    Dim sPath As String
    sPath = IniFile
    sBuf = Space$(8192)
    iSize = Len(sBuf)
    iRetCode = GetPrivateProfileString(sSectionName, 0&, sDefault, sBuf, iSize, sPath)
    If (iSize > 0) Then
        sSection = Left$(sBuf, iRetCode)
    Else
        sSection = ""
    End If
    
    iCount = 0
    Erase sKey
    If (Len(sSection) > 0) Then
        iPos = 1
        iNextPos = InStr(iPos, sSection, Chr$(0))
        Do While iNextPos <> 0
            sCur = Mid$(sSection, iPos, (iNextPos - iPos))
            If (sCur <> Chr$(0)) Then
                iCount = iCount + 1
                ReDim Preserve sKey(1 To iCount) As String
                sKey(iCount) = Mid$(sSection, iPos, (iNextPos - iPos))
                iPos = iNextPos + 1
                iNextPos = InStr(iPos, sSection, Chr$(0))
            End If
        Loop
    End If
    
    
    
End Function
Public Property Let FileName(ByVal Value As String)
    Dim FileNum%
    Const sDot = "."
    Const sBackslash = "\"
    Const sExtension = ".ini"
    
    pIniFileName = Value
    If InStr(pIniFileName, sDot) = z Then pIniFileName = pIniFileName & sExtension
    If InStr(pIniFileName, sBackslash) = z Then pIniFileName = App.Path & sBackslash & pIniFileName
  
    If Dir(pIniFileName) = "" Then
        
        FileNum = FreeFile
        Open pIniFileName For Append As FileNum
        Close #FileNum
    End If
    
    
    
End Property

Public Property Get FileName() As String
  FileName = pIniFileName
End Property

Public Property Get Section() As String
  Section = pSection
End Property

Public Property Let Section(ByVal Value As String)
  pSection = Value
End Property

Public Function WriteString(ByVal sSection As String, ByVal sKey As String, ByVal Value As String) As Long
    WriteString = WritePrivateProfileString(sSection, sKey, Value, pIniFileName)
End Function


Public Function ReadBool(ByVal sSection As String, ByVal sKey As String, ByVal Default As Boolean) As Boolean
  Dim Value As String, lRet As Long, ReadString As String
  If sSection = "" Then Exit Function
  If sKey = "" Then Exit Function
  
  Value = String$(MAXLEN, z)
  lRet = GetPrivateProfileString(sSection, sKey, Default, Value, MAXLEN, pIniFileName)
  ReadString = Left(Value, lRet)
  
  Const sFalso = "Falso"
  Const sZero = "0"
  
  If ReadString = sFalso Or ReadString = sZero Or ReadString = "" Then
    ReadBool = False
  Else
    ReadBool = True
  End If
    
End Function





Public Function ReadInt(ByVal sSection As String, ByVal sKey As String, ByVal Default As Integer) As Integer
  Dim Value As String, lRet As Long
  If sSection = "" Then Exit Function
  If sKey = "" Then Exit Function
  
  Value = String$(MAXLEN, z)
  lRet = GetPrivateProfileString(sSection, sKey, Default, Value, MAXLEN, pIniFileName)
  
  If lRet = 0 Then
        ReadInt = Default
  Else
        ReadInt = Val(Left(Value, lRet))
  End If
  
End Function

'Public Function ReadString(ByVal sSection As String, ByVal sKey As String, ByVal Default As String) As String
'  Dim Value As String, lRet As Long
'  If sSection = "" Then Exit Function
'  If sKey = "" Then Exit Function
'
'  Value = String$(MAXLEN, z)
'  lRet = GetPrivateProfileString(sSection, sKey, Default, Value, MAXLEN, pIniFileName)
'
'  If lRet = 0 Then
'        ReadString = Default
'  Else
'       ' ReadString = Left(Value, Len(Trim(Value)) - 1)
'       ReadString = Left(Value, Len(Trim(Value)) - 1)
'  End If
'
'End Function

'获得ini文件中的值
Public Function GetIniString(strSection As String, strValue As String, strFileName As String) As String
    Dim strReturnValue As String
    Const lSize = 512
    GetIniString = ""
    On Error GoTo ErrMsg
    If Trim(strSection) = "" Or Trim(strValue) = "" Or Trim(strFileName) = "" Then Exit Function
    strReturnValue = Space(lSize)
    GetPrivateProfileString strSection, strValue, "", strReturnValue, lSize, strFileName
    strReturnValue = Left(strReturnValue, Len(Trim(strReturnValue)) - 1)
    GetIniString = Trim(strReturnValue)
    Exit Function
ErrMsg:
    MsgBox Err.Description, vbInformation, "错误信息"
End Function
Public Function DeleteKey(ByVal sSection As String, ByVal sKey As String) As Long
    Dim sIniFile As String
    sIniFile = FileName
    DeleteKey = WritePrivateProfileString(sSection, sKey, 0&, sIniFile)
    
End Function

Public Function DeleteSection(ByVal sSection As String) As Long
  Dim sFileIni As String
  sFileIni = FileName
  DeleteSection = WritePrivateProfileString(sSection, 0&, 0&, sFileIni)

End Function