Files
FileManager/DriveInfo/MyAuth.vb
2021-12-26 22:53:39 +09:00

496 lines
18 KiB
VB.net

Imports System.Security.Cryptography
Public Class EnDec
Private TripleDes As New TripleDESCryptoServiceProvider
Sub New(ByVal key As String)
' Initialize the crypto provider.
TripleDes.Key = TruncateHash(key, TripleDes.KeySize \ 8)
TripleDes.IV = TruncateHash("", TripleDes.BlockSize \ 8)
End Sub
Private Function TruncateHash(
ByVal key As String,
ByVal length As Integer) _
As Byte()
Dim sha1 As New SHA1CryptoServiceProvider
' Hash the key.
Dim keyBytes() As Byte =
System.Text.Encoding.Unicode.GetBytes(key)
Dim hash() As Byte = sha1.ComputeHash(keyBytes)
' Truncate or pad the hash.
ReDim Preserve hash(length - 1)
Return hash
End Function
''' <summary>
''' 문자열의 암호화
''' </summary>
''' <param name="plaintext"></param>
''' <returns></returns>
''' <remarks></remarks>
Public Function EncryptData(
ByVal plaintext As String) _
As String
' Convert the plaintext string to a byte array.
Dim plaintextBytes() As Byte =
System.Text.Encoding.Unicode.GetBytes(plaintext)
' Create the stream.
Dim ms As New System.IO.MemoryStream
' Create the encoder to write to the stream.
Dim encStream As New CryptoStream(ms,
TripleDes.CreateEncryptor(),
System.Security.Cryptography.CryptoStreamMode.Write)
' Use the crypto stream to write the byte array to the stream.
encStream.Write(plaintextBytes, 0, plaintextBytes.Length)
encStream.FlushFinalBlock()
' Convert the encrypted stream to a printable string.
Return Convert.ToBase64String(ms.ToArray)
End Function
''' <summary>
''' 복호화'
''' </summary>
''' <param name="encryptedtext"></param>
''' <returns></returns>
''' <remarks></remarks>
Public Function DecryptData(
ByVal encryptedtext As String) _
As String
' Convert the encrypted text string to a byte array.
Dim encryptedBytes() As Byte = Convert.FromBase64String(encryptedtext)
' Create the stream.
Dim ms As New System.IO.MemoryStream
' Create the decoder to write to the stream.
Dim decStream As New CryptoStream(ms,
TripleDes.CreateDecryptor(),
System.Security.Cryptography.CryptoStreamMode.Write)
' Use the crypto stream to write the byte array to the stream.
decStream.Write(encryptedBytes, 0, encryptedBytes.Length)
decStream.FlushFinalBlock()
' Convert the plaintext stream to a string.
Return System.Text.Encoding.Unicode.GetString(ms.ToArray, 0, ms.Length)
End Function
''' <summary>
''' 파일로부터 문자열을 읽어옵니다.
''' </summary>
''' <param name="Filename"></param>
''' <remarks></remarks>
Public Function Read_STring(ByVal Filename As String) As String
Dim FI As New System.IO.FileInfo(Filename)
If FI.Exists = False Then
MsgBox("필수파일이 존재하지않습니다", MsgBoxStyle.Critical, "확인")
Return ""
End If
Dim FS As New System.IO.FileStream(FI.FullName, IO.FileMode.Open)
Dim SR As New System.IO.StreamReader(FS, System.Text.Encoding.Default)
Dim cipherText As String = SR.ReadToEnd
SR.Close()
FS.Close()
' DecryptData throws if the wrong password is used.
Try
Dim plainText As String = DecryptData(cipherText)
Return plainText
'MsgBox("해독값은? " & plainText)
Catch ex As System.Security.Cryptography.CryptographicException
Return ""
MsgBox("암호화키가 일치하지않거나 기타 오류입니다")
End Try
End Function
''' <summary>
''' 파일에 해당 문자열을 기록합니다.
''' </summary>
''' <param name="Filename"></param>
''' <param name="Contents"></param>
''' <remarks></remarks>
Public Sub Write_String(ByVal Filename As String, ByVal Contents As String)
Dim cipherText As String = EncryptData(Contents)
Dim FI As New System.IO.FileInfo(Filename)
Dim FS As New System.IO.FileStream(FI.FullName, IO.FileMode.Create)
Dim SW As New System.IO.StreamWriter(FS, System.Text.Encoding.Default)
'MsgBox("암호화된값은? " & cipherText)
SW.Write(cipherText)
SW.Flush()
SW.Close()
FS.Close()
End Sub
End Class
Public Class MyAuth '//각종인증방법을 이용한다.
Public Function GetDateAuth(ByVal 만기일자 As Date) As Boolean '//날짜인증시 사용가능한지
'//사용가능한 날짜인지 확인하고 만약 날짜정보가 없으면은 날짜를 setdataeauth 를 실행합니다
'//인터넷에 연결되어있을시 현재 시간정보를 인터넷에서 받아온ㄷ
'//콘솔의 현재날짜가 설치된 날짜보다 더 뒤일경우 사용중지
'//레지 파일의 기록날짜가 서로다를경우 사용중지
'//레지,파일의 기록날짜가 동일하고 콘솔의 현재날짜가 기한을 넘지않았을경우에만 true 한다.
Dim isAvailable As Boolean = My.Computer.Network.IsAvailable '//인터넷사용여부
Dim CurrentDate As Date
If isAvailable Then '//인터넷에서 날짜정보를 가져온다 기록된 날짜와 오늘의 날짜를 확인한다.
Dim Itime As Date
Try
CurrentDate = Itime
Catch ex As Exception '//에러발생시 콘솔날짜로 세팅한다.
CurrentDate = Now
End Try
Else
MsgBox("인터넷사용불가")
CurrentDate = Now
End If
If 만기일자 > CurrentDate Then Return False
Return True
End Function
Public Sub SetAuth(ByVal Newkey As Long, ByVal Fn As String)
' Dim auth As New ARINCLASS
Dim Arinini As New MyINI2(Fn)
Arinini.Write("main", "install2", Newkey)
Arinini.Write("main", "installkey2", Newkey.GetHashCode)
Dim A As New System.Text.StringBuilder
A.AppendLine("인증정보가 파일에 기록되었습니다")
A.AppendLine("만기일 : " & Date.FromFileTimeUtc(Newkey))
MsgBox(A.ToString, MsgBoxStyle.Information, "기록완료")
End Sub
''' <summary>
''' 미지원 함수
''' </summary>
''' <returns></returns>
''' <remarks></remarks>
Public Function SetDateAuth() As Boolean '//레지와 파일에 해당 인증정보를 기록합니다
Return True
End Function
''' <summary>
''' 미지원함수
''' </summary>
''' <returns></returns>
''' <remarks></remarks>
Public Function GetCurrentDate() As Date '//오늘날짜를 가져옵니다
Return Now
End Function
Public Function GetDateNumber(ByVal 시작일 As Date) As Long
Return 시작일.ToFileTimeUtc
End Function
Public Function GetDateNumberEnc(ByVal 시작일 As Date) As String
Return 시작일.ToFileTimeUtc.ToString.GetHashCode '//날짜로 들어가면 날짜의 해쉬코드를 넘겨준다.
End Function
Public Function GetDateNumberEnc(ByVal 시작일 As Long) As String
Return 시작일.ToString.GetHashCode
End Function
End Class
Public Class MyINI2
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