<%@ Language=VBScript %> <%Response.buffer = true%> <% '-------------------------------------------------------------------- ' Microsoft ADO ' ' (c) 1996 Microsoft Corporation. All Rights Reserved. ' ' ' ' ADO constants include file for VBScript ' '-------------------------------------------------------------------- '---- CursorTypeEnum Values ---- Const adOpenForwardOnly = 0 Const adOpenKeyset = 1 Const adOpenDynamic = 2 Const adOpenStatic = 3 '---- CursorOptionEnum Values ---- Const adHoldRecords = &H00000100 Const adMovePrevious = &H00000200 Const adAddNew = &H01000400 Const adDelete = &H01000800 Const adUpdate = &H01008000 Const adBookmark = &H00002000 Const adApproxPosition = &H00004000 Const adUpdateBatch = &H00010000 Const adResync = &H00020000 '---- LockTypeEnum Values ---- Const adLockReadOnly = 1 Const adLockPessimistic = 2 Const adLockOptimistic = 3 Const adLockBatchOptimistic = 4 '---- CursorLocationEnum Values ---- Const adUseClient = 1 Const adUseServer = 2 Const adUseClientBatch = 3 '---- DataTypeEnum Values ---- Const adEmpty = 0 Const adTinyInt = 16 Const adSmallInt = 2 Const adInteger = 3 Const adBigInt = 20 Const adUnsignedTinyInt = 17 Const adUnsignedSmallInt = 18 Const adUnsignedInt = 19 Const adUnsignedBigInt = 21 Const adSingle = 4 Const adDouble = 5 Const adCurrency = 6 Const adDecimal = 14 Const adNumeric = 131 Const adBoolean = 11 Const adError = 10 Const adUserDefined = 132 Const adVariant = 12 Const adIDispatch = 9 Const adIUnknown = 13 Const adGUID = 72 Const adDate = 7 Const adDBDate = 133 Const adDBTime = 134 Const adDBTimeStamp = 135 Const adBSTR = 8 Const adChar = 129 Const adVarChar = 200 Const adLongVarChar = 201 Const adWChar = 130 Const adVarWChar = 202 Const adLongVarWChar = 203 Const adBinary = 128 Const adVarBinary = 204 Const adLongVarBinary = 205 '---- ConnectPromptEnum Values ---- Const adPromptAlways = 1 Const adPromptComplete = 2 Const adPromptCompleteRequired = 3 Const adPromptNever = 4 '---- ConnectModeEnum Values ---- Const adModeUnknown = 0 Const adModeRead = 1 Const adModeWrite = 2 Const adModeReadWrite = 3 Const adModeShareDenyRead = 4 Const adModeShareDenyWrite = 8 Const adModeShareExclusive = &Hc Const adModeShareDenyNone = &H10 '---- IsolationLevelEnum Values ---- Const adXactUnspecified = &Hffffffff Const adXactChaos = &H00000010 Const adXactReadUncommitted = &H00000100 Const adXactBrowse = &H00000100 Const adXactCursorStability = &H00001000 Const adXactReadCommitted = &H00001000 Const adXactRepeatableRead = &H00010000 Const adXactSerializable = &H00100000 Const adXactIsolated = &H00100000 '---- XactAttributeEnum Values ---- Const adXactPollAsync = 2 Const adXactPollSyncPhaseOne = 4 Const adXactCommitRetaining = &H00020000 Const adXactAbortRetaining = &H00040000 Const adXactAbortAsync = &H00080000 '---- FieldAttributeEnum Values ---- Const adFldBookmark = &H00000001 Const adFldMayDefer = &H00000002 Const adFldUpdatable = &H00000004 Const adFldUnknownUpdatable = &H00000008 Const adFldFixed = &H00000010 Const adFldIsNullable = &H00000020 Const adFldMayBeNull = &H00000040 Const adFldLong = &H00000080 Const adFldRowID = &H00000100 Const adFldRowVersion = &H00000200 Const adFldCacheDeferred = &H00001000 '---- EditModeEnum Values ---- Const adEditNone = &H0000 Const adEditInProgress = &H0001 Const adEditAdd = &H0002 '---- RecordStatusEnum Values ---- Const adRecOK = &H0000000 Const adRecNew = &H0000001 Const adRecModified = &H0000002 Const adRecDeleted = &H0000004 Const adRecUnmodified = &H0000008 Const adRecInvalid = &H0000010 Const adRecMultipleChanges = &H0000040 Const adRecPendingChanges = &H0000080 Const adRecCanceled = &H0000100 Const adRecCantRelease = &H0000400 Const adRecConcurrencyViolation = &H0000800 Const adRecIntegrityViolation = &H0001000 Const adRecMaxChangesExceeded = &H0002000 Const adRecObjectOpen = &H0004000 Const adRecOutOfMemory = &H0008000 Const adRecPermissionDenied = &H0010000 Const adRecSchemaViolation = &H0020000 Const adRecDBDeleted = &H0040000 '---- GetRowsOptionEnum Values ---- Const adGetRowsRest = -1 '---- PositionEnum Values ---- Const adPosUnknown = -1 Const adPosBOF = -2 Const adPosEOF = -3 '---- AffectEnum Values ---- Const adAffectCurrent = 1 Const adAffectGroup = 2 Const adAffectAll = 3 '---- FilterGroupEnum Values ---- Const adFilterNone = 0 Const adFilterPendingRecords = 1 Const adFilterAffectedRecords = 2 Const adFilterFetchedRecords = 3 '---- PropertyAttributesEnum Values ---- Const adPropNotSupported = &H0000 Const adPropRequired = &H0001 Const adPropOptional = &H0002 Const adPropRead = &H0200 Const adPropWrite = &H0400 '---- ErrorValueEnum Values ---- Const adErrInvalidArgument = &Hbb9 Const adErrNoCurrentRecord = &Hbcd Const adErrIllegalOperation = &Hc93 Const adErrInTransaction = &Hcae Const adErrFeatureNotAvailable = &Hcb3 Const adErrItemNotFound = &Hcc1 Const adErrObjectNotSet = &Hd5c Const adErrDataConversion = &Hd5d Const adErrObjectClosed = &He78 Const adErrObjectOpen = &He79 Const adErrProviderNotFound = &He7a Const adErrBoundToCommand = &He7b '---- ParameterAttributesEnum Values ---- Const adParamSigned = &H0010 Const adParamNullable = &H0040 Const adParamLong = &H0080 '---- ParameterDirectionEnum Values ---- Const adParamUnknown = &H0000 Const adParamInput = &H0001 Const adParamOutput = &H0002 Const adParamInputOutput = &H0003 Const adParamReturnValue = &H0004 '---- CommandTypeEnum Values ---- Const adCmdUnknown = 0 Const adCmdText = &H0001 Const adCmdTable = &H0002 Const adCmdStoredProc = &H0004 %> <% Sub drawAdObject(cf_id, activeCode) 'ADSERVER ADD-ON if dLookUp("constants","ct_value","ct_id='adserv_mode'") = "1" then call InsertAd(activeCode, dLookUp("constants","ct_value","ct_id='adserv_descr'"),cf_id) end if End Sub Function IsAdvertisement(ad_id) dim SQL, RS set RS = Server.CreateObject("ADODB.RecordSet") ad_id = ConvertToNum(ad_id) SQL = "select count(AD_ID) as FLAG from ADS where AD_ID=" & ad_id RS.Open SQL, Session("Con"),adOpenDynamic,adLockReadOnly IsAdvertisement = RS("FLAG") RS.Close End Function sub UpdateAdImpLogs(activeAd, ad_imp_date, ad_imp_day) dim SQL, RS dim ad_url set RS = server.CreateObject("ADODB.RecordSet") SQL = "SELECT ad_id, as_date, as_imp_day" SQL = SQL & " FROM ads_daily_stats" SQL = SQL & " WHERE ad_id=" & activeAd SQL = SQL & " AND as_date=" & QueryDate(ad_imp_date) RS.Open SQL, Session("Con"),adOpenDynamic,adLockOptimistic if RS.eof then RS.addnew RS("ad_id") = activeAd end if RS("as_date") = ad_imp_date RS("as_imp_day") = ad_imp_day RS.Update RS.Close end sub sub UpdateAdClicks(activeAd) dim SQL, RS dim ad_url set RS = server.CreateObject("ADODB.RecordSet") if activeAd="" then exit sub else SQL = "SELECT ad_id, ad_click, ad_click_max, ad_url" SQL = SQL & " FROM ads" SQL = SQL & " WHERE ad_id=" & activeAd SQL = SQL & " AND ad_status='1'" RS.Open SQL, Application("Con"),adOpenDynamic,adLockOptimistic if RS.EOF then RS.Close exit sub else ad_url = RS("ad_url") RS("ad_click") = converttonum(RS("ad_click")) + 1 RS.Update RS.Close Response.Redirect ad_url end if end if end sub Sub UpdateAdStats(activeAd, activePosition) dim SQL, RS dim ad_system dim maximpnow set RS = server.CreateObject("ADODB.RecordSet") SQL = "SELECT max(dp_imp) as maximp" SQL = SQL & " FROM ads_2positions" SQL = SQL & " WHERE ap_id=" & activePosition RS.Open SQL, Session("Con"),adOpenDynamic,adLockReadOnly If RS.EOF then exit sub else maximpnow = RS("maximp") RS.Close end if ' Session("Con").BeginTrans SQL = "SELECT dp_imp" SQL = SQL & " FROM ads_2positions" SQL = SQL & " WHERE ad_id=" & activeAd SQL = SQL & " AND ap_id=" & activePosition RS.Open SQL, Session("Con"),adOpenDynamic,adLockOptimistic If RS.EOF then ' Session("Con").RollbackTrans exit sub else RS("dp_imp") = maximpnow + 1 'maximize impressions in position in order not to be shown again soon RS.Update RS.Close end if SQL = "SELECT ad_id, ad_status," SQL = SQL & " ad_imp, ad_imp_day," SQL = SQL & " ad_imp_max, ad_imp_day_max, ad_imp_date," SQL = SQL & " ad_datt, ad_start, ad_end, ad_system, ad_status" SQL = SQL & " FROM ads" SQL = SQL & " WHERE ad_id=" & activeAd RS.Open SQL, Session("Con"),adOpenDynamic,adLockOptimistic If RS.EOF then ' Session("Con").RollbackTrans exit sub else RS("ad_imp") = converttonum(RS("ad_imp")) + 1 ' one more impression for ad If RS("ad_imp")="1" then RS("ad_start") = now() end If ' check for violation of impressions per day limit If isnull(RS("ad_imp_date")) or RS("ad_imp_date")="" then RS("ad_imp_date") = datevalue(now()) End if If datevalue(RS("ad_imp_date")) = datevalue(now()) then RS("ad_imp_day") = converttonum(RS("ad_imp_day")) + 1 ' one more impression for ad for today Else call UpdateAdImpLogs(activeAd, RS("ad_imp_date"), RS("ad_imp_day")) RS("ad_imp_date") = datevalue(now()) RS("ad_imp_day") = 1 ' first impression for ad for today End If RS("ad_end") = now() RS.Update RS.Close end if 'Session("Con").CommitTrans 'If err.number<>0 then ' Session("Con").RollbackTrans 'End If end sub Function DetermineAd(activePosition) dim SQL, RS dim activeAd, isValid dim minimp set RS = server.CreateObject("ADODB.RecordSet") activeAd = -1 minimp = 0 SQL = "SELECT P.dp_imp, A.ad_id, ad_status," SQL = SQL & " ad_imp, ad_imp_day, ad_click," SQL = SQL & " ad_imp_max, ad_imp_day_max, ad_click_max, ad_imp_date," SQL = SQL & " ad_datf, ad_datt" SQL = SQL & " FROM ads A, ads_2positions P" SQL = SQL & " WHERE ad_status='1'" SQL = SQL & " AND ad_datf<=" & QueryDate(now()) SQL = SQL & " AND A.ad_id=P.ad_id" SQL = SQL & " AND P.ap_id=" & activePosition RS.Open SQL, Session("Con"),adOpenDynamic,adLockReadOnly while not RS.EOF isValid = true if not isnull(RS("ad_imp_max")) and converttonum(RS("ad_imp"))>=converttonum(RS("ad_imp_max")) then isValid = false end if if (not isnull(RS("ad_imp_date"))) and RS("ad_imp_date")<>"" and datevalue(ConvertToDate(RS("ad_imp_date")))=datevalue(now()) then if not isnull(RS("ad_imp_day_max")) and converttonum(RS("ad_imp_day"))>=converttonum(RS("ad_imp_day_max")) then isValid = false end if end if if not isnull(RS("ad_click_max")) and converttonum(RS("ad_click"))>converttonum(RS("ad_click_max")) then isValid = false end if if ((not isnull(RS("ad_datt"))) and RS("ad_datt")<>"") and ConvertToDate(RS("ad_datt"))<=now() then isValid = false end if If isValid and (converttonum(RS("dp_imp"))<=minimp or activeAd=-1) then activeAd = RS("ad_id") minimp = converttonum(RS("dp_imp")) End if RS.MoveNext wend RS.Close DetermineAd = activeAd End Function sub InsertAd(activeCode, activeDescriptor, cf_id) dim ap_id, ap_image_width, ap_image_height, ap_window dim SQL, RS set RS = server.CreateObject("ADODB.RecordSet") SQL = "SELECT DISTINCT ap_id, ap_descr, ap_code, ap_descriptor, ap_category," SQL = SQL & " ap_image_width, ap_image_height, ap_window" SQL = SQL & " FROM ads_positions" SQL = SQL & " WHERE ap_code='" & activeCode & "'" SQL = SQL & " AND ap_descriptor='" & activeDescriptor &"'" RS.Open SQL, Session("Con"),adOpenDynamic,adLockReadOnly if not RS.EOF then ap_id = RS("ap_id") ap_image_width = RS("ap_image_width") ap_image_height = RS("ap_image_height") ap_window = RS("ap_window") RS.Close else RS.Close exit sub end if ad_id = DetermineAd(ap_id) if ad_id=-1 then exit sub call UpdateAdStats(ad_id, ap_id) if ap_window = 0 then call ShowAd(ad_id, ap_id) else %> <% end if end sub Sub ShowAd(activeAd, activePosition) dim SQL, RS set RS = server.CreateObject("ADODB.RecordSet") SQL = "SELECT ad_image, ad_descr, ad_image_width, ad_image_height," SQL = SQL & " ad_url, ad_alt, ad_target," SQL = SQL & " ap_image_width, ap_image_height, at_title, ap_window" SQL = SQL & " FROM ads A, ads_2positions D, ads_positions P, ad_types T" SQL = SQL & " WHERE P.ap_id=D.ap_id" SQL = SQL & " AND A.ad_id=D.ad_id" SQL = SQL & " AND A.ad_type=T.at_id" SQL = SQL & " AND P.ap_id=" & activePosition SQL = SQL & " AND A.ad_id=" & activeAd RS.Open SQL, Session("Con"),adOpenDynamic,adLockReadOnly if not RS.EOF then '
select case RS("at_title") case "image" Response.Write ImageAd(activeAd, RS("ad_image"), RS("ad_image_width"), RS("ad_image_height"), RS("ad_url"), RS("ad_alt") ,RS("ad_target"), RS("ap_image_width"), RS("ap_image_height"), RS("ap_window")) case "flash" Response.Write FlashAd(activeAd, RS("ad_image"), RS("ad_image_width"), RS("ad_image_height"), RS("ad_url"), RS("ad_alt"), RS("ad_target"), RS("ap_image_width"), RS("ap_image_height"), RS("ap_window")) end select '
end if RS.Close End Sub Function AdjustAdDimensions(im_width, im_height, pos_width, pos_height, pos_window) dim mode if ConvertToNum(pos_window)=0 then if converttonum(im_width)=0 or converttonum(im_height)=0 then mode = "position" elseif converttonum(im_width) <% end if end if AdjustAdDimensions = mode End Function Function ImageAd(ad_id, im_file, im_width, im_height, im_url, im_alt, im_target, pos_width, pos_height, pos_window) dim cmd, attr dim width, height cmd = ""http" then attr = " src=""" & Application("Banners") & im_file & """" else attr = " src=""" & im_file & """" end if cmd = cmd & attr ' width, height select case AdjustAdDimensions(im_width, im_height, pos_width, pos_height, pos_window) case "position" width = pos_width height = pos_height case "image" width = im_width height = im_height case "scale" width = pos_width height = int(converttonum(im_height) * converttonum(pos_width)/converttonum(im_width)) end select attr = " width=""" & width & """" cmd = cmd & attr attr = " height=""" & height & """" cmd = cmd & attr 'alt if im_alt<>"" then attr = " alt=""" & im_alt & """" cmd = cmd & attr end if cmd = cmd & " vspace=""0""" cmd = cmd & ">" if im_url<>"" then attr = "" cmd = attr & cmd cmd = cmd & "" end if ImageAd = cmd End Function Function FlashAd(ad_id, im_file, im_width, im_height, im_url, im_alt, im_target, pos_width, pos_height, pos_window) dim cmd, attr, plugin dim width, height plugin = " TYPE=""application/x-shockwave-flash"" PLUGINSPAGE=""http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash""" cmd = cmd & ""http" then attr = " src=""" & Application("Banners") & im_file & """" else attr = " src=""" & im_file & """" end if cmd = cmd & attr ' width, height select case AdjustAdDimensions(im_width, im_height, pos_width, pos_height, pos_window) case "position" width = pos_width height = pos_height case "image" width = im_width height = im_height case "scale" width = pos_width height = int(converttonum(im_height) * converttonum(pos_width)/converttonum(im_width)) end select attr = " width=""" & width & """" cmd = cmd & attr attr = " height=""" & height & """" cmd = cmd & attr 'plugin cmd = cmd & plugin cmd = cmd & ">" ' 'alt ' if im_alt<>"" then ' attr = " alt=""" & im_alt & """" ' cmd = cmd & attr ' end if ' if im_url<>"" then ' attr = "" ' cmd = attr & cmd ' cmd = cmd & "" ' end if FlashAd = cmd End Function %> <% 'if InStr(1,UCase(Request.ServerVariables("path_info")),"CHAT")=0 then ' 'end if 'SQL INJECTION PRECAUSES public function stripQuotes(strWords) stripQuotes = replace(strWords, "'", "''") end function public function killChars(strWords) dim badChars dim newChars badChars = array("select", "drop", ";", "--", "insert", "delete", "xp_") newChars = strWords for i = 0 to uBound(badChars) newChars = replace(newChars, badChars(i), "") next killChars = newChars end function public function cleanMe(strWords) dim cleanMeTemp cleanMeTemp = strWords cleanMeTemp = stripQuotes(cleanMeTemp) cleanMeTemp = killChars(cleanMeTemp) cleanMe = cleanMeTemp end function Function ConvertToString(s) if isnull(s) then ConvertToString = "" else ConvertToString = trim(s) end if End Function function ConvertToNum(s) if isnull(s) then ConvertToNum = 0 else if not isnumeric(s) then ConvertToNum = 0 else ConvertToNum = cdbl(s) end if end if End function Function ConvertToDate(d) if isnull(d) or d="" then ConvertToDate = "" else ConvertToDate = cdate(d) end if End Function Sub AddToPending(fName) dim tRS, SQL, id set tRS = Server.CreateObject("ADODB.RecordSet") SQL = "SELECT * FROM PENDING_OBJECTS" & " WHERE 1=0" tRS.Open SQL,Session("Con"),adOpenDynamic,adLockOptimistic id = GetNext(Left("PENDING_OBJECTS",12)) tRS.AddNew tRS("PO_ID") = ID tRS("PO_FILENAME") = fName tRS("PO_STATUS") = "1" tRS("CRD") = now tRS("CHD") = now tRS("CRUSER") = Session("US_ID") tRS("CHUSER") = Session("US_ID") tRS.Update tRS.Close set tRS = Nothing End Sub public Function DLookUp(TblName, ReturnField , WhereString) Dim LookUpTBL set LookUpTBL = Server.CreateObject("ADODB.RecordSet") DIM LSQLQuery DLookUp="" LSQLQuery = "select " & ReturnField & " from " & TblName if WhereString<>"" then LSQLQuery = LSQLQuery & " where " & WhereString 'Response.write LSQLQuery LookUpTBL.Open LSQLQuery, Session("Con"), adOpenDynamic, adLockReadOnly if (not LookUpTBL.EOF) then dLookUp=ConvertToString(LookUpTBL(0)) end If LookUpTBL.Close set LookUpTBL=nothing End Function public Function LookUp(TblName, KeyField , ReturnField , KeyValue) DIM LSQLQuery Dim LookUpTBL set LookUpTBL = Server.CreateObject("ADODB.RecordSet") LookUp="" LSQLQuery = "select " & ReturnField & " from " & TblName if KeyValue<>"" and keyField<>"" then LSQLQuery = LSQLQuery & " where " & KeyField & "='" & KeyValue & "'" 'Response.write LSQLQuery LookUpTBL.Open LSQLQuery, Session("Con"), adOpenDynamic, adLockReadOnly if (not LookUpTBL.EOF) then LookUp=ConvertToString(LookUpTBL(0)) end If LookUpTBL.Close set LookUpTBL=nothing End Function public Function LookUpNum(TblName, KeyField , ReturnField , KeyValue) DIM LSQLQuery Dim LookUpTBL set LookUpTBL = Server.CreateObject("ADODB.RecordSet") LookUpNum="" IF KeyValue<>"" then LSQLQuery = "select " & ReturnField & " from " & TblName & " where " & KeyField & "=" & KeyValue LookUpTBL.Open LSQLQuery, Session("Con"), adOpenDynamic, adLockReadOnly if (not LookUpTBL.EOF) then LookUpNum=ConvertToString(LookUpTBL(ReturnField)) end If LookUpTBL.Close end if set LookUpTBL=nothing End Function Public Function iif(c, a, b) if c then iif=a else iif=b end if End Function Public Function VisitorNo() dim rs, sql if Session("VisitorNo") = 0 then 'Access Log Session("VisitorNo") = GetNext("HITS") set rs = Server.CreateObject("ADODB.RecordSet") sql = "SELECT * FROM USER_ACCESS_LOG WHERE 1 = 0" rs.Open SQL, Session("Con"), adOpenDynamic, adLockOptimistic rs.AddNew RS("UL_ID") = Session("VisitorNo") RS("UL_DATE") = DateValue(Session("LoginTime")) Rs("UL_TIME") = TimeValue(Session("LoginTime")) Rs("UL_IP") = Request.ServerVariables("REMOTE_HOST") rs.Update rs.Close end if VisitorNo = Session("VisitorNo") End Function Public Function GetNext(CN_ID) Dim getRS, getSQL If CN_ID<>"" Then set getRS = Server.CreateObject("ADODB.RecordSet") getSQL = "SELECT * FROM COUNTERS WHERE CN_ID='" & CN_ID & "'" getRS.open getSQL, Application("Con"), adOpenDynamic, adLockOptimistic If not getRS.EOF Then GetNext = getRS("CN_NVAL") getRS("CN_NVAL") = getRS("CN_NVAL") + 1 getRS.Update Else GetNext = 1 getRS.AddNew getRS("CN_ID") = left(CN_ID,12) getRS("CN_DESCR") = CN_ID getRS("CN_NVAL") = 2 getRS("CRUSER") = Session("US_ID") getRS("CRD") = now() getRS("CHUSER") = Session("US_ID") getRS("CHD") = now() getRS.Update end if getRS.close End If Set getRS = nothing End Function public Sub CloseSession() dim rs, sql if Session("VisitorNo") <> 0 then 'Access Log update set rs = Server.CreateObject("ADODB.RecordSet") sql = "SELECT * FROM USER_ACCESS_LOG WHERE UL_ID = " & Session("VisitorNo") rs.Open SQL, Session("Con"), adOpenDynamic,adLockOptimistic if not rs.EOF then Rs("UL_DURATION") = DateDiff("m",Session("LoginTime"),Now()) if Rs("UL_DURATION")<=0 then Rs("UL_DURATION")=1 rs.Update end if rs.Close end if End Sub Public Function DurationString(t1, t2) Dim hours, minutes, secs dif = DateDiff("s", cdate(t1), cdate(t2)) secs = dif mod 60 minutes = int(dif/60) hours = int(minutes / 60) minutes = minutes - hours * 60 DurationString="" if hours>0 then DurationString = hours & "h " if minutes>0 then DurationString = DurationString & minutes & "' " if secs>0 then DurationString = DurationString & secs & "''" End Function Public Function UsDate(dat) UsDate = Month(dat) & "/" & day(dat) & "/" & year(dat) End Function Public Function UsDateTime(dat) UsDateTime = usDate(dat) & " " & hour(dat) & ":" & fixedDigits(minute(dat),2) & ":" & fixedDigits(second(dat),2) End Function Public Function QueryDate(dat) QueryDate = "#" & UsDate(dat) & "#" End Function Public Function QueryDateTime(dat) QueryDateTime = "#" & UsDateTime(dat) & "#" End Function Public Function UserIsMember(UG_USR_ID, US_ID) dim SQL, RS set RS = Server.CreateObject("ADODB.RecordSet") SQL = "SELECT UG_USR_ID FROM USER_GROUPS, USER_GROUPS_REL " SQL = SQL & "WHERE USER_GROUPS.UG_ID=USER_GROUPS_REL.UG_ID AND US_ID=" & US_ID SQL = SQL & " AND UG_USR_ID='" & UG_USR_ID & "'" RS.Open SQL, Session("Con"), adOpenDynamic, adLockReadOnly UserIsMember = NOT RS.EOF RS.CLOSE SET RS = NOTHING END Function Function Max(a,b) if ab then Min = b else Min = a end if End Function Function FixedDigits(m,NumberOfDigits) dim i FixedDigits = cstr(clng(m)) i=len(FixedDigits)-NumberOfDigits if i>0 then FixedDigits = string(i,"0") & FixedDigits end if End Function Function FixedDecimals(m,NuberOfDecimals) dim st, k, zerosToAdd n = cdbl(m) n = Round(n,NuberOfDecimals) st = cstr(n) k = instr(st,",") if k = 0 then zerosToAdd = NuberOfDecimals else zerosToAdd = NuberOfDecimals - (len(st) - k) end if if zerosToAdd=NuberOfDecimals then st = st & "," for k = 1 to zerosToAdd st = st & "0" next FixedDecimals = st End Function Function DottedNumber(n) dim s, i, r, absNum, sign, nn if isNull(n) then n = 0 nn = cdbl(n) absNum = abs(nn) if nn<0 then sign = "-" else sign = "" end if s = cstr(absNum) r = "" for i = len(s) to 1 step -1 if (i-len(s)) mod 3 = 0 and i<>len(s) then r = "." & r r = mid(s,i,1) & r next DottedNumber = "" & sign & r End Function Function Odd(n) Odd = (n mod 2)=1 End Function Function PartialString(s,i) PartialString = Left(s,i) End Function Function gcd(x,y) a=x b=y If a>0 and b>0 Then While a<>b If a>b Then a=a-b Else b=b-a End If Wend gcd=a Else gcd=1 End If End Function Function GetUser(userid) dim userlogin, getSQL Dim LookUpTBL set LookUpTBL = Server.CreateObject("ADODB.RecordSet") getSQL = "SELECT us_login FROM users WHERE us_id = " & userid LookUpTBL.Open getSQL,Session("Con"),adOpenDynamic,adLockOptimistic userlogin = Converttostring(LookUpTBL("us_login")) LookUpTBL.Close GetUser = userlogin set LookUpTBL=nothing End Function Function ConvertToString_Dblquote(s) if isnull(s) then ConvertToString_Dblquote = "" else ConvertToString_Dblquote = trim(replace(s,"""",""")) end if End Function ' ================================================================= ' REVISED e-mail validation function ======================================= ' ================================================================= Function IsValidEmail(strEmail) ' Dim bIsValid ' bIsValid = True ' If Len(strEmail) < 5 Then ' bIsValid = False ' Else ' If Instr(1, strEmail, " ") <> 0 Then ' bIsValid = False ' Else ' If InStr(1, strEmail, "@", 1) < 2 Then ' bIsValid = False ' Else ' If InStrRev(strEmail, ".") < InStr(1, strEmail, "@", 1) + 2 Then ' bIsValid = False ' End If ' End If ' End If ' End If ' IsValidEmail = bIsValid IsValidEmail = RegExpTest(strEmail) End Function Function RegExpTest(sEmail) RegExpTest = false Dim regEx, retVal ' Create regular expression: Set regEx = New RegExp ' Set pattern: regEx.Pattern ="^[\w-\.]{1,}\@([\da-zA-Z-]{1,}\.){1,}[\da-zA-Z-]{2,3}$" ' Set case sensitivity. regEx.IgnoreCase = true ' Execute the search test. retVal = regEx.Test(sEmail) If not retVal Then exit function End If RegExpTest = true End Function 'Function IsValidEmail(strEmail) ' Dim bIsValid ' bIsValid = True ' ' If Len(strEmail) < 5 Then ' bIsValid = False ' Else ' If Instr(1, strEmail, " ") <> 0 Then ' bIsValid = False ' Else ' If InStr(1, strEmail, "@", 1) < 2 Then ' bIsValid = False ' Else ' If InStrRev(strEmail, ".") < InStr(1, strEmail, "@", 1) + 2 Then ' bIsValid = False ' End If ' End If ' End If ' End If ' ' IsValidEmail = bIsValid 'Replaced by more professional function in 13/01/2006 by skotro ' IsValidEmail = RegExpTest(strEmail) 'End Function Function ConvertToDBString(s) if trim(s)="" then ConvertToDBString = null else ConvertToDBString = trim(s) end if End Function 'CONTENT MANAGEMENT ADD-ONS Sub ReleasePending(FileNameList) dim globCMD, getSQL set globCMD = server.CreateObject("ADODB.Command") getSQL = "DELETE FROM PENDING_OBJECTS WHERE PO_FILENAME IN (" & FileNameList & ")" globCMD.ActiveConnection = session("Con") globCMD.CommandText = getSQL globCMD.Execute set globCMD = nothing End Sub Sub AddErrMessage(ErrMessage_string,Message) ErrMessage_string = ErrMessage_string & "
  • " & Message & vbCrLf & vbCrLf End Sub Sub DisplayErrorPage(EMessage, ETarget) Session("ErrorMessage") = EMessage Session("ErrorTarget") = ETarget Response.Redirect Application("Manage") & "ErrorPage.asp" Response.End End Sub Sub DropDownFromTable(table, id, id_value, code, descr, SQLorder) dim SQLdd, RSdd set RSdd = server.CreateObject("ADODB.RecordSet") SQLdd = "SELECT " & id & ", " & descr if code<>"" then SQLdd = SQLdd & ", " & code SQLdd = SQLdd & " FROM " & table if SQLorder<>"" then SQLdd = SQLdd & " ORDER BY " & SQLorder RSdd.Open SQLdd,session("Con"),adOpenDynamic,adLockReadOnly while not RSdd.EOF %> <%RSdd.MoveNext wend RSdd.Close set RSdd = nothing End sub %> <% Function CheckAccess(Login, Password) dim RS, SQL CheckAccess = false SQL = "select us_id, us_login, us_password from users where us_login='" & cleanme(Trim(LOGIN)) & "' " SQL = SQL & "and us_password='" & cleanMe(Trim(PASSWORD)) & "' " set rs = server.createObject("ADODB.RecordSet") Rs.Open SQL, session("Con"),adOpenDynamic,adLockReadOnly CheckAccess = not Rs.EOF if not Rs.EOF then CheckAccess = cleanMe(trim(password)) = ConvertToString(rs("US_PASSWORD")) if CheckAccess then Session("US_ID") = clng(RS("US_ID")) Session("Login")=cleanMe(Trim(Request("Login"))) Session("password")=cleanMe(Trim(Request("Password"))) end if end if Rs.Close Session("AccessChecked")=true End Function Function CheckPassword(US_ID, Password, Full) dim RS, SQL, login CheckPassword=FALSE SQL = "select us_password, us_login from users where us_id=" & cleanMe(US_ID) set rs = server.createObject("ADODB.RecordSet") Rs.Open SQL, session("Con"),adOpenDynamic,adLockReadOnly IF not Rs.EOF THEN if Full then CheckPassword = Password=ConvertToString(rs("US_PASSWORD")) else if len(Password)=1 then CheckPassword = Password=Mid(ConvertToString(rs("US_PASSWORD")),Left(cstr(us_id),1),1) Response.Cookies("Control").Expires = DateAdd("m",6,Date()) Response.Cookies("Control")("I") = us_id Response.Cookies("Control")("P") = PartialString(ConvertToString(rs("US_PASSWORD")),5) else CheckPassword = Password=PartialString(ConvertToString(rs("US_PASSWORD")),5) end if end if login = ConvertToString(Rs("US_LOGIN")) Password = ConvertToString(Rs("US_PASSWORD")) End If Rs.Close if CheckPassword then Session("US_ID")=US_ID Session("Login")=Login Session("Password")=Password end if End Function Function CheckStoredAccess() dim US_ID, PWD US_ID=Request.Cookies("Control")("I") if cstr(US_ID)<>"" then PWD = Request.Cookies("Control")("P") CheckStoredAccess=CheckPassword(US_ID, PWD, false) else CheckStoredAccess=false end if Session("AccessChecked")=true End Function Sub LoadGroups(US_ID) dim SQL, RS SET RS = Server.CreateObject("ADODB.RecordSet") SQL = "SELECT UG_USR_ID FROM USER_GROUPS, USER_GROUPS_REL WHERE US_ID=" & US_ID & " AND USER_GROUPS.UG_ID=USER_GROUPS_REL.UG_ID" Rs.Open sql, session("Con"),adOpenDynamic,adLockReadOnly While not Rs.EOF Session(RS("UG_USR_ID")) = true Rs.MoveNext wend Rs.Close End Sub Sub InitConnection() dim SQL, RS SET RS = Server.CreateObject("ADODB.RecordSet") sql = "select us_id from user_access_log where ul_id=" & VisitorNo() Rs.Open sql, session("Con"),adOpenDynamic,adLockOptimistic if not Rs.EOF then rs("us_id") = Session("us_id") Rs.Update end if Rs.Close call LoadGroups(Session("us_id")) SQL = "SELECT * FROM BOARD_USERS WHERE BR_ID=0 AND US_ID=" & Session("us_id") Rs.Open SQL,SESSION("CON"),adOpenDynamic,adLockOptimistic IF Rs.EOF THEN Rs.AddNew rs("BR_ID")=0 RS("US_ID")=Session("us_id") Rs.Update END IF Rs.Close End Sub %> <% if Application("OnLine")<>true then Session.Timeout = 1 Response.redirect Application("Root") & "welcome_temp.asp" end if if Session("VisitorNo") = 0 then Call VisitorNo() end if if Session("AccessChecked")<>true then if CheckStoredAccess() then call InitConnection() Session("UserWelcomed") = true end if end if Session("UserWelcomed")=true 'pop-up for new SMS if Session("US_ID")>0 THEN LastSMS = ConvertToNum(dLookUp("MESSAGES","MAX(MS_ID)","MS_RECEIVER=" & Session("US_ID") & " AND MS_READ='0'")) if LastSMS>Session("LastSMS") and LastSMS>0 then Session("LastSMS")=LastSMS%> <% end if end if %> <% dim RS, SQL, I, lastDescr set RS = Server.CreateObject("ADODB.RecordSet") if Session("US_ID")=0 then Response.redirect Application("Root") end if %> ΝΥΓΜΑ: ΟΡΟΙ ΦΥΛΑΞΗΣ ΔΕΔΟΜΕΝΩΝ
    ΜΕΛΗ ΟΡΟΙ ΦΥΛΑΞΗΣ ΔΕΔΟΜΕΝΩΝ  

    Το ΝΥΓΜΑ σέβεται το απόρρητο των προσωπικών στοιχείων που καταχωρούν τα μέλη του κατά την οποιαδήποτε συναλλαγή τους με τον ηλεκτρονικό τόπο. Σε καμία περίπτωση δεν προτίθεται να τα δημοσιοποιήσει, να τα επεξεργαστεί, να τα μαγειρέψει ή ο,τιδήποτε άλλο βάζει ο νους του (κακού) ανθρώπου.

    Τα προσωπικά αυτά δεδομένα (είναι και της μόδας ο όρος) διατηρούνται στη βάση του ΝΥΓΜΑτος και χρησιμοποιούνται αποκλειστικά και μόνο για τη διαμόρφωση της ηλεκτρονικής σελίδας ανάλογα με τις δηλωθείσες προτιμήσεις και την τήρηση στατιστικών στοιχείων επισκεψιμότητας των σελίδων του τόπου.

    Σε οποιαδήποτε χρονική στιγμή τα μέλη του ΝΥΓΜΑτος διατηρούν το δικαίωμα ενημέρωσης ή και αντίρρησης στην περαιτέρω επεξεργασία των προσωπικών τους στοιχείων βάσει του άρθρου 13 του νόμου 2472/97.

    Αυτά.

    ΝΥΓΜΑ ανλίμιτεντ σαμ ράιτς ρισέρβντ 1994-2099