ASP용 함수정리

이번에 작업하면서 ASP함수 정리한거 기록남김.

라이브러리 파일로 만들어 인클루드 사용

- 기존에 잘되던것들이 안되는경우가 있음. : 안되던것들 되는걸로 업데이트

- 환경 UTF8

===========================================================================

'편하게 사용하기 위한 상수설정 ( Const  로 선언하든지 변수로 사용해도 무방 )

Start_Dir = "m/"

HTTP_HOST = Request.ServerVariables("HTTP_HOST")

HOME = "http://" & Request.ServerVariables("HTTP_HOST") & "/" & Start_Dir

LINK = "http://" & Request.ServerVariables("HTTP_HOST") & "/" & Start_Dir

IMAGE = "http://" & Request.ServerVariables("HTTP_HOST") & "/" & Start_Dir & "/"

ASPSELF = REQUEST("SCRIPT_NAME")

REQUEST_URI_PRE = ASPSELF & "?" & Request.QueryString()

REQUEST_URI = Server.URLEncode(REQUEST_URI_PRE)

REMOTE_ADDR = Request.ServerVariables("REMOTE_ADDR")

HTTP_USER_AGENT = Request.ServerVariables("HTTP_USER_AGENT")

HTTP_REFERER = Request.ServerVariables("HTTP_REFERER")

ROOT_DIR = Server.MapPath("/")

ROOT_DIR_HOME = Server.MapPath("/") &  "\" & Start_Dir

GUIDE_INFO = "<div style='font-size:12px;padding:5px;margin:5px; position:absolute;z-index:10000;background-color:#ffffff;'>" &_

  "[HTTP_HOST : " & HTTP_HOST & "]<br />" &_

  "[HOME : " & HOME & "]<br />" &_

  "[ASPSELF :  " & ASPSELF& "]<br />" &_

  "[REMOTE_ADDR :  " & REMOTE_ADDR& "]<br />" &_

  "[HTTP_USER_AGENT :  " & HTTP_USER_AGENT& "]<br />" &_

  "[LINK :  " & LINK& "]<br />" &_

  "[IMAGE :  " & IMAGE& "]<br />" &_

  "[REQUEST_URI_PRE : " & REQUEST_URI_PRE& "]<br />" &_

  "[REQUEST_URI : " & REQUEST_URI& "]<br />" &_

  "</div>"

===========================================================================

' 구글 GCM 함수 (인터넷에서 검색해서 나온소스 잘작동됨)

' GOOGLE_GCM_KEY 는 상수에서 설정(본인api서버키)

' ASP 용 구글 GCM 상세 내용( 발송및 json처리) 다른글로 정리

Function SendPushByAndroid(Byval Set_Data, Byval Set_UserPushCode)

On Error Resume Next

Dim param ,i

Dim XMLHTTPS(2)

Dim objHttp

Set objHttp = Server.CreateObject("Msxml2.ServerXMLHTTP")

Dim senddata    : senddata = ""

Dim gcmid    : gcmid = ""

Dim sURL

      ' 배열로 받는다

if not isarray(Set_Data) Then

SendPushByAndroid = 0

Exit Function

End If

' json

for i = 1 to Ubound(Set_Data,1)

senddata = senddata & """" & Set_Data(i,1) & """:""" & Set_Data(i,2) & """"

if i <> Ubound(Set_Data,1) Then

senddata = senddata & ","

End If

Next

'for i = 1 to Ubound(Set_UserPushCode,1)

for i = 0 to Ubound(Set_UserPushCode,1)

gcmid = gcmid & """" & Set_UserPushCode(i) & """"

if i <> Ubound(Set_UserPushCode,1) Then

gcmid = gcmid & ","

End If

Next

param = "{"

param = param & """collapse_key"" :""" & collapse_key & ""","

param = param & """data"":{" & senddata & "},""registration_ids"":["& gcmid &"]"

param = param & "}"

sURL = "https://android.googleapis.com/gcm/send"

'Response.write "sURL : " & sURL &"<br /><br />"

'Response.write "param : " & param &"<br /><br />"

objHttp.Open "POST", sURL, False

objHttp.SetRequestHeader "Content-Type","application/json"

objHttp.SetRequestHeader "Authorization","key=" & GOOGLE_GCM_KEY

objHttp.send param

XMLHTTPS(1) = objHttp.status

XMLHTTPS(2) = objHttp.responseText

If Err.Number <> 0 Then

XMLHTTPS(0)  = False

Else

XMLHTTPS(0)  = True

End If

'Response.write "XMLHTTPS(0) : " & XMLHTTPS(0) &"<br /><br />"

'Response.write "XMLHTTPS(1) : " & XMLHTTPS(1) &"<br /><br />"

'Response.write "XMLHTTPS(2) : " & XMLHTTPS(2) &"<br /><br />"

SendPushByAndroid = XMLHTTPS

End Function

===========================================================================

'문자열관련함수

' php 의 htmlspecialchars 와 비슷하게

Function htmlspecialchars(sStr)

htmlspecialchars = Replace( sStr, "&", "&amp;" )

htmlspecialchars = Replace( htmlspecialchars, ">", "&gt;" )

htmlspecialchars = Replace( htmlspecialchars, "<", "&lt;" )

htmlspecialchars = Replace( htmlspecialchars, """", "&quot;" )

htmlspecialchars = Replace( htmlspecialchars, "'", "&#039;" )

End Function

'htmlspecialchars 역변환

Function chars_HTML(sStr)

chars_HTML = Replace( sStr, "&amp;", "&" )

chars_HTML = Replace( chars_HTML, "&gt;", ">" )

chars_HTML = Replace( chars_HTML, "&lt;", "<" )

chars_HTML = Replace( chars_HTML, "&quot;" , """" )

chars_HTML = Replace( chars_HTML, "&#039;", "'" )

End Function

'태그제거

FUNCTION removeHTML(strHTML)

dim objRegExp

on error resume next

set objRegExp = New RegExp

With objRegExp

.Global = true

.IgnoreCase = true

.Pattern = "<[a-zA-Z\/\s][^>]*>"

strHTML = .Replace(strHTML, "")

end With

set objRegExp = nothing

removeHTML = strHTML

END FUNCTION

' 줄바꿈변환(라인피드->br)

Function nl2br(strText)

strText = Replace(strText, VbNewLine, "<br />")

strText = Replace(strText, VbCrLf, "<br />")

strText = Replace(strText, VbCr, "<br />")

strText = Replace(strText, VbLf, "<br />")

nl2br = strText

End Function

'줄바꿈 역변환 (br-> 라인피드)

Function br2nl(strText)

strText = Replace(strText, "<br />", VbNewLine)

strText = Replace(strText, "<br>", VbNewLine)

br2nl = strText

End Function

' 줄바꿈문자 제거

Function strip_br(strText)

strText = Replace(strText, VbNewLine, "")

strText = Replace(strText, VbCrLf, "")

strText = Replace(strText, VbCr, "")

strText = Replace(strText, VbLf, "")

strip_br = strText

End Function

' URL 디코딩

Function UrlDecode(ByVal str)

Dim B, ub, UtfB, UtfB1, UtfB2, UtfB3, i, n, s

n=0

ub=0

For i = 1 To Len(str)

B=Mid(str, i, 1)

Select Case B

Case "+"

s=s & " "

Case "%"

ub=Mid(str, i + 1, 2)

UtfB = CInt("&H" & ub)

If UtfB<128 Then

i=i+2

s=s & ChrW(UtfB)

Else

UtfB1=(UtfB And &H0F) * &H1000

UtfB2=(CInt("&H" & Mid(str, i + 4, 2)) And &H3F) * &H40

UtfB3=CInt("&H" & Mid(str, i + 7, 2)) And &H3F

s=s & ChrW(UtfB1 Or UtfB2 Or UtfB3)

i=i+8

End If

Case Else

s=s & B

End Select

Next

UrlDecode = s

End Function

'날짜관련 : 2014-03-03 11:11

FUNCTION view_date_time(target_date)

Dim yy,mm,dd,h,mi,result

yy= year(target_date)

mm = right("0" & month(target_date),2)

dd = right("0" & day(target_date),2)

h = right("0" & hour(target_date),2)

mi = right("0" & minute(target_date),2)

result = yy & "-" & mm & "-" & dd & " " & h & ":" & mi & ""

view_date_time = result

END Function

'날짜관련 : 2014-03-03 11:11:11

FUNCTION view_date_time2(target_date)

Dim yy,mm,dd,h,mi,result

yy= year(target_date)

mm = right("0" & month(target_date),2)

dd = right("0" & day(target_date),2)

h = right("0" & hour(target_date),2)

mi = right("0" & minute(target_date),2)

ss = right("0" & second(target_date),2)

result = yy & "-" & mm & "-" & dd & " " & h & ":" & mi & ":" &ss

view_date_time2 = result

END Function

'날짜관련 : 2014-03-03 

FUNCTION view_date(target_date)

Dim yy,mm,dd,h,mi,result

If Trim(target_date) = "" Then

view_date = "-"

else

yy= year(target_date)

mm = right("0" & month(target_date),2)

dd = right("0" & day(target_date),2)

result = yy & "-" & mm & "-" & dd

view_date = result

End if

END FUNCTION

'날짜관련 : 2014.03.03 11:11 

FUNCTION view_date2(target_date)

Dim yy,mm,dd,h,mi,result

yy= year(target_date)

mm = right("0" & month(target_date),2)

dd = right("0" & day(target_date),2)

h = right("0" & hour(target_date),2)

mi = right("0" & minute(target_date),2)

result = yy & "." & mm & "." & dd & " " & h & ":" & mi & ""

view_date2 = result

END FUNCTION

' 문자열 길이자르기

function cutString_len(ByVal szString, ByVal szLen)

if len(szString) > szLen then

cutString_len = left(szString,szLen) & "…"

Else

cutString_len = szString

end if

end Function

Function Word_check(str,patrn)

Dim regEx, match, matches

SET regEx = New RegExp

regEx.Pattern = patrn            ' 패턴을 설정합니다.

regEx.IgnoreCase = True            ' 대/소문자를 구분하지 않도록 합니다.

regEx.Global = True         ' 전체 문자열을 검색하도록 설정합니다.

SET Matches = regEx.Execute(str)

if 0 < Matches.count then

Word_check = false

Else

Word_check = true

end If

'pattern0 = "[^가-힣]"  '한글만

'pattern1 = "[^-0-9 ]"  '숫자만

'pattern2 = "[^-a-zA-Z]"  '영어만

'pattern3 = "[^-가-힣a-zA-Z0-9/ ]" '숫자와 영어 한글만

'pattern4 = "<[^>]*>"   '태그만

'pattern5 = "[^-a-zA-Z0-9/ ]"    '영어 숫자만

End Function

' 이메일형식체크

Function f_mailCheck(str_mail)

Dim obj_regExp

Set obj_regExp = New RegExp

With obj_regExp

.Pattern = "^([\w-\.]+)@((\[[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.)|(([\w-]+\.)+))([a-zA-Z]{2,4}|[0-9]{1,3})(\]?)$"

.IgnoreCase = True

f_mailCheck = .Test(str_mail)

End With

Set obj_regExp = Nothing

End Function

Function SQL_Injection( get_String )

   get_String = REPLACE( get_String, "'", "''" )

   get_String = REPLACE( get_String, ";", "" )

   get_String = REPLACE( get_String, "--", "" )

   get_String = REPLACE( get_String, "select", "", 1, -1, 1 )

   get_String = REPLACE( get_String, "insert", "", 1, -1, 1 )

   get_String = REPLACE( get_String, "update", "", 1, -1, 1 )

   get_String = REPLACE( get_String, "delete", "", 1, -1, 1 )

   get_String = REPLACE( get_String, "drop", "", 1, -1, 1 )

   get_String = REPLACE( get_String, "union", "", 1, -1, 1 )

   get_String = REPLACE( get_String, "and", "", 1, -1, 1 )

   get_String = REPLACE( get_String, "or", "", 1, -1, 1 )

   get_String = REPLACE( get_String, "1=1", "", 1, -1, 1 )

   get_String = REPLACE( get_String, "sp_", "", 1, -1, 1 )

   get_String = REPLACE( get_String, "xp_", "", 1, -1, 1 )

   get_String = REPLACE( get_String, "@variable", "", 1, -1, 1 )

   get_String = REPLACE( get_String, "@@variable", "", 1, -1, 1 )

   get_String = REPLACE( get_String, "exec", "", 1, -1, 1 )

   get_String = REPLACE( get_String, "sysobject", "", 1, -1, 1 )

   SQL_Injection = get_String

End Function

===========================================================================

'파일관련함수

FUNCTION make_dir(strPath)

DIM FSO, fldr

SET FSO = CreateObject("Scripting.FileSystemObject")

IF NOT(fso.FolderExists(strPath)) THEN

SET fldr = fso.CreateFolder(strPath)

END IF

SET FSO = NOTHING

End Function

FUNCTION Delete_dir(strPath)

DIM FSO, fldr

SET FSO = CreateObject("Scripting.FileSystemObject")

IF (fso.FolderExists(strPath))  THEN

fso.DeleteFolder(strPath)

END IF

SET FSO = NOTHING

End Function

FUNCTION Delete_File(strFileName)

DIM FSO

Set fso = Server.CreateObject("Scripting.FileSystemObject")

If fso.FileExists(strFileName) Then

fso.DeleteFile (strFileName)

End If

set FSO = Nothing

End Function

FUNCTION chk_image_ext(strFileName)

IF strFileName = "" OR ISNULL(strFileName) = True THEN

checkImageFileField = False

ELSE

DIM FileExe

FileExe = REPLACE(MID(strFileName, INSTRREV(strFileName, ".") + 1), ".", "")

SELECT CASE UCASE(FileExe)

'CASE "JPG", "GIF", "BMP", "PNG", "TIF"

CASE "JPG", "GIF",  "PNG"

chk_image_ext = True

CASE ELSE

chk_image_ext = False

END SELECT

END IF

End Function

FUNCTION chk_allow_file_ext(strFileName)

IF strFileName = "" OR ISNULL(strFileName) = True THEN

chk_allow_file_ext = False

ELSE

DIM FileExe

FileExe = REPLACE(MID(strFileName, INSTRREV(strFileName, ".") + 1), ".", "")

SELECT CASE UCASE(FileExe)

'CASE "JPG", "GIF", "BMP", "PNG", "TIF"

'CASE "JPG","GIF","PNG","JPEG","BMP","ZIP","RAR","ALZ","EGG","TXT","DOC","XLS","HWP","PDF"

CASE "JPG","GIF","PNG","JPEG","BMP","TXT","DOC","XLS","HWP","PDF"

chk_allow_file_ext = True

CASE ELSE

chk_allow_file_ext = False

END SELECT

END IF

End Function

Function File_Uploads_Generation(FileName,Path)

Set FSO = CreateObject("Scripting.FileSystemObject")

attach_file = FileName

FileName1 = Mid(attach_file, InstrRev(attach_file, "\") + 1)

strName = Mid(FileName1, 1, Instr(FileName1, ".") - 1)

strExt = Mid(FileName1, Instr(FileName1, ".") + 1)

FileName1 = strName & "." & strExt

bExist = True

strFileName = Path & FileName1

countFileName  = 0

Do While bExist

If (FSO.FileExists(strFileName)) Then

countFileName = countFileName  + 1

FileName1 = strName & "_" & countFileName & "." & strExt

strFileName = Path & FileName1

Else

bExist = False

End If

Loop

set FSO = Nothing

File_Uploads_Generation = FileName1

End Function

Function FileExists(Path)

Set fso = Server.CreateObject("Scripting.FileSystemObject")

strFileName = Path

If fso.FileExists(strFileName) Then

FileExists = true

Else

FileExists = false

End If

set FSO = Nothing

End Function

'파일명얻기

function Get_BaseFileName(attach_file)

   set fso =  server.createObject("Scripting.FilesystemObject")

   Get_BaseFileName = fso.GetBaseName(attach_file)&"."&fso.GetExtensionName(attach_file) 

   set fso = nothing

end Function

===========================================================================

'개발디버깅용 함수

' form 전송된 값 보기

Function print_r_form()

'If form_type = "GET" Then

'QueryString으로 넘어온값

'For Each item in Request.QueryString

' For index_i = 1 To Request.QueryString(item).Count

' Response.Write (item & " : " & Request.QueryString(item)(index_i) & "<br>")

' Next

'Next

Response.Write "<!doctype html><html lang='ko'><head><meta charset='utf-8' /></head><body>"

Response.Write "<br /><table cellpadding='5' cellspacing='1' border='0' bgcolor='#cccccc'>" &_

"<tr bgcolor='#000000'><th colspan='3' style='font-size:12px;color:#ffffff;'>GET Values</th></tr>" &_

"<tr bgcolor='#dfdfdf'><th style='font-size:12px;'>No</th><th style='font-size:12px;'>Key</th><th style='font-size:12px;'>Value</th></tr>"

seq = 1

For Each key in Request.QueryString

Response.Write "<tr bgcolor='#ffffff'>" &_

"<td width='35' style='font-size:12px;font-weight:bold;' bgcolor='#efefef' align='center'>" & seq &"</td>" &_

"<td style='font-size:12px;padding:0 20px 0 20px;font-weight:bold;'>" & Key & "</td>" &_

"<td style='font-size:12px;padding:0 20px 0 20px;'>" & Request.QueryString(key) & "</td>" &_

"</tr>"

seq = seq + 1

Next

Response.Write "</table>"

'Else

'Post로 넘어온값<br>

'For Each item in Request.Form

' For index_i = 1 To  Request.Form(item).Count

' Response.Write (item & " : " & Request.Form(item)(index_i) & "<br>")

' Next

'Next

Response.Write "<br /><table cellpadding='5' cellspacing='1' border='0' bgcolor='#cccccc'>" &_

"<tr bgcolor='#000000'><th colspan='3' style='font-size:12px;color:#ffffff;'>POST Values</th></tr>" &_

"<tr bgcolor='#dfdfdf'><th style='font-size:12px;'>No</th><th style='font-size:12px;'>Key</th><th style='font-size:12px;'>Value</th></tr>"

seq = 1

For Each key in Request.Form

Response.Write "<tr bgcolor='#ffffff'>" &_

"<td width='35' style='font-size:12px;font-weight:bold;' bgcolor='#efefef' align='center'>" & seq &"</td>" &_

"<td style='font-size:12px;padding:0 20px 0 20px;font-weight:bold;'>" & Key & "</td>" &_

"<td style='font-size:12px;padding:0 20px 0 20px;'>" & Request.Form(key) & "</td>" &_

"</tr>"

seq = seq + 1

Next

Response.Write "</table>"

'End if

End Function

' 배열 값보기

' http://dumbung.com/main/bbs/board.php?bo_table=ASP_TIP&wr_id=10

FUNCTION print_r_array(arr, mode)

'mode : in,

dim i, s_len, msg, val, sep, my_newLine, my_tab

'my_newLine = vbCrLf

my_newLine = "<br />"

if not IsArray(arr) then

'response.write "<br>배열이 아닙니다."

exit function

end if

my_tab = vbTab

my_tab = "    "

dim in_my_tab

if mode = "in" then

'in_my_tab = my_tab &  "    "

in_my_tab = my_tab &  "&nbsp;&nbsp;...&nbsp;&nbsp;"

else

in_my_tab = ""

end if

msg = ""

s_len = Ubound(arr)

for i=0 to s_len

val = arr(i)

sep = in_my_tab & my_tab & "[" &  i & "]" & " => "

if not IsArray(val) then

msg = msg & sep & val & my_newLine

else

mode = "in"

msg = msg & sep & print_r_array(val, mode)

end if

next

msg = "Array" &_

my_newLine &_

in_my_tab & "(" & my_newLine &_

msg &_

in_my_tab & ")" &_

my_newLine

response.write msg

'print_r_array = msg

END FUNCTION

' 세션보기

FUNCTION print_r_session()

Response.Write "<!doctype html><html lang='ko'><head><meta charset='utf-8' /></head><body>"

Response.Write "<br /><table cellpadding='5' cellspacing='1' border='0' bgcolor='#cccccc'>" &_

"<tr bgcolor='#000000'><th colspan='3' style='font-size:12px;color:#ffffff;'>SESSION Values</th></tr>" &_

"<tr bgcolor='#dfdfdf'><th style='font-size:12px;'>No</th><th style='font-size:12px;'>Key</th><th style='font-size:12px;'>Value</th></tr>"

seq = 1

For Each item in Session.Contents

Session_item = Session.Contents(item)

'객체인지 확인

Response.Write "<tr bgcolor='#ffffff'>" &_

"<td width='35' style='font-size:12px;font-weight:bold;' bgcolor='#efefef' align='center'>" & seq &"</td>" &_

"<td style='font-size:12px;padding:0 20px 0 20px;font-weight:bold;'>"

If IsObject(Session_item) Then

'Response.Write "객체:" & item & "<br>"

Response.Write "객체 </td>"

Response.Write "<td style='font-size:12px;padding:0 20px 0 20px;'>" & item & "</td>"

'배열인지 확인

Elseif IsArray(Session_item) Then

'Response.Write "배열:" & item & "<br>"

Response.Write "배열  " & item & "</td>"

Response.Write "<td style='font-size:12px;padding:0 20px 0 20px;'>"

strArray = Session.Contents(item)

For i = 0 to UBound(strArray)

Response.Write "(" & i & ")" & strArray(i) & "<br>"

Next

Response.Write "</td>"

'변수인 경우

Else

'Response.Write "변수:Session('"& item & "') : '"& Session.Contents(item) & "'<br>"

Response.Write "변수:Session('"& item & "')</td>"

Response.Write "<td style='font-size:12px;padding:0 20px 0 20px;'>" & Session.Contents(item) & "</td>"

End If

Response.Write "</tr>"

seq = seq + 1

Next

Response.Write "</table>"

END FUNCTION

'배열 값 잇나 검사

Function in_array(element, arr)

in_array = False

For i=0 To Ubound(arr)

If Trim(arr(i)) = Trim(element) Then

in_array = True

Exit Function

End If

Next

End Function

' 배열키반환

Function array_key(element, arr)

array_key = False

For i=0 To Ubound(arr)

If Trim(arr(i)) = Trim(element) Then

array_key = i

Exit Function

End If

Next

End Function

===========================================================================

' alert메세지등 페이지 이동

' alert메세지만

Function alerts_only(msgs)

response.write "<script type=text/javascript>alert('" &msgs &"');</script>"

response.end

End Function

' alert 후 뒤로

Function alerts(msgs)

response.write "<script type=text/javascript>alert('" &msgs &"');history.go(-1)</script>"

response.end

End Function

' alert 후 해당경로

Function Go_Url(Url,Msg)

if Url <> "" Then

links = " location.href='"&Url&"'; "

Else

links = " history.back(); "

End If

If Msg <> "" Then

  msgs = " alert('" & Msg & "'); "

End If

response.write "<meta http-equiv='Content-Type' content='text/html; charset=utf-8' />"

response.write "<script type=text/javascript>" & msgs & links & "</script>"

response.end

End Function

===========================================================================