devflow.kr@:~#

URLEncode/Deocde 함수

VB
'****************************************************************************************
'*
'*  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

티스토리 툴바