'****************************************************************************************
'*
'* EgoCube.URLTools Component 는 공개 Component 입니다. 상업적, 비상업적인 목적으로 어디
'* 서나 자유롭게 사용하실 수 있습니다.
'*
'* 다만, 기능 추가나 에러 수정을 목적으로 Code 를 수정하셨을 때는, 제게 수정된 내용과
'* 목적에 대하여 적은 메일을 보내주셔서 제가 수정사항을 반영할 수 있도록 해주시면 감사하
'* 겠습니다. 또한, 이런식으로 수정된 Code 는 그 내용과 이유를 정리하여 제 홈페이지의
'* 내용에 추가하도록 하겠습니다. 연락처는 다음과 같습니다.
'*
'* Homepage URL : http://www.egocube.pe.kr/
'* E-Mail : songgun@egocube.pe.kr
'*
'****************************************************************************************
Option Explicit
Public Type ColorsType
rVal As Integer
gVal As Integer
bVal As Integer
End Type
Public Type Song
Title As String
Artist As String
Number As String
End Type
'****************************************************************************************
'*
'* 형 식 : Function
'* 정 의 : Public Function URLEncode(URLStr As String) As String
'* 설 명 : URLStr 인자로 입력받은 문자열을 URLEncoding 한다.
'* 작 성 : 송원석
'* 날 짜 : 2001.12.03
'*
'****************************************************************************************
Public Function URLEncode(URLStr As String) As String
Dim sURL As String '** 입력받은 URL 문자열
Dim sBuffer As String '** Encoding 중의 URL 을 담을 Buffer 문자열
Dim sTemp As String '** 임시 문자열
Dim cChar As String '** URL 문자열 중의 현재 Index 의 문자
Dim Index As Integer
Dim lErrNum As Long '** Error Number
Dim sErrSource As String '** Error Source
Dim sErrDesc As String '** Error Description
Dim sMsg As String '** Error Message
On Error GoTo ErrorHanddle:
sURL = Trim(URLStr) '** URL 문자열을 얻는다.
sBuffer = "" '** 임시 Buffer 용 문자열 변수 초기화.
'******************************************************
'* URL Encoding 작업
'******************************************************
For Index = 1 To Len(sURL)
'** 현재 Index 의 문자를 얻는다.
cChar = Mid(sURL, Index, 1)
If cChar = "0" Or _
(cChar >= "1" And cChar <= "9") Or _
(cChar >= "a" And cChar <= "z") Or _
(cChar >= "A" And cChar <= "Z") Or _
cChar = "-" Or _
cChar = "_" Or _
cChar = "." Or _
cChar = "*" Then
'** URL 에 허용되는 문자들 :: Buffer 문자열에 추가한다.
sBuffer = sBuffer & cChar
ElseIf cChar = " " Then
'** 공백 문자 :: + 로 대체하여 Buffer 문자열에 추가한다.
sBuffer = sBuffer & "+"
Else
'** URL 에 허용되지 않는 문자들 :: % 로 Encoding 해서 Buffer 문자열에 추가
sTemp = CStr(Hex(Asc(cChar)))
If Len(sTemp) = 4 Then
sBuffer = sBuffer & "%" & Left(sTemp, 2) & "%" & Mid(sTemp, 3, 2)
ElseIf Len(sTemp) = 2 Then
sBuffer = sBuffer & "%" & sTemp
End If
End If
Next
'** 결과를 리턴한다.
URLEncode = sBuffer
Exit Function
ErrorHanddle:
'** Error 가 발생하면 공백 문자를 Return 한다.
URLEncode = ""
'** Error 정보를 얻는다.
lErrNum = Err.Number
sErrSource = Err.Source
sErrDesc = Err.Description
'** Event Log 에 Error 를 기록한다.
sMsg = vbCrLf & vbCrLf & _
"Error Object : EgoCube.URLTools," & vbCrLf & _
"Error Method : Public Function URLEncode(URLStr As String) As String," & vbCrLf & _
"Error Number : " & lErrNum & "," & vbCrLf & _
"Error Source : " & sErrSource & "," & vbCrLf & _
"Error Description : " & sErrDesc
App.LogEvent sMsg, vbLogEventTypeError
'** Error 를 발생시킨다.
Err.Raise lErrNum, sErrSource, sErrDesc
Exit Function
End Function
'****************************************************************************************
'*
'* 형 식 : Function
'* 정 의 : Public Function URLDecode(URLStr As String) As String
'* 설 명 : URLStr 인자로 입력받은 문자열을 URLDecoding 한다.
'* 작 성 : 송원석
'* 날 짜 : 2001.12.03
'*
'****************************************************************************************
Public Function URLDecode(URLStr As String) As String
Dim sURL As String '** 입력받은 URL 문자열
Dim sBuffer As String '** Decoding 중의 URL 을 담을 Buffer 문자열
Dim cChar As String '** URL 문자열 중의 현재 Index 의 문자
Dim Index As Integer
Dim lErrNum As Long '** Error Number
Dim sErrSource As String '** Error Source
Dim sErrDesc As String '** Error Description
Dim sMsg As String '** Error Message
On Error GoTo ErrorHanddle:
sURL = Trim(URLStr) '** URL 문자열을 얻는다.
sBuffer = "" '** 임시 Buffer 용 문자열 변수 초기화.
'******************************************************
'* URL Decoding 작업
'******************************************************
Index = 1
Do While Index <= Len(sURL)
cChar = Mid(sURL, Index, 1)
If cChar = "+" Then
'** '+' 문자 :: ' ' 로 대체하여 Buffer 문자열에 추가한다.
sBuffer = sBuffer & " "
Index = Index + 1
ElseIf cChar = "%" Then
'** '%' 문자 :: Decoding 하여 Buffer 문자열에 추가한다.
cChar = Mid(sURL, Index + 1, 2)
If CInt("&H" & cChar) < &H80 Then
'** 일반 ASCII 문자
sBuffer = sBuffer & Chr(CInt("&H" & cChar))
Index = Index + 3
Else
'** 2 Byte 한글 문자
cChar = Replace(Mid(sURL, Index + 1, 5), "%", "")
sBuffer = sBuffer & Chr(CInt("&H" & cChar))
Index = Index + 6
End If
Else
'** 그 외의 일반 문자들 :: Buffer 문자열에 추가한다.
sBuffer = sBuffer & cChar
Index = Index + 1
End If
Loop
'** 결과를 리턴한다.
URLDecode = sBuffer
Exit Function
ErrorHanddle:
'** Error 가 발생하면 공백 문자를 Return 한다.
URLDecode = ""
'** Error 정보를 얻는다.
lErrNum = Err.Number
sErrSource = Err.Source
sErrDesc = Err.Description
'** Event Log 에 Error 를 기록한다.
sMsg = vbCrLf & vbCrLf & _
"Error Object : EgoCube.URLTools," & vbCrLf & _
"Error Method : Public Function URLDecode(URLStr As String) As String," & vbCrLf & _
"Error Number : " & lErrNum & "," & vbCrLf & _
"Error Source : " & sErrSource & "," & vbCrLf & _
"Error Description : " & sErrDesc
App.LogEvent sMsg, vbLogEventTypeError
'** Error 를 발생시킨다.
Err.Raise lErrNum, sErrSource, sErrDesc
Exit Function
End Function
VB
