Imports System.IO Public Class MyINI Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer, ByVal lpFileName As String) As Integer Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lpDownFileName As String) As Integer 'Private Aname As String Public FileName As String = vbNullString Private FileNameBuf As String Private m_sPath As String Private m_sKey As String Private m_sSection As String Private m_sDefault As String Private m_lLastReturnCode As Integer Public Sub New(ByVal File As String) FileName = File FileNameBuf = File Me.Create() 'MsgBox("New 1=" & FileName & vbCrLf & "2=" & FileNameBuf) ' If Not System.IO.File.Exists(File) Then System.IO.File.Create(File) End Sub Public Sub Create() If Exist() = True Then Return Dim A As New IO.FileInfo(FileName) A.Directory.Create() Dim FS As IO.FileStream = A.Create() Dim SW As New IO.StreamWriter(FS, System.Text.Encoding.Default) SW.WriteLine("//Myini 로부터 자동생성된 파일입니다") SW.WriteLine("//생성일자 : " & Now.ToString) SW.Flush() SW.Close() FS.Close() SW = Nothing FS = Nothing FileName = FileNameBuf End Sub Public Function Exist() As Boolean Return System.IO.File.Exists(FileName) End Function Public Function Read(ByVal appkey As String, ByVal subkey As String, Optional ByVal DefaultValue As String = vbNullString) As String '//변수초기화 'MsgBox("Read 1=" & FileName & vbCrLf & "2=" & FileNameBuf) Dim tempstr As Integer 'ini파일에서 읽어온 값을 임시저장하는 변수 Dim strtemp As String = New String(Chr(0), 2000) 'ini파일의 임시 변수 Dim Tempbuf As String If Not Exist() Then MsgBox("환경파일이 존재하지 않습니다" & vbCrLf & "APP=" & appkey & vbCrLf & "subkey=" & subkey & vbCrLf & "파일명=" & FileName, MsgBoxStyle.Critical, "Error") Return vbNullString End If Try tempstr = GetPrivateProfileString(appkey, subkey, "", strtemp, Len(strtemp), FileName) Tempbuf = strtemp.Substring(0, tempstr) Tempbuf = Tempbuf.Trim(Chr(0)) FileName = FileNameBuf If Tempbuf.Trim = vbNullString AndAlso DefaultValue <> vbNullString Then Return DefaultValue Else Return Tempbuf End If Catch ex As Exception FileName = FileNameBuf Return vbNullString End Try End Function Public Function ReadFile(ByVal appkey As String, ByVal subkey As String, ByVal filename2 As String, Optional ByVal DefaultValue As String = vbNullString) As String '//변수초기화 'MsgBox("ReadFile 1=" & FileName & vbCrLf & "2=" & FileNameBuf) Dim tempstr As Integer 'ini파일에서 읽어온 값을 임시저장하는 변수 Dim strtemp As String = New String(Chr(0), 2000) 'ini파일의 임시 변수 Dim Tempbuf As String If Not System.IO.File.Exists(filename2) Then MsgBox("환경파일이 존재하지 않습니다" & vbCrLf & "파일명=" & FileName, MsgBoxStyle.Critical, "Error") Return vbNullString End If Try tempstr = GetPrivateProfileString(appkey, subkey, "", strtemp, Len(strtemp), filename2) Tempbuf = strtemp.Substring(0, tempstr) If Tempbuf.Trim = vbNullString AndAlso DefaultValue <> vbNullString Then Return DefaultValue Else Return Tempbuf End If Catch ex As Exception Return vbNullString End Try FileName = FileNameBuf End Function Public Function Write(ByVal appkey As String, ByVal subkey As String, ByVal WriteVal As Object) As Integer Dim RetVal As Integer 'MsgBox("Write1 1=" & FileName & vbCrLf & "2=" & FileNameBuf) If Not Exist() Then MsgBox("환경파일이 존재하지 않습니다" & vbCrLf & "파일을 생성합니다." & vbCrLf & "파일명=" & FileName, MsgBoxStyle.Information, "확인") Me.Create() End If ' FileName = Aname RetVal = (WritePrivateProfileString(appkey, subkey, WriteVal, FileName)) FileName = FileNameBuf Return RetVal End Function Public Sub Write(ByVal appkey As String, ByVal subkey As String, ByVal WriteVal As Object, ByVal fileName2 As String) 'MsgBox("Write2 1=" & FileName & vbCrLf & "2=" & FileNameBuf) If Not System.IO.File.Exists(fileName2) Then MsgBox("[D] 환경파일이 존재하지 않습니다" & vbCrLf & "파일을 생성합니다." & vbCrLf & "파일명=" & fileName2, MsgBoxStyle.Information, "확인") System.IO.File.Create(fileName2) End If WritePrivateProfileString(appkey, subkey, WriteVal, fileName2) FileName = FileNameBuf End Sub Public Sub EnumerateCurrentSection(ByRef sKey() As String, ByRef iCount As Integer) Dim sSection As String Dim iPos As Integer Dim iNextPos As Integer Dim sCur As String iCount = 0 Erase sKey sSection = INISection 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 'UPGRADE_WARNING: sKey 배열의 하한이 1에서 0(으)로 변경되었습니다. 자세한 내용은 다음을 참조하십시오. 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="0F1C9BE1-AF9D-476E-83B1-17D43BECFF20"' ReDim Preserve sKey(iCount) sKey(iCount) = Mid(sSection, iPos, iNextPos - iPos) iPos = iNextPos + 1 iNextPos = InStr(iPos, sSection, Chr(0)) End If Loop End If End Sub Public Sub GetAllsection(ByVal key As String, ByRef Section As ArrayList, ByRef Value As ArrayList) Dim FS As New System.IO.FileStream(FileName, FileMode.Open) Dim SR As New StreamReader(FS, System.Text.Encoding.Default) Dim Findkey As String = "[" & key & "]" Dim Line As String Dim KeyPos As Integer = -1 Dim Seppos As Integer = -1 While SR.Peek > -1 Line = SR.ReadLine If KeyPos = -1 Then '//키를 못찻았으면 If Line.ToUpper.IndexOf(Findkey.ToUpper) > -1 Then KeyPos = Line.ToUpper.IndexOf(Findkey.ToUpper) Else '//찾앗으면 If Line.IndexOf("[") = -1 Then '//그다음 키가 오기전까지 모두 추가한다. Seppos = Line.IndexOf("=") Section.Add(Line.Substring(0, Seppos)) Value.Add(Line.Substring(Seppos + 1)) Else Exit While End If End If End While SR.Close() FS.Close() End Sub Public Sub EnumerateAllSections(ByRef sSections() As String, ByRef iCount As Integer) Dim sIniFile As String Dim iPos As Integer Dim iNextPos As Integer Dim sCur As String iCount = 0 Erase sSections sIniFile = Sections If (Len(sIniFile) > 0) Then iPos = 1 iNextPos = InStr(iPos, sIniFile, Chr(0)) Do While iNextPos <> 0 If (iNextPos <> iPos) Then sCur = Mid(sIniFile, iPos, iNextPos - iPos) iCount = iCount + 1 'UPGRADE_WARNING: sSections 배열의 하한이 1에서 0(으)로 변경되었습니다. 자세한 내용은 다음을 참조하십시오. 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="0F1C9BE1-AF9D-476E-83B1-17D43BECFF20"' ReDim Preserve sSections(iCount) sSections(iCount) = sCur End If iPos = iNextPos + 1 iNextPos = InStr(iPos, sIniFile, Chr(0)) Loop End If End Sub Property INISection() As String Get Dim sBuf As String Dim iSize As String Dim iRetCode As Short sBuf = Space(8192) iSize = CStr(Len(sBuf)) iRetCode = GetPrivateProfileString(m_sSection, 0, m_sDefault, sBuf, CInt(iSize), m_sPath) If (CDbl(iSize) > 0) Then INISection = Left(sBuf, iRetCode) Else INISection = "" End If End Get Set(ByVal Value As String) m_lLastReturnCode = WritePrivateProfileString(m_sSection, 0, Value, m_sPath) End Set End Property ReadOnly Property Sections() As String Get Dim sBuf As String Dim iSize As String Dim iRetCode As Short sBuf = Space(8192) iSize = CStr(Len(sBuf)) iRetCode = GetPrivateProfileString(0, 0, m_sDefault, sBuf, CInt(iSize), m_sPath) If (CDbl(iSize) > 0) Then Sections = Left(sBuf, iRetCode) Else Sections = "" End If End Get End Property ReadOnly Property LastReturnCode() As Integer Get LastReturnCode = m_lLastReturnCode End Get End Property ReadOnly Property Success() As Boolean Get Success = (m_lLastReturnCode <> 0) End Get End Property 'UPGRADE_NOTE: Default이(가) Default_Renamed(으)로 업그레이드되었습니다. 자세한 내용은 다음을 참조하십시오. 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="A9E4979A-37FA-4718-9994-97DD76ED70A7"' Property Default_Renamed() As String Get Default_Renamed = m_sDefault End Get Set(ByVal Value As String) m_sDefault = Value End Set End Property Property Path() As String Get Path = m_sPath End Get Set(ByVal Value As String) m_sPath = Value End Set End Property Property Key() As String Get Key = m_sKey End Get Set(ByVal Value As String) m_sKey = Value End Set End Property Property Section() As String Get Section = m_sSection End Get Set(ByVal Value As String) m_sSection = Value End Set End Property End Class