<%
'****************************************************************
'* 함수설명 : 한글을 2바이트로 계산한 Len
'* 변수설명 : str = 문자
'****************************************************************
Function strLen(str)
Dim i, CharAt
strLen=0
For i=1 to Len(str)
CharAt=Mid(str, i, 1)
If asc(CharAt)>0 And Asc(CharAt)<255 Then
strLen=strLen+1
Else
strLen=strLen+2
End If
Next
End Function
'****************************************************************
'* 함수설명 : 한글을 2바이트로 계산한 Mid
'* 변수설명 : str = 문자
'* srart = 시작지점
'* length = 길이
'****************************************************************
Function strMid(str, start, length)
Dim i, CharAt, VBLength, VBn1, VBn2, BLength, AddByte
VBn2=length
VBLength=Len(str)
BLength=0
For i=1 To VBLength
CharAt=Mid(str, i, 1)
If Asc(CharAt)>0 And Asc(CharAt)<255 Then
BLength=BLength + 1
Else
BLength=BLength + 2
End If
If BLength>=start Then
Exit For
End If
Next
VBn1=i
If VBn1<1 Then VBn1=1
BLength=0
For i=VBn1 To VBLength
CharAt=Mid(str, i, 1)
If Asc(CharAt)>0 And Asc(CharAt)<255 Then
BLength=BLength + 1
Else
BLength=BLength + 2
End If
If BLength=length Then
VBn2=i+1
Exit For
ElseIf BLength>length Then
VBn2=i
Exit For
End If
Next
strMid=Mid(str, VBn1, VBn2-VBn1)
End Function
'****************************************************************
'* 함수설명 : 한글을 2바이트로 계산한 Left
'* 변수설명 : str = 문자
'* size = 길이
'****************************************************************
Function strLeft(str, size)
If isNull(str) Or LEN(str) < 1 Then
strLeft = ""
Else
strLeft = strMid(str, 1, size)
End If
End Function
'****************************************************************
'* 함수설명 : 문자 길이 컷트
'* 변수설명 : str = 문자
'* size = 길이
'****************************************************************
Function CutString(str, size)
If Not IsNull(str) Then
If strLen(str) > size Then str = strLeft(str, size) & "..."
End If
CutString = str
End Function
'****************************************************************
'* 함수설명 : 자동 링크 함수
'* 변수설명 : str = 입력값, target = 새창여부
'****************************************************************
Function AutoLink(str, target)
Dim regEx
SET regEx = New RegExp
regEx.pattern = "(http|ftp):\/\/([a-z0-9\_\-\./~@?=%&:\-]+)"
regEx.IgnoreCase = True
regEx.Global = True
If target = "_blank" Then
str = regEx.Replace(str, "$1://$2")
Else
str = regEx.Replace(str, "$1://$2")
End If
regEx.Pattern = "(\w+)@([\w.\-]+)"
str = regEx.Replace(str, "$1@$2")
AutoLink = str
End Function
'****************************************************************
'* 함수설명 : ' -> ', " -> "
'* 변수설명 : text = 입력값
'****************************************************************
Function GetFormText(str)
Dim text
If IsNull(str) Or str = "" Then
GetFormText = ""
Else
text = Replace(str, """, chr(34))
text = Replace(text, "'", "'")
text = Replace(text, "'", "'")
text = Replace(text, """, """)
GetFormText = text
End If
End Function
'****************************************************************
'* 함수설명 : HTML 태그를 텍스트로
'* 변수설명 : text = 입력값
'****************************************************************
Function Tag2Text(str)
Dim text
If IsNull(str) Or str = "" Then
Tag2Text = ""
Else
text = Replace(str, """, Chr(34))
text = Replace(text, "'", "'")
text = Replace(text, "'", "'")
text = Replace(text, """, """)
text = Replace(text, "<", "<")
text = Replace(text, ">", ">")
text = Replace(text, Chr(13)&Chr(10), " ")
text = Replace(text, Chr(10), " ")
Tag2Text = text
End If
End Function
'****************************************************************
'* 함수설명 : HTML 태그 변환 함수
'* 변수설명 : text = 변환할 변수 값
'****************************************************************
Function Tag2Html(str)
Dim text
If IsNull(str) Or str = "" Then
Tag2Html = ""
Else
text = BadScriptTagReplace(str)
text = Replace(text, """, Chr(34))
text = Replace(text, "'", "'")
text = Replace(text, "'", "'")
text = Replace(text, """, """)
text = Replace(text,"<" & "%","<%")
text = Replace(text,"%" & ">","%>")
Tag2Html = text
End If
End Function
'****************************************************************
'* 함수설명 : HTML BR 태그 변환 함수
'* 변수설명 :text = 변환할 변수 값
'****************************************************************
Function Tag2HtmlBr(str)
Dim text
If IsNull(str) Or str = "" Then
Tag2HtmlBr = ""
Else
text = BadScriptTagReplace(str)
text = Replace(text, """, Chr(34))
text = Replace(text, "'", "'")
text = Replace(text, "'", "'")
text = Replace(text, """, """)
text = Replace(text,"<" & "%","<%")
text = Replace(text,"%" & ">","%>")
text = Replace(text, Chr(13)&Chr(10), " ")
text = Replace(text, Chr(10), " ")
Tag2HtmlBr = text
End If
End Function
'****************************************************************
'* 함수설명 : 에디터용 태그 변환 함수
'* 변수설명 : text = 변환할 변수 값
'****************************************************************
Function Tag2Editor(str)
Dim text
If IsNull(str) Or str = "" Then
Tag2Editor = ""
Else
text = Replace(str, """, Chr(34))
text = Replace(text, "'", "'")
text = Replace(text, "&", "&")
Tag2Editor = text
End If
End Function
'****************************************************************
'* 함수설명 : 텍스트를 HTML 태그로
'* 변수설명 : str = 입력값
'****************************************************************
Function Text2Tag(str)
If IsNull(str) Or str = "" Then
Text2Tag = ""
Else
Dim text
text = replace(str, "<", "<")
text = replace(text, ">", ">")
text = replace(text, """, chr(34))
text = replace(text, "'", "'")
text = Replace(text, "'", "'")
text = Replace(text, """, """)
Text2Tag = text
End If
End Function
'****************************************************************
'* 함수설명 : 변수값 받기
'* 변수설명 : str = 입력값
'****************************************************************
Function GetRequest(str)
Dim text
If inStr(Request.ServerVariables("HTTP_CONTENT_TYPE"),"multipart/form-data") > 0 Then
text = Trim(UPLOAD(str))
Else
text = Trim(Request(str))
End If
text = Replace(text, "'", "'")
text = Replace(text, """, """)
text = Replace(text, Chr(34), """)
text = Replace(text, "'", "'")
text = InjectionCheck(text, 1)
GetRequest = text
End Function
Function GetRequestArr(str, num)
On Error Resume Next
Dim text
If inStr(Request.ServerVariables("HTTP_CONTENT_TYPE"),"multipart/form-data") > 0 Then
If UPLOAD(str).Count > 0 Then
text = Trim(UPLOAD(str)(num))
End If
Else
If Request(str).Count > 0 Then
text = Trim(Request(str)(num))
End If
End If
text = Replace(text, "'", "'")
text = Replace(text, """, """)
text = Replace(text, Chr(34), """)
text = Replace(text, "'", "'")
text = InjectionCheck(text, 1)
GetRequestArr = text
End Function
Function GetRequestMulti(str,val)
Dim Text, i
If inStr(Request.ServerVariables("HTTP_CONTENT_TYPE"),"multipart/form-data") > 0 Then
If UPLOAD(str).Count > 0 Then
For i = 1 To UPLOAD(str).Count
If Len(Text) > 0 Then Text = Text &"|"
Text = Text & Trim(GetRequestArr(str, i))
Next
Else
Text = val
End If
Else
If Request(str).Count > 0 Then
For i = 1 To Request(str).Count
If Len(Text) > 0 Then Text = Text &"|"
Text = Text & Trim(GetRequestArr(str, i))
Next
Else
Text = val
End If
End If
GetRequestMulti = Text
End Function
'****************************************************************
'* 함수설명 : 지정한 자릿수만큼 0을 채운다.
'* 변수설명 : strNum = 숫자
'* pos = 자릿수
'****************************************************************
Function FillZero(strNum, pos)
Dim i, strZero
strZero = ""
For i=1 To pos
strZero = strZero & "0"
Next
FillZero = right(strZero&strNum, pos)
End Function
'****************************************************************
'* 함수설명 : 숫자만 가져오기
'* 변수설명 : str = 입력값
'****************************************************************
Function getStrToNum(str)
Dim i, chkStr, rtnResult
rtnResult = ""
For i = 1 to Len(str)
chkStr = Mid(str, i, 1)
If Asc(chkStr) > 47 And Asc(chkStr) < 58 Then
rtnResult = rtnResult & chkStr
End If
Next
getStrToNum = rtnResult
End Function
Function getStrToNumInt(str)
Dim i, chkStr, rtnResult
rtnResult = ""
For i = 1 to Len(str)
chkStr = Mid(str, i, 1)
If Asc(chkStr) > 47 And Asc(chkStr) < 58 Then
rtnResult = rtnResult & chkStr
End If
Next
If isNumeric(rtnResult) Then
rtnResult = CLng(rtnResult)
Else
rtnResult = 0
End If
getStrToNumInt = rtnResult
End Function
'****************************************************************
'* 함수설명 : 단어 체크
'* 변수설명 : str = 입력값
'* strWords = 체크할 단어 리스트
'****************************************************************
Function WordCheck(str,strWords)
Dim word, Words
Words = split(strWords, ",")
For Each word In Words
If str = word Then
WordCheck = True
Exit Function
End If
Next
WordCheck = False
End Function
'****************************************************************
'* 함수설명 : 태그들만 빼고 글가져오기
'* 변수설명 : strHTML = 입력값
'****************************************************************
Function stripHTML(strHTML, strFlag)
If IsNull(strHTML) Or strHTML = "" Then
stripHTML = ""
Else
Dim objRegExp, strOutput
Set objRegExp = New Regexp
objRegExp.IgnoreCase = True
objRegExp.Global = True
If strFlag = "1" Then
objRegExp.Pattern = "<.+?>"
strOutput = objRegExp.Replace(strHTML, "")
ElseIf strFlag = "2" Then
objRegExp.Pattern = "<.+?>"
strOutput = objRegExp.Replace(strHTML, "")
strOutput = Replace(strOutput, " ", "")
strOutput = Replace(strOutput, Chr(13)&Chr(10), "")
strOutput = Replace(strOutput, Chr(10), "")
strOutput = Trim(strOutput)
ElseIf strFlag = "3" Then
objRegExp.Pattern = "<(?!\/P|P).+?>"
strOutput = objRegExp.Replace(strHTML, "")
ElseIf strFlag = "4" Then
objRegExp.Pattern = "<.+?>"
strOutput = objRegExp.Replace(strHTML, "")
strOutput = Replace(strOutput, Chr(13)&Chr(10), " ")
strOutput = Replace(strOutput, Chr(10), " ")
strOutput = Trim(strOutput)
ElseIf strFlag = "5" Then
objRegExp.Pattern = "<.+?>"
strOutput = objRegExp.Replace(strHTML, "")
strOutput = Replace(strOutput, Chr(13)&Chr(10), " ")
strOutput = Replace(strOutput, Chr(10), " ")
strOutput = Trim(strOutput)
End If
stripHTML = strOutput
Set objRegExp = Nothing
End If
End Function
'****************************************************************
'* 함수설명 : Select, Radio, CheckBox 선택상태 만들기
'****************************************************************
Function SetSelected(str,strValue)
Dim rtnValue
rtnValue = ""
If str = strValue Then rtnValue = " selected=""selected"""
SetSelected = rtnValue
End Function
Function SetChecked(str,strValue)
Dim rtnValue
rtnValue = ""
If str = strValue Then rtnValue = " checked=""checked"""
SetChecked = rtnValue
End Function
Function SetCheckedByList(str,strList)
Dim rtnValue
rtnValue = ""
If InStr(strList,str) > 0 Then rtnValue = " checked=""checked"""
SetCheckedByList = rtnValue
End Function
Function SetDisabled(str,strValue)
Dim rtnValue
rtnValue = ""
If str = strValue Then rtnValue = " disabled=""disabled"""
SetDisabled = rtnValue
End Function
Function SetDisabledByList(str,strList)
Dim rtnValue
rtnValue = ""
If InStr(strList,str) > 0 Then rtnValue = " disabled=""disabled"""
SetDisabledByList = rtnValue
End Function
'****************************************************************
'* 함수설명 : 랜덤 비밀번호 만들기
'* 변수설명 : intLen = 만들 비밀번호 자릿수
'****************************************************************
Function GetRndPwd(intLen)
Dim strTemp, i, num , str
Randomize
strTemp = "abcdefghijklmnopqrstuvwxyz0123456789"
For i=1 To intLen
num = Int((36 * Rnd) + 1)
str = str & Mid(strTemp,num,1)
Next
GetRndPwd = str
End Function
'****************************************************************
'* 함수설명 : 날짜와 시간을 형식에 맞춰 변환
'* 변수설명 : datetime = 날짜
'* datetype = 형식
'* 대문자는 날짜, 소문자는 시간(Y, M, D, t, h, m, s)
'* 내장된 예약어로는 DATE,DATETIME,TIME
'****************************************************************
Function FormatDate(datetime, datetype)
If Trim(datetime) = "" Or isNull(Trim(datetime)) Then
FormatDate=""
Else
dim sYear, sMonth, sDay, sHour, sMinute, sSecond
dim lYear, lMonth, lDay, lHour, lMinute, lSecond
dim is12, s12
dim dateForm
dim i, cnt
dim str, c, oldc
sYear=Year(datetime)
sMonth=Month(datetime)
sDay=Day(datetime)
sHour=Hour(datetime)
sMinute=Minute(datetime)
sSecond=Second(datetime)
dateForm=Trim(datetype)
If dateForm="" Then dateForm="DATE"
Select Case UCase(dateForm)
Case "DATETIME"
dateForm = "Y-M-D th:m:s"
Case "DATE"
dateForm = "Y-M-D"
Case "TIME"
dateForm = "th:m:s"
End Select
lYear=Len(dateForm)-Len(Replace(dateForm, "Y", ""))
lMonth=Len(dateForm)-Len(Replace(dateForm, "M", ""))
lDay=Len(dateForm)-Len(Replace(dateForm, "D", ""))
lHour=Len(dateForm)-Len(Replace(dateForm, "h", ""))
lMinute=Len(dateForm)-Len(Replace(dateForm, "m", ""))
lSecond=Len(dateForm)-Len(Replace(dateForm, "s", ""))
is12=instr(dateForm, "t")
sYear=FormatStr(sYear, String(lYear, "0"))
sMonth=FormatStr(sMonth, String(lMonth, "0"))
sDay=FormatStr(sDay, String(lDay, "0"))
sHour=FormatStr(sHour, String(lHour, "0"))
sMinute=FormatStr(sMinute, String(lMinute, "0"))
sSecond=FormatStr(sSecond, String(lSecond, "0"))
If is12 Then
s12="오전"
If sHour > 12 Then
s12="오후"
sHour=sHour-12
End If
End If
sMonth = fillZero(sMonth,2)
sDay = fillZero(sDay,2)
sHour = fillZero(sHour,2)
sMinute = fillZero(sMinute,2)
sSecond = fillZero(sSecond,2)
cnt=Len(dateForm)
i=1
Do Until i>cnt
c=mid(dateForm, i, 1)
If c <> oldc Then
oldc=c
Select Case c
Case "Y"
str=str & sYear
Case "M"
str=str & sMonth
Case "D"
str=str & sDay
Case "t"
str=str & s12
Case "h"
str=str & sHour
Case "m"
str=str & sMinute
Case "s"
str=str & sSecond
Case else
str=str & c
End Select
End If
i=i+1
Loop
FormatDate=str
End If
End Function
Function FormatStr(s, dateForm)
If Len(s) > Len(dateForm) Then
FormatStr=s
Else
FormatStr=left(dateForm, Len(dateForm)-Len(s)) & s
End If
End Function
Function FormatDateDay(datetime, printType)
If Trim(datetime) = "" Or IsNull(Trim(datetime)) Then
FormatDateDay = ""
Else
Dim sYear, sMonth, sDay, sWeekDay, diaNombre
sYear = Year(datetime)
sMonth = Right("0"& Month(datetime), 2)
sDay = Right("0"& Day(datetime), 2)
sWeekDay = weekDay(datetime)
If sWeekDay = 1 Then
diaNombre = "일"
ElseIf sWeekDay = 2 Then
diaNombre = "월"
ElseIf sWeekDay = 3 Then
diaNombre = "화"
ElseIf sWeekDay = 4 Then
diaNombre = "수"
ElseIf sWeekDay = 5 Then
diaNombre = "목"
ElseIf sWeekDay = 6 Then
diaNombre = "금"
ElseIf sWeekDay = 7 Then
diaNombre = "토"
End If
If printType = "-" Then
FormatDateDay = sYear &"-"& sMonth &"-"& sDay &" ("& diaNombre &")"
ElseIf printType = "." Then
FormatDateDay = sYear &"."& sMonth &"."& sDay &" ("& diaNombre &")"
ElseIf printType = "kr" Then
FormatDateDay = sYear &"년 "& sMonth &"월 "& sDay &"일 ("& diaNombre &")"
Else
FormatDateDay = sMonth &"/"& sDay &" "& diaNombre &"요일"
End If
End If
End Function
Function FormatWeekday(datetime)
If Trim(datetime) = "" Or IsNull(Trim(datetime)) Then
FormatWeekday = ""
Else
Dim sYear, sMonth, sDay, sWeekDay, diaNombre
sYear = Year(datetime)
sMonth = Right("0"& Month(datetime), 2)
sDay = Right("0"& Day(datetime), 2)
sWeekDay = weekDay(datetime)
If sWeekDay = 1 Then
diaNombre = "일"
ElseIf sWeekDay = 2 Then
diaNombre = "월"
ElseIf sWeekDay = 3 Then
diaNombre = "화"
ElseIf sWeekDay = 4 Then
diaNombre = "수"
ElseIf sWeekDay = 5 Then
diaNombre = "목"
ElseIf sWeekDay = 6 Then
diaNombre = "금"
ElseIf sWeekDay = 7 Then
diaNombre = "토"
End If
FormatWeekday = diaNombre
End If
End Function
'****************************************************************
'* 함수설명 : RegExp.Test() 메소드를 일반화한 함수
'****************************************************************
Public Function RegExpTest(Patrn, TestStr)
Dim ObjRegExp
On Error Resume Next
Set ObjRegExp = New RegExp
ObjRegExp.Pattern = Patrn '** 정규 표현식 패턴
ObjRegExp.Global = True '** 문자열 전체를 검색함
ObjRegExp.IgnoreCase = True '** 대.소문자 구분 안함
RegExpTest = ObjRegExp.Test(TestStr)
Set ObjRegExp = Nothing
End Function
'****************************************************************
'* 함수설명 : RegExp.Execute() 메소드를 일반화한 함수
'****************************************************************
Public Function RegExpExec(Patrn, TestStr)
Dim ObjRegExp
On Error Resume Next
Set ObjRegExp = New RegExp
ObjRegExp.Pattern = Patrn '** 정규 표현식 패턴
ObjRegExp.Global = True '** 문자열 전체를 검색함
ObjRegExp.IgnoreCase = True '** 대.소문자 구분 안함
Set RegExpExec = ObjRegExp.Execute(TestStr)
Set ObjRegExp = Nothing
End Function
' '** RegExpExec() 함수 실행
' Set Rmc = RegExpExec("저장", Test_String)
'
' '** 루프를 돌면서 정보를 출력한다.
' For Each Rm In Rmc
' With Response
' .Write ""
' .Write "문자열의 첫 글자의 Index 위치 :: " & Rm.FirstIndex & " "
' .Write "문자열의 길이 :: " & Rm.Length & " "
' .Write "문자열의 내용 :: " & Rm.Value & " "
' .Write " "
' .Flush
' End With
' Next
'****************************************************************
'* 함수설명 : RegExp.Replace() 메소드를 일반화한 함수
'* 변수설명 : Patrn = 패턴
'* Str = 입력값
'* ReStr = 변경할 값
'****************************************************************
Public Function RegExpReplace(Patrn, Str, ReStr)
Dim ObjRegExp
On Error Resume Next
Set ObjRegExp = New RegExp
ObjRegExp.Pattern = Patrn '** 정규 표현식 패턴
ObjRegExp.Global = True '** 문자열 전체를 검색함
ObjRegExp.IgnoreCase = True '** 대.소문자 구분 안함
RegExpReplace = ObjRegExp.Replace(Str,ReStr)
Set ObjRegExp = Nothing
End Function
'****************************************************************
'* 함수설명 : 정규식 체크
'* 변수설명 : strType = 형식
'* str = 입력값
'****************************************************************
Function ChkPattern(strType, str)
Dim strPatrn
Select Case strType
Case "NUM"
strPatrn = "^[0-9]+$"
Case "PHONE"
strPatrn = "^[0-9]{2,4}-[0-9]{3,4}-[0-9]{4}$"
Case "MAIL"
strPatrn = "^[_a-zA-Z0-9-]+@[._a-zA-Z0-9-]+\.[a-zA-Z]+$"
Case "DOMAIN"
strPatrn = "^[.a-zA-Z0-9-]+.[a-zA-Z]+$"
Case "ENGNUM"
strPatrn = "^[a-zA-Z0-9]+$"
Case "ENG"
strPatrn = "^[a-zA-Z]+$"
Case "HOST"
strPatrn = "^[a-zA-Z_]+$"
Case "HANGUL"
strPatrn = "[가-힣]/"
Case "HANGULENG"
strPatrn = "[가-힣a-zA-Z]"
Case "HANGULONLY"
strPatrn = "^[가-힣]*$"
Case "ID"
strPatrn = "^[a-zA-Z]{1}[a-zA-Z0-9_-]{4,15}$"
Case "DATE"
strPatrn = "^[0-9]{4}-[0-9]{2}-[0-9]{2}$"
End Select
ChkPattern = RegExpTest(strPatrn, str)
End Function
'****************************************************************
'* 함수설명 : 사용불가 스크립트 및 태그 체크
'* 변수설명 : str = 입력값
'****************************************************************
Function BadScriptTagReplace(str)
Dim strBadScripts, strBadTags, scripts, tags, contents
strBadScripts = ".location,location.,onload,.cookie,alert(,window.open(,onmouse,onkey,onclick,view-source:"
strBadTags = "iframe,script"
'<([a-zA-Z].[^<>]*?[\s])("& scripts &")(.*?)>
tags = Replace(strBadTags,",","|")
scripts = Replace(strBadScripts,".","\.")
scripts = Replace(scripts,"(","\(")
scripts = Replace(scripts,"-","\-")
scripts = Replace(scripts,",","|")
contents = RegExpReplace("<([a-zA-Z].[^<>]*?)("& scripts &")(.*?)>",str,"<$1$2$3>")
contents = RegExpReplace("<(\/?)("& tags &")([^<>]*)?>",contents,"<$1$2$3>")
BadScriptTagReplace = contents
End Function
'****************************************************************
'* 함수설명 : 본문 주문등록번호 치환(******)
'* 변수설명 : str = 입력값
'****************************************************************
Function PersonalNoReplace(str)
Dim text
text = RegExpReplace("([0-9]{6})\s?-\s?([1-4][0-9]{6})",str,"$1-*******")
PersonalNoReplace = text
End Function
'****************************************************************
'* 함수설명 : 본문 이름 치환(***)
'* 변수설명 : str = 입력값
'****************************************************************
Function NameReplace(str)
If Len(str) > 0 Then
NameReplace = Left(str,1) &"*"& Mid(str, 3, Len(str))
Else
NameReplace = ""
End If
End Function
'****************************************************************
'* 함수설명 : URLDecode (한글지원)
'* 변수설명 : Expression = URL
'****************************************************************
Public Function URLDecode(str)
Dim i, Ret, M, C, C2
i=1: Ret = ""
Do
if i> Len(str) Then Exit Do
M = Mid(str,i,1)
if M = "%" Then
C = Mid(str,i+1,2): i = i + 2
if Left(C,1) = "E" Then
C2 = Mid(str,i+1,6): i = i + 6: Ret = Ret & URLDecodeChar(C & C2)
Else
Ret = Ret & ChrW("&H" & C)
End if
Else
Ret = Ret & M
End if
i=i+1
Loop
URLDecode = Ret
End Function
'// 글자 디코딩
Private Function URLDecodeChar(S)
Dim Code, C1, C2, C3, C4, C5, C6, X
Code = Replace(S, "%", "")
C1 = Left(Code, 1) ' E
C2 = Mid(Code, 2, 1) ' <- 1
C3 = Mid("00011011",(Instr("89AB",Mid(Code, 3, 1))-1)*2+1,2)
C4 = URLDecodeHtob(Mid(Code, 4, 1))
C5 = Mid("00011011",(Instr("89AB",Mid(Code, 5, 1))-1)*2+1,2)
C6 = Mid(Code, 6, 1) ' <- 4
X = C3 & C4 & C5
X = ChrW(Cint("&H" & C2 & URLDecodeBtoh(Left(X, 4)) & URLDecodeBtoh(Right(X, 4)) & C6))
URLDecodeChar = X
End Function
'// 2진수를 16진수로
Private Function URLDecodeBtoh(X)
URLDecodeBtoh = Mid("0123456789ABCDEF",(Instr("0000,0001,0010,0011,0100,0101,0110,0111,1000,1001,1010,1011,1100,1101,1110,1111,",X&",")-1)/5+1,1)
End Function
'// 16진수를 2진수로
Private Function URLDecodeHtob(X)
If X <> "" Then URLDecodeHtob = Split("0000,0001,0010,0011,0100,0101,0110,0111,1000,1001,1010,1011,1100,1101,1110,1111", ",")(Cint("&H"&X))
End Function
'****************************************************************
'* 함수설명 : 16진수를 10진수로 바꾸는 함수
'* 변수설명 : num = 16진수값
'****************************************************************
Function Hex2Dec(num)
Hex2Dec = Int("&H" & num)
End Function
'****************************************************************
'* 함수설명 : 10진수를 2진수로 바꾸는 함수
'* 변수설명 : num = 10진수값
'****************************************************************
Function Dec2Hex(num)
Dim str10, str16, en
str10 = "0|1|2|3|4|5|6|7|8|9|10|11|12|13|14|15|16|17|18|19"
str10 = Split(str10, "|")
str16 = "0|1|2|3|4|5|6|7|8|9|A|B|C|D|E|F|10|11|12|13"
str16 = Split(str16, "|")
Dec2Hex = str16(Int(num / 16))
en = num Mod 16
Dec2Hex = Dec2Hex & str16(en)
End Function
'****************************************************************
'* 함수설명 : 신규 게시물 체크
'* 변수설명 : intTime = 신규 게시물 출력 시간
'* 변수설명 : strRegDate = 게시물 등록시간
'****************************************************************
Function GetNewTime(intTime, strRegDate)
If intTime = 0 Then
GetNewTime = False
Else
If Int(Datediff("h", strRegDate, Now)) < Int(intTime) Then GetNewTime = True Else GetNewTime = False
End If
End Function
'****************************************************************
'* 함수설명 : 폼메일 발송 함수
'* 변수설명 : strSendName = 보내는 사람 이름
'* strSendMail = 보내는 사람의 메일주소
'* strRecvName = 받는 사람 이름
'* strRecvMail = 받는 사람의 메일주소
'* strSubject = 메일 제목
'* strContent = 메일내용
'* strRecvBccMail = 참조
'* strRecvCcMail = 숨은참조
'* sendFileName = 첨부파일
'****************************************************************
Function sendEmail(strSendName, strSendMail, strRecvName, strRecvMail, strSubject, strContent, strRecvBccMail, strRecvCcMail, sendFileName)
On Error Resume Next
Dim arrAttachFile, j, objMail, objConf
arrAttachFile = Split(sendFileName, ",")
Set objMail = Server.CreateObject("CDO.Message")
Set objConf = Server.CreateObject("CDO.Configuration")
With objConf.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "210.116.77.71"
.Item("http://schemas.microsoft.com/cdo/configuration/sendemailaddress") = strSendName &" <"& strSendMail &">"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpuserreplyemailaddress") = strSendName &" <"& strSendMail &">"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
.Update
End With
SET objMail.Configuration = objConf
objMail.From = strSendName & "<" & strSendMail & ">"
objMail.ReplyTo = ""
If strRecvName <> "" Then
objMail.To = strRecvName & "<" & strRecvMail & ">"
Else
objMail.To = strRecvMail
End If
If strRecvBccMail <> "" Then objMail.Bcc = strRecvBccMail
If strRecvCcMail <> "" Then objMail.cc = strRecvCcMail
objMail.Subject = strSubject
objMail.HTMLBody = strContent
If UBound(arrAttachFile) > -1 Then
For j=0 To UBound(arrAttachFile)
objMail.AddAttachment(arrAttachFile(j))
Next
End If
objMail.BodyPart.Charset = "EUC-KR"
objMail.HTMLBodyPart.Charset = "EUC-KR"
objMail.Send
Set objConf = Nothing
Set objMail = Nothing
sendEmail = Err.Number
End Function
Function sendEmailSmtpSvr(strSendName, strSendMail, strRecvName, strRecvMail, strSubject, strContent, strRecvBccMail, strRecvCcMail, sendFileName)
On Error Resume Next
Dim strSmtpServer
Dim objMail, objConf
strSendName = NullReplace(strSendName, "HelloTravel")
strSendMail = NullReplace(strSendMail, "sender@hellotravel.kr")
Set objMail = Server.CreateObject("CDO.Message")
Set objConf = objMail.Configuration
With objConf.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.mailplug.co.kr"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpaccountname") = strSendMail
.Item("http://schemas.microsoft.com/cdo/configuration/sendemailaddress") = strSendName &" <"& strSendMail &">"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpuserreplyemailaddress") = strSendName &" <"& strSendMail &">"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "sender@hellotravel.kr"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "hellotravel12#$"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
.Update
End With
objMail.From = strSendName & "<" & strSendMail & ">"
objMail.ReplyTo = ""
objMail.To = strRecvName & "<" & strRecvMail & ">"
If strRecvBccMail <> "" Then objMail.Bcc = strRecvBccMail
If strRecvCcMail <> "" Then objMail.cc = strRecvCcMail
objMail.Subject = strSubject
objMail.HTMLBody = strContent
If sendFileName <> "" Then
If FileExists(sendFileName) Then objMail.AddAttachment(sendFileName)
End If
objMail.BodyPart.Charset = "UTF-8"
objMail.HTMLBodyPart.Charset = "UTF-8"
objMail.Send
Set objConf = Nothing
Set objMail = Nothing
sendEmailSmtpSvr = Err.Number
End Function
Function sendEmailLocal(strSendName, strSendMail, strRecvName, strRecvMail, strSubject, strContent, strRecvBccMail, strRecvCcMail, sendFileName)
On Error Resume Next
Dim arrAttachFile, j, objMail, objConf
arrAttachFile = Split(sendFileName, ",")
Set objMail = Server.CreateObject("CDO.Message")
Set objConf = objMail.Configuration
With objConf.Fields
.item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverpickupdirectory") = "E:\mailroot\pickup"
.item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "210.116.77.88"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
.Update
End With
objMail.From = strSendName & "<" & strSendMail & ">"
objMail.ReplyTo = ""
If strRecvName <> "" Then
objMail.To = strRecvName & "<" & strRecvMail & ">"
Else
objMail.To = strRecvMail
End If
If strRecvBccMail <> "" Then objMail.Bcc = strRecvBccMail
If strRecvCcMail <> "" Then objMail.cc = strRecvCcMail
objMail.Subject = strSubject
objMail.HTMLBody = strContent
If UBound(arrAttachFile) > -1 Then
For j=0 To UBound(arrAttachFile)
objMail.AddAttachment(arrAttachFile(j))
Next
End If
'objMail.BodyPart.Charset = "UTF-8"
'objMail.HTMLBodyPart.Charset = "UTF-8"
objMail.Send
Set objConf = Nothing
Set objMail = Nothing
sendEmailLocal = Err.Number
End Function
'****************************************************************
'* 함수설명 : BIT값 변환함수
'* 변수설명 : strBit = 변환될 변수값 (True 또는 False)
'****************************************************************
Function GetTrueFalse(strBit)
If strBit = True Then GetTrueFalse = "1" Else GetTrueFalse = "0"
End Function
' ***************************************************************
' * 함수설명 : 체크박스 폼 전송값 반환함수 *
' * 변수설명 : str = 입력값 *
' ***************************************************************
Function GetRequestCheckBox(str)
If str = "" Then GetRequestCheckBox = "0" Else GetRequestCheckBox = "1"
End Function
'****************************************************************
'* 함수설명 : Radio Form 구성 함수
'* 변수설명 : strForm = 폼 이름
'* arrStr = 폼 배열 값 (1,제목|2,내용)
'* chkValue = 선택된 값
'* setClass = 클래스설정
'* setEvent = 이벤트 설정 ( onClick='alert(''데스트'')' )
'****************************************************************
Function SetRadioForm(ByVal strForm, ByVal arrStr, ByVal chkValue, ByVal setClass, ByVal setEvent)
Dim i, Checked, arrValue, rtnString
rtnString = ""
If setClass <> "" Then setClass = " "& setClass
If setEvent <> "" Then setEvent = " "& setEvent
If arrStr <> "" And IsNull(arrStr) = False Then
arrStr = Split(arrStr, "|")
For i=0 To Ubound(arrStr)
arrValue = Split(arrStr(i), ",")
If Trim(arrValue(0)) = Trim(chkValue) Then Checked = " checked=""checked""" Else Checked = ""
rtnString = rtnString &""
rtnString = rtnString &""
Next
End If
SetRadioForm = rtnString
End Function
Function SetRadioForm2(ByVal strForm, ByVal arrStr, ByVal chkValue, ByVal setClass, ByVal setEvent, ByVal strLabel)
Dim i, Checked, arrValue, rtnString
rtnString = ""
If setClass <> "" Then setClass = " "& setClass
If setEvent <> "" Then setEvent = " "& setEvent
If arrStr <> "" And IsNull(arrStr) = False Then
arrStr = Split(arrStr, "|")
For i=0 To Ubound(arrStr)
arrValue = Split(arrStr(i), ",")
If Trim(arrValue(0)) = Trim(chkValue) Then Checked = " checked=""checked""" Else Checked = ""
rtnString = rtnString &""
rtnString = rtnString &""
Next
End If
SetRadioForm2 = rtnString
End Function
Function SetRadioForm3(strForm, arrStr, chkValue, setClass, setEvent, strLabel)
Dim i, Checked, arrValue, rtnString
rtnString = ""
If setClass <> "" Then setClass = " "& setClass
If setEvent <> "" Then setEvent = " "& setEvent
If arrStr <> "" And IsNull(arrStr) = False Then
arrStr = Split(arrStr, "{{|}}")
For i=0 To Ubound(arrStr)
arrValue = Split(arrStr(i), "|^|")
If Trim(arrValue(0)) = Trim(chkValue) Then Checked = " checked=""checked""" Else Checked = ""
rtnString = rtnString &""
rtnString = rtnString &""
Next
End If
SetRadioForm3 = rtnString
End Function
'****************************************************************
'* 함수설명 : CheckBox Form 구성 함수
'* 변수설명 : strFotm = 폼이름
'* arrStr = 폼 배열 값 (1,제목|2,내용)
'* chkValue = 선택된 값
'* setClass = 클래스설정
'* setEvent = 이벤트 설정 ( onClick='alert(''데스트'')' )
'****************************************************************
Function SetCheckboxForm(strForm, arrStr, chkValue, setClass, setEvent)
Dim strClass, i, arrValue, Checked, rtnString, arrChkValue, c
rtnString = ""
arrChkValue = Split(chkValue, ",")
If setClass <> "" Then setClass = " "& setClass
If setEvent <> "" Then setEvent = " "& setEvent
If arrStr <> "" And IsNull(arrStr) = False Then
arrStr = Split(arrStr, "|")
For i = 0 To Ubound(arrStr)
arrValue = Split(arrStr(i), ",")
Checked = ""
If Ubound(arrChkValue) > -1 Then
For c = 0 To Ubound(arrChkValue)
If Trim(arrChkValue(c)) = Trim(arrValue(0)) Then Checked = " checked=""checked"""
Next
Else
If Trim(chkValue) = Trim(arrValue(0)) Then Checked = " checked=""checked"""
End If
rtnString = rtnString &""
rtnString = rtnString &""
Next
End If
arrStr = Join(arrStr, "|")
SetCheckboxForm = rtnString
End Function
Function SetCheckboxForm2(strForm, arrStr, chkValue, setClass, setEvent, strLabel)
Dim strClass, i, arrValue, Checked, rtnString, arrChkValue, c
rtnString = ""
arrChkValue = Split(chkValue, ",")
If setClass <> "" Then setClass = " "& setClass
If setEvent <> "" Then setEvent = " "& setEvent
If strLabel <> "" Then strLabel = " "& strLabel
If arrStr <> "" And IsNull(arrStr) = False Then
arrStr = Split(arrStr, "|")
For i = 0 To Ubound(arrStr)
arrValue = Split(arrStr(i), ",")
Checked = ""
If Ubound(arrChkValue) > -1 Then
For c = 0 To Ubound(arrChkValue)
If Trim(arrChkValue(c)) = Trim(arrValue(0)) Then Checked = " checked=""checked"""
Next
Else
If Trim(chkValue) = Trim(arrValue(0)) Then Checked = " checked=""checked"""
End If
rtnString = rtnString &""
rtnString = rtnString &""
Next
End If
arrStr = Join(arrStr, "|")
SetCheckboxForm2 = rtnString
End Function
Function SetCheckboxForm3(strForm, arrStr, chkValue, setClass, setEvent, strLabel)
Dim strClass, i, arrValue, Checked, rtnString, arrChkValue, c
rtnString = ""
arrChkValue = Split(chkValue, "|^|")
If setClass <> "" Then setClass = " "& setClass
If setEvent <> "" Then setEvent = " "& setEvent
If strLabel <> "" Then strLabel = " "& strLabel
If arrStr <> "" And IsNull(arrStr) = False Then
arrStr = Split(arrStr, "{{|}}")
For i = 0 To Ubound(arrStr)
arrValue = Split(arrStr(i), "|^|")
Checked = ""
If Ubound(arrChkValue) > -1 Then
For c = 0 To Ubound(arrChkValue)
If Trim(arrChkValue(c)) = Trim(arrValue(0)) Then Checked = " checked=""checked"""
Next
Else
If Trim(chkValue) = Trim(arrValue(0)) Then Checked = " checked=""checked"""
End If
rtnString = rtnString &""
rtnString = rtnString &""
Next
End If
arrStr = Join(arrStr, "{{|}}")
SetCheckboxForm3 = rtnString
End Function
Function SetCheckboxFixForm(strForm, arrStr, chkValue, setWidth)
Dim strClass, i, arrValue, Checked, rtnString, arrChkValue, c
rtnString = ""
rtnString = rtnString &"
"
arrChkValue = Split(chkValue,"|")
If setWidth <> "" Then setWidth = " style=""width:"& setWidth &";"""
If arrStr <> "" And IsNull(arrStr) = False Then
arrStr = Split(arrStr, "|")
For i = 0 To Ubound(arrStr)
arrValue = Split(arrStr(i), ",")
Checked = ""
If Ubound(arrChkValue) > -1 Then
For c = 0 To Ubound(arrChkValue)
If Trim(arrChkValue(c)) = Trim(arrValue(0)) Then Checked = " checked=""checked"""
Next
Else
If Trim(chkValue) = Trim(arrValue(0)) Then Checked = " checked=""checked"""
End If
rtnString = rtnString &""
rtnString = rtnString &""
rtnString = rtnString &""
rtnString = rtnString &""
Next
End If
rtnString = rtnString &"
"
arrStr = Join(arrStr, "|")
SetCheckboxFixForm = rtnString
End Function
'****************************************************************
'* 함수설명 : Select Form 구성 함수
'* 변수설명 : strForm = 폼 이름
'* arrFirstOpt = 처음옵션
'* arrStr = 폼 배열 값 (1,제목,style|2,내용,style)
'* chkValue = 선택된 값
'* setClass = 클래스설정
'* setEvent = 이벤트 설정 ( onClick='alert(''데스트'')' )
'****************************************************************
Function SetSelectForm(ByVal strForm, ByVal arrFirstOpt, ByVal arrStr, ByVal setValue, ByVal setClass, ByVal setEvent)
Dim i, Selected, strStyle, arrValue, rtnString
rtnString = ""
If setClass <> "" Then setClass = " "& setClass
If setEvent <> "" Then setEvent = " "& setEvent
rtnString = rtnString & ""
SetSelectForm = rtnString
End Function
Function SetSelectForm2(ByVal strForm, ByVal arrFirstOpt, ByVal arrStr, ByVal setValue, ByVal setClass, ByVal setEvent)
Dim i, Selected, strStyle, arrValue, rtnString
rtnString = ""
If setClass <> "" Then setClass = " "& setClass
If setEvent <> "" Then setEvent = " "& setEvent
rtnString = rtnString & ""
SetSelectForm2 = rtnString
End Function
'****************************************************************
'* 함수설명 : 에러 메세지 출력
'* 변수설명 : strCode = 코드 (필수)
'* strMsg = 출력메세지 (필수)
'****************************************************************
Sub ErrorMsg(strCode, strMsg)
Dim JSON : Set JSON = New aspJSON
Set JSON.data("status") = JSON.Collection()
JSON.data("status").Add "code", strCode
JSON.data("status").Add "message", strMsg
Response.Clear
Response.ContentType = "application/json"
Response.Write JSON.JSONoutput()
Set JSON = Nothing
Response.End
End Sub
'****************************************************************
'* 함수설명 : 에러 메세지 출력 (Alert)
'* 변수설명 : strMsg = 출력메세지 (필수)
'* flag = 메세지 출려후 액션 (필수)
'* strUrl = 이동할 페이지
'****************************************************************
Sub ErrorMsgAlert(strMsg, flag, strUrl)
Response.Write ""
Response.End
End Sub
'****************************************************************
'* 함수설명 : Null값 에러
'* 변수설명 : str = 체크 할 값 (필수)
'* strMsg = 출력메세지 (필수)
'****************************************************************
Sub NullCheck(str, strMsg)
If Trim(str) = "" Or isNull(Trim(str)) Then
Call ErrorMsg("0", strMsg)
End If
End Sub
Sub NullCheckAlert(str, strMsg, flag, strUrl)
If Trim(str) = "" Or isNull(Trim(str)) Then
Call ErrorMsgAlert(strMsg, flag, strUrl)
End If
End Sub
'****************************************************************
'* 함수설명 : 널잢을 다른값으로 대체
'* 변수설명 : str = 입력값
'* strReplace = 널값일경우 변경할값
'****************************************************************
Function NullReplace(str,strReplace)
If str = "" Or IsNull(str) Then
NullReplace = strReplace
Else
NullReplace = str
End If
End Function
'****************************************************************
'* 함수설명 : Null값 체크
'* 변수설명 : str = 체크 할 값
'****************************************************************
Function bitNull(str)
If Trim(str) = "" Or isNull(Trim(str)) Then
bitNull = True
Else
bitNull = False
End If
End Function
Function bitNotNull(str)
If Trim(str) = "" Or isNull(Trim(str)) Then
bitNotNull = False
Else
bitNotNull = True
End If
End Function
'****************************************************************
'* 함수설명 : 문자열 암호화 함수
'* 변수설명 : PlainText = 입력값
'****************************************************************
Function Encrypt(str)
Dim obj, key1, key2
If Trim(str) <> "" Then
Set obj = Server.CreateObject("Hoyasoft.StrCipher")
key1 = 267982127 : key2 = 944564583
Encrypt = obj.Encrypt(str, key1, key2)
Set obj = nothing
Else
Encrypt = str
End If
End Function
'****************************************************************
'* 함수설명 : 문자열 복호화 함수
'* 변수설명 : PlainText = 입력값
'****************************************************************
Function Decrypt(str)
Dim obj, key1, key2
On Error Resume Next
If Trim(str) <> "" Then
Set obj = Server.CreateObject("Hoyasoft.StrCipher")
key1 = 267982127 : key2 = 944564583
Decrypt = Trim(obj.Decrypt(str, key1, key2))
Set obj = nothing
Else
Decrypt = str
End If
If Err.Number <> 0 Then
Decrypt = str
End If
End Function
'****************************************************************
'* 함수설명 : 인젝션 공격 체크
'* 변수설명 : strRequest = QueryString, intMethod = 변경방법
'****************************************************************
Function InjectionCheck(strRequest, intMethod)
Dim intBadCnt, strBadWords, arrBadWords, strWord, strReChar
If Len(strRequest) > 80 Then
intBadCnt = 0
strBadWords = ";|--|@@|/*|*/|exec(|execute(|cast(|sysobjects|sysadmin|char(|varchar(|declare|syscolumns|drop table|drop column|alter table|alter column|select|convert("
arrBadWords = split(strBadWords, "|")
For Each strWord In arrBadWords
If inStr(LCase(strRequest),strWord) > 0 Then
intBadCnt = intBadCnt + 1
End If
Next
If intBadCnt > 5 Then
InjectionCheckLog(strRequest)
For Each strWord In arrBadWords
If inStr(LCase(strRequest),strWord) > 0 Then
If intMethod = 1 Then
strReChar = ""
Else
strReChar = "{^["& strWord &"]^}"
End If
strRequest = Replace(strRequest,strWord,strReChar)
End If
Next
End If
End If
InjectionCheck = strRequest
End Function
'****************************************************************
'* 함수설명 : 인젝션 공격 로그저장
'* 변수설명 :
'****************************************************************
Function InjectionCheckLog(QueryString)
Dim objXML, bitFileExist, objXmlData, intIdx, xmlLogFile
On Error Resume Next
Set objXML = server.CreateObject("Microsoft.XMLDOM")
objXML.async = False
xmlLogFile = "/injection_log.xml"
bitFileExist = objXML.load(server.MapPath(xmlLogFile))
If bitFileExist = False Then
objXML.appendChild(objXML.createProcessingInstruction("xml","version=""1.0"""))
objXML.appendChild(objXML.createElement("IP_LOGS"))
intIdx = 1
Else
intIdx = objXML.documentElement.childNodes(objXML.documentElement.childNodes.length - 1).childNodes(0).text + 1
End If
Set objXmlData = objXML.createElement("IP_LOG")
objXmlData.appendChild(objXML.createElement("ID"))
objXmlData.appendChild(objXML.createElement("QUERY_STRING"))
objXmlData.appendChild(objXML.createElement("HTTP_REFERER"))
objXmlData.appendChild(objXML.createElement("REMOTE_ADDR"))
objXmlData.appendChild(objXML.createElement("LOCAL_ADDR"))
objXmlData.appendChild(objXML.createElement("DATE"))
objXmlData.childNodes(0).text = intIdx
objXmlData.childNodes(1).text = Request.ServerVariables("SCRIPT_NAME") &"?"& QueryString
objXmlData.childNodes(2).text = Request.ServerVariables("HTTP_REFERER")
objXmlData.childNodes(3).text = Request.ServerVariables("REMOTE_ADDR")
objXmlData.childNodes(4).text = Request.ServerVariables("LOCAL_ADDR")
objXmlData.childNodes(5).text = Now()
objXML.documentElement.appendChild(objXmlData.cloneNode(True))
objXML.save(server.MapPath(xmlLogFile))
Set objXmlData = Nothing
Set objXML = Nothing
End Function
'****************************************************************
'* 함수설명 : Round 함수
'* 변수설명 : intVal = 값 , intFlag = 자리수
'****************************************************************
Function GetRound(intVal,intFlag)
Dim temp, i
temp = 5
For i=0 To intFlag+1
temp = temp / 10
Next
GetRound = Round(intVal+temp,intFlag)
End Function
'****************************************************************
'* 함수설명 : 캐릭터셋 변환 함수
'* 변수설명 : str = 문자값 , charset = 변환될 캐릭터셋(UTF-8)
'****************************************************************
Function CharsetConvert(str, charset)
Dim Stream, rtnStr
set Stream = Server.CreateObject("ADODB.Stream")
Stream.Type = 2
Stream.Open
Stream.Charset = charset
Stream.Position = 0
Stream.WriteText str
Stream.Position = 3
rtnStr = Stream.ReadText
Stream.close
Set Stream = Nothing
CharsetConvert = rtnStr
End Function
'****************************************************************
'* 함수설명 : 문자 하나만 가져오기 함수
'* 변수설명 : str = 문자열, num = 문자위치, flag = 1:앞에서 부터 2:뒤에서 부터
'****************************************************************
Function getOneChar(str, num, flag)
Dim strRtn : strRtn = ""
If flag = 1 Then
If Len(str) >= num Then
strRtn = Mid(CStr(str),num,1)
If Len(strRtn) = 0 Then strRtn = ""
End If
Else
If Len(str) >= num Then
strRtn = Left(Right(CStr(str),num),1)
If Len(strRtn) = 0 Then strRtn = ""
End If
End If
getOneChar = strRtn
End Function
'****************************************************************
'* 함수설명 : 3자리마다 콤마찍기
'* 변수설명 : intMoney = 금액, point = 소숫점
'****************************************************************
Function getCurrency(intMoney, point)
If isNumeric(intMoney) Then
If Left(UCase(point),1) = "X" Then
Dim arrMoney
point = Right(point, Len(point) - 1)
arrMoney = Split(intMoney, ".")
If UBound(arrMoney) > 0 Then
If Len(point) = 0 Then
point = Len(arrMoney(1))
End If
getCurrency = FormatNumber(intMoney, Int(point))
Else
getCurrency = FormatNumber(intMoney, 0)
End If
Else
getCurrency = FormatNumber(intMoney, point)
End If
Else
getCurrency = 0
End If
End Function
Function getCurrencyNull(intMoney, point)
Dim intCurrency
intCurrency = getCurrency(intMoney, point)
If intCurrency = 0 Then
getCurrencyNull = ""
Else
getCurrencyNull = intCurrency
End If
End Function
'****************************************************************
'* 함수설명 : 랜덤키 생성
'****************************************************************
Function rndKey()
Dim strTime, RndSerial
Randomize
strTime = Replace(Date(),"-","") & datepart("h",Now) & Right("0" & datepart("n",Now),2) & Right("0" & datepart("s",Now),2)
RndSerial = Int((89990 * Rnd) + 10000)
rndKey = strTime & RndSerial
End Function
'****************************************************************
'* 함수설명 : 현재 페이지 URL
'* 변수설명 : flag = URL 인코딩여부(1 or 0)
'****************************************************************
Function getCurrUrl(flag)
Dim strServerName, strPathInfo, strQueryString
strServerName = Request.ServerVariables("SERVER_NAME")
strPathInfo = Replace(Request.ServerVariables("PATH_INFO"),"index.asp","")
strQueryString = Request.ServerVariables("QUERY_STRING")
If strQueryString <> "" Then strQueryString = "?"&strQueryString
If flag = 0 Then
getCurrUrl = "http://"& strServerName & strPathInfo & strQueryString
Else
getCurrUrl = Server.URLEncode("http://"& strServerName & strPathInfo & strQueryString)
End If
End Function
'****************************************************************
'* 함수설명 : 전체 페이지수
'* 변수설명 : intTotalCount=총 게시물수, intPageSize=페이지 사이즈
'****************************************************************
Function getTotalPage(intTotalCount, intPageSize)
If (intTotalCount Mod intPageSize) = 0 Then
getTotalPage = intTotalCount \ intPageSize
Else
getTotalPage = intTotalCount \ intPageSize + 1
End If
End Function
'****************************************************************
'* 함수설명 : TimeStamp
'****************************************************************
Function getTimeStamp()
getTimeStamp = DateDiff("s", CDate("1970-01-01 00:00:00"), now()) - (9*60*60)
End Function
'****************************************************************
'* 함수설명 : 한글자소분리
'* 변수설명 : strString = 문자, strSeparator = 자소분리 구분 문자
'****************************************************************
Function hangulToJaso(strString, strSeparator)
Dim rtnResult : rtnResult = ""
Dim ChoSeong, JungSeong, JongSeong
Dim i, iCho, iJung, iJong
ChoSeong = Array("ㄱ", "ㄲ", "ㄴ", "ㄷ", "ㄸ", "ㄹ", "ㅁ", "ㅂ", "ㅃ", "ㅅ", "ㅆ", "ㅇ", "ㅈ", "ㅉ", "ㅊ", "ㅋ", "ㅌ", "ㅍ", "ㅎ")
JungSeong = Array("ㅏ", "ㅐ", "ㅑ", "ㅒ", "ㅓ", "ㅔ", "ㅕ", "ㅖ", "ㅗ", "ㅘ", "ㅙ", "ㅚ", "ㅛ", "ㅜ", "ㅝ", "ㅞ", "ㅟ", "ㅠ", "ㅡ", "ㅢ", "ㅣ")
JongSeong = Array(" ", "ㄱ", "ㄲ", "ㄳ", "ㄴ", "ㄵ", "ㄶ", "ㄷ", "ㄹ", "ㄺ", "ㄻ", "ㄼ", "ㄽ", "ㄾ", "ㄿ", "ㅀ", "ㅁ", "ㅂ", "ㅄ", "ㅅ", "ㅆ", "ㅇ", "ㅈ", "ㅊ", "ㅋ", "ㅌ", "ㅍ", "ㅎ")
For i=1 To Len(strString)
If Len(rtnResult) > 0 Then rtnResult = rtnResult & strSeparator
'// 한글인경우
If AscW(Mid(strString, i, 1)) >= -21504 And AscW(Mid(strString, i, 1)) <= -10333 Then
iJong = AscW(Mid(strString, i, 1)) - AscW("가")
iCho = Int(iJong / (21*28))
iJong = iJong mod (21*28)
iJung = Int(iJong / 28)
iJong = iJong mod 28
rtnResult = rtnResult & ChoSeong(iCho) & strSeparator & JungSeong(iJung)
If iJong > 0 Then
rtnResult = rtnResult & strSeparator & JongSeong(iJong)
End If
'// 한글이 아닌경우
Else
rtnResult = rtnResult & Mid(strString, i, 1)
End IF
Next
hangulToJaso = rtnResult
End Function
'****************************************************************
'* 함수설명 : 날짜 여부 체크
'* 변수설명 : val = 입력값, rep = 리턴값
'****************************************************************
Function CheckDate(val, rep)
If Not IsDate(val) Then val = rep
CheckDate = val
End Function
'****************************************************************
'* 함수설명 : 숫자 여부 체크
'* 변수설명 : val = 입력값, rep = 리턴값
'****************************************************************
Function CheckNumeric(val, rep)
If Not IsNumeric(val) Then val = rep
CheckNumeric = val
End Function
'****************************************************************
'* 함수설명 : 이메일 검사
'* 변수설명 : strEMail = 이메일 주소
'****************************************************************
Function IsEmail(strEmail)
Dim objRegExpr
Set objRegExpr = New RegExp
objRegExpr.Pattern = "^[a-zA-Z0-9][\w\.-]*[a-zA-Z0-9\-\_]@[\w-\.]*[a-zA-Z0-9]\.[a-zA-Z]{2,7}$"
objRegExpr.Global = True
objRegExpr.IgnoreCase = False
IsEmail = objRegExpr.Test(strEmail)
Set objRegExpr = Nothing
End Function
'****************************************************************
'* 함수설명 : 시간 검사
'* 변수설명 : str = 시간
'****************************************************************
Function IsTime(str)
if str = "" then
IsTime = false
Else
On Error Resume Next
TimeValue(str)
If Err.number = 0 Then
IsTime = True
Else
IsTime = False
End If
End If
End Function
'****************************************************************
'* 함수설명 : 빈값인지 체크
'****************************************************************
Sub isItNull(strValue, strMsg, strFlag, strUrl)
If Trim(strValue) = "" Or IsNull(Trim(strValue)) Then
Call actionAlarm(strMsg, strFlag, strUrl)
End If
End Sub
'****************************************************************
'* 액션 등 dtd 선언이 없을 경우 사용하는 alert
'****************************************************************
Sub actionAlarm(strMsg, strFlag, strUrl)
Dim strAlertHtml : strAlertHtml = ""
If strFlag = "json" Then
strAlertHtml = strAlertHtml & "{""status"":"""& strUrl &""", ""message"":"""& strMsg &"""}"
ElseIf strFlag = "fancy" Then
strAlertHtml = strAlertHtml & ""
ElseIf strFlag = "selffancy" Then
strAlertHtml = strAlertHtml & ""
Else
strAlertHtml = strAlertHtml & strDoctypeHtml
strAlertHtml = strAlertHtml & ""& vbCrLf
strAlertHtml = strAlertHtml & strHeadMetaTag
strAlertHtml = strAlertHtml & ""& sysCompName &" - 경고창"& vbCrLf
strAlertHtml = strAlertHtml & ""& vbCrLf
strAlertHtml = strAlertHtml & ""& vbCrLf
strAlertHtml = strAlertHtml & ""& vbCrLf
strAlertHtml = strAlertHtml & ""& vbCrLf
strAlertHtml = strAlertHtml & ""& vbCrLf
strAlertHtml = strAlertHtml & "