Line 1: #ExternalChecksum("C:\home\site\wwwroot\outpatient.aspx","{ff1816ec-aa5e-4d10-87f7-6f4963833460}","0039B15D4EBB6292D9BAB566255D31005F6E4D83")
Line 2: '------------------------------------------------------------------------------
Line 3: ' <auto-generated>
Line 4: ' This code was generated by a tool.
Line 5: ' Runtime Version:4.0.30319.42000
Line 6: '
Line 7: ' Changes to this file may cause incorrect behavior and will be lost if
Line 8: ' the code is regenerated.
Line 9: ' </auto-generated>
Line 10: '------------------------------------------------------------------------------
Line 11:
Line 12: Option Strict Off
Line 13: Option Explicit On
Line 14:
Line 15: Imports Microsoft.VisualBasic
Line 16: Imports System
Line 17: Imports System.Collections
Line 18: Imports System.Collections.Specialized
Line 19: Imports System.Configuration
Line 20: Imports System.Data
Line 21: Imports System.Drawing
Line 22: Imports System.IO
Line 23: Imports System.Text
Line 24: Imports System.Text.RegularExpressions
Line 25: Imports System.Web
Line 26: Imports System.Web.Caching
Line 27: Imports System.Web.Profile
Line 28: Imports System.Web.Security
Line 29: Imports System.Web.SessionState
Line 30: Imports System.Web.UI
Line 31: Imports System.Web.UI.HtmlControls
Line 32: Imports System.Web.UI.WebControls
Line 33: Imports System.Web.UI.WebControls.WebParts
Line 34:
Line 35: Namespace ASP
Line 36:
Line 37: <System.Runtime.CompilerServices.CompilerGlobalScopeAttribute()> _
Line 38: Public Class outpatient_aspx
Line 39: Inherits Global.System.Web.UI.Page
Line 40: Implements System.Web.SessionState.IRequiresSessionState, System.Web.IHttpHandler
Line 41:
Line 42: Private Shared __initialized As Boolean
Line 43:
Line 44: Private Shared __fileDependencies As Object
Line 45:
Line 46: <System.Diagnostics.DebuggerNonUserCodeAttribute()> _
Line 47: Public Sub New()
Line 48: MyBase.New
Line 49: Dim dependencies() As String
Line 50: CType(Me,Global.System.Web.UI.Page).AppRelativeVirtualPath = "~/outpatient.aspx"
Line 51: If (Global.ASP.outpatient_aspx.__initialized = false) Then
Line 52: dependencies = New String(2) {}
Line 53: dependencies(0) = "~/outpatient.aspx"
Line 54: dependencies(1) = "~/Inc/Function.asp"
Line 55: dependencies(2) = "~/Inc/ChkFunction.asp"
Line 56: Global.ASP.outpatient_aspx.__fileDependencies = Me.GetWrappedFileDependencies(dependencies)
Line 57: Global.ASP.outpatient_aspx.__initialized = true
Line 58: End If
Line 59: Me.Server.ScriptTimeout = 30000000
Line 60: End Sub
Line 61:
Line 62: Protected ReadOnly Property Profile() As System.Web.Profile.DefaultProfile
Line 63: Get
Line 64: Return CType(Me.Context.Profile,System.Web.Profile.DefaultProfile)
Line 65: End Get
Line 66: End Property
Line 67:
Line 68: Protected Overrides ReadOnly Property SupportAutoEvents() As Boolean
Line 69: Get
Line 70: Return false
Line 71: End Get
Line 72: End Property
Line 73:
Line 74: Protected ReadOnly Property ApplicationInstance() As ASP.global_asax
Line 75: Get
Line 76: Return CType(Me.Context.ApplicationInstance,ASP.global_asax)
Line 77: End Get
Line 78: End Property
Line 79:
Line 80: <System.Diagnostics.DebuggerNonUserCodeAttribute()> _
Line 81: Private Sub __BuildControlTree(ByVal __ctrl As outpatient_aspx)
Line 82:
Line 83: #ExternalSource("C:\home\site\wwwroot\outpatient.aspx",1)
Line 84: Me.InitializeCulture
Line 85:
Line 86: #End ExternalSource
Line 87: __ctrl.SetRenderMethodDelegate(AddressOf Me.__Render__control1)
Line 88: End Sub
Line 89:
Line 90: Private Sub __Render__control1(ByVal __w As System.Web.UI.HtmlTextWriter, ByVal parameterContainer As System.Web.UI.Control)
Line 91:
Line 92: #ExternalSource("C:\home\site\wwwroot\outpatient.aspx",1)
Line 93:
Line 94: Session.CodePage=65001
Line 95: Response.Charset="utf-8"
Line 96:
Line 97:
Line 98: #End ExternalSource
Line 99:
Line 100: #ExternalSource("C:\home\site\wwwroot\Inc\Function.asp",1)
Line 101:
Line 102: ' -------------------------------------------------------------------------------------------------------
Line 103: ' 支援函式
Line 104: ' -------------------------------------------------------------------------------------------------------
Line 105: Dim BrandPK, KindPK, ItemPK, BrandName, KindName, ItemName, SortFieldName
Line 106: Dim Conn
Line 107: Dim Str, DataArray, DataArrayCount
Line 108: Dim DataArray2, DataArrayCount2
Line 109: ' 計數器使用
Line 110: Dim NowPageCount,NowPageCount2
Line 111:
Line 112: 'Access 2003 資料庫連結
Line 113: Function GetConnection(DBName)
Line 114: Dim strProvider
Line 115: Dim Server_Address, DB_Name, DB_ID, DB_PassWord
Line 116:
Line 117: ' MSSQL
Line 118: ' 61.221.67.227 DEB
Line 119: 'Server_Address = "127.0.0.1"
Line 120: 'Server_Address = "61.221.67.227"
Line 121: 'Server_Address = "210.61.150.10"
Line 122: 'Server_Address = "192.168.0.8"
Line 123:
Line 124: 'DB_Name = "carwin"
Line 125: 'DB_ID = "carwin"
Line 126: 'DB_PassWord = "CarWin-12345600"
Line 127: 'DB_PassWord = "carwin"
Line 128:
Line 129: Set Conn = Server.CreateObject("ADODB.Connection")
Line 130: ' MDB
Line 131: 'strProvider = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source = " & Server.MapPath("\db\" & DBName &".mdb")
Line 132: ' MSSQL
Line 133: 'strProvider = "driver={SQL Server};Server="&Server_Address&";Database="&DB_Name&";UID="&DB_ID&";PWD="&DB_PassWord&";"
Line 134: 'strProvider = "driver={SQL Server};Server="&Server_Address&";Database="&DB_Name&";UID="&DB_ID&";PWD="&DB_PassWord&";"
Line 135: 'strProvider = "Provider=sqloledb;Data Source="&Server_Address&";Initial Catalog="&DB_Name&";User ID="&DB_ID&";Password="&DB_PassWord&";"
Line 136: ' 正式機
Line 137: 'strProvider = "Provider=SQLOLEDB.1;Persist Security Info=False;UID=carwin;PWD=carwin;Initial Catalog=carwin;Data Source=192.168.0.8"
Line 138: 'strProvider = "Provider=SQLOLEDB.1;Persist Security Info=False;UID=flash2u;PWD=12345600;Initial Catalog=carwin;Data Source=210.61.150.11"
Line 139: strProvider = "Provider=SQLOLEDB.1;Persist Security Info=False;UID=carwin;PWD=carwin;Initial Catalog=DEB;Data Source=192.168.0.8"
Line 140: 'strProvider = "tcp:n3ilvzmhwm.database.windows.net,1433;Database=asirdb;User ID=asirdbmanager@n3ilvzmhwm;Password=asir2015-2016;Trusted_Connection=False;Encrypt=True;Connection Timeout=30;"
Line 141: ' Azure
Line 142: strProvider = "Provider=SQLOLEDB.1;Persist Security Info=False;UID=asirdbmanager@n3ilvzmhwm;PWD=asir2015-2016;Initial Catalog=asirdb;Data Source=n3ilvzmhwm.database.windows.net"
Line 143: ' Local
Line 144: 'strProvider = "Provider=SQLOLEDB.1;Persist Security Info=False;UID=webcontent;PWD=web08008887588;Initial Catalog=asirdb;Data Source=127.0.0.1"
Line 145: 'strProvider = "DRIVER=SQL Server Native Client 11.0;Server=n3ilvzmhwm.database.windows.net;UID=asirdbmanager@n3ilvzmhwm;PWD=asir2015-2016;Encrypt=yes;TrustServerCertificate=no;"
Line 146: 'Response.Write strProvider
Line 147: Conn.Open strProvider
Line 148: If Err Then
Line 149: Err.Clear
Line 150: Set Conn = Nothing
Line 151: Response.Write "資料庫連結出錯,請檢查連結字串。"
Line 152: Response.Write "<br/>"
Line 153: Response.Write strProvider
Line 154: Response.End
Line 155: End If
Line 156: Set GetConnection = Conn
Line 157: End Function
Line 158:
Line 159: Function GetConnection2(DBName)
Line 160: Dim strProvider
Line 161: Dim Server_Address, DB_Name, DB_ID, DB_PassWord
Line 162:
Line 163: ' MSSQL
Line 164: ' 61.221.67.227 DEB
Line 165: Server_Address = "127.0.0.1"
Line 166: 'Server_Address = "61.221.67.227"
Line 167: 'Server_Address = "210.61.150.10"
Line 168: DB_Name = "carwin"
Line 169: DB_ID = "carwin"
Line 170: 'DB_PassWord = "CarWin-12345600"
Line 171: DB_PassWord = "carwin"
Line 172:
Line 173: Set Conn = Server.CreateObject("ADODB.Connection")
Line 174: ' MDB
Line 175: 'strProvider = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source = " & Server.MapPath("\db\" & DBName &".mdb")
Line 176: ' MSSQL
Line 177: strProvider = "driver={SQL Server};Server="&Server_Address&";Database="&DB_Name&";UID="&DB_ID&";PWD="&DB_PassWord&";"
Line 178: 'strProvider = "driver={SQL Server};Server="&Server_Address&";Database="&DB_Name&";UID="&DB_ID&";PWD="&DB_PassWord&";"
Line 179: 'strProvider = "Provider=sqloledb;Data Source="&Server_Address&";Initial Catalog="&DB_Name&";User ID="&DB_ID&";Password="&DB_PassWord&";"
Line 180: ' 正式機
Line 181: 'strProvider = "Provider=SQLOLEDB.1;Persist Security Info=False;UID=carwin;PWD=carwin;Initial Catalog=carwin;Data Source=192.168.0.8"
Line 182: strProvider = "Provider=SQLOLEDB.1;Persist Security Info=False;UID=flash2u;PWD=12345600;Initial Catalog=carwin;Data Source=210.61.150.11"
Line 183: strProvider = "Provider=SQLOLEDB.1;Persist Security Info=False;UID=flash2u;PWD=12345600;Initial Catalog=carwin;Data Source=127.0.0.1"
Line 184: ' 20140506
Line 185: strProvider = "Provider=SQLOLEDB.1;Persist Security Info=False;UID=deb;PWD=deb;Initial Catalog=carwin;Data Source=192.168.0.8"
Line 186: 'Response.Write strProvider
Line 187: Conn.Open strProvider
Line 188: If Err Then
Line 189: Err.Clear
Line 190: Set Conn = Nothing
Line 191: Response.Write "資料庫連結出錯,請檢查連結字串。"
Line 192: Response.End
Line 193: End If
Line 194: Set GetConnection2 = Conn
Line 195: End Function
Line 196:
Line 197: Function GetConnection3(DBName)
Line 198: Dim strProvider
Line 199: Dim Server_Address, DB_Name, DB_ID, DB_PassWord
Line 200:
Line 201: Set GetConnection3Conn = Server.CreateObject("ADODB.Connection")
Line 202: strProvider = "Provider=SQLOLEDB.1;Persist Security Info=False;UID=carwin;PWD=carwin;Initial Catalog=DEB;Data Source=192.168.0.8"
Line 203:
Line 204: GetConnection3Conn.Open strProvider
Line 205: If Err Then
Line 206: Err.Clear
Line 207: Set GetConnection3Conn = Nothing
Line 208: Response.Write "資料庫連結出錯,請檢查連結字串。"
Line 209: Response.End
Line 210: End If
Line 211: Set GetConnection3 = GetConnection3Conn
Line 212: End Function
Line 213:
Line 214: Function CloseDBLink()
Line 215: Rs.Close
Line 216: Conn.Close
Line 217: Set Rs = Nothing
Line 218: Set Conn = Nothing
Line 219: End Function
Line 220:
Line 221: Sub PageInit()
Line 222: BrandPK = Request("BrandPK")
Line 223: KindPK = Request("KindPK")
Line 224: ItemPK = Request("ItemPK")
Line 225: SortFieldName = Request("Sort")
Line 226:
Line 227: If BrandPK = Empty then
Line 228: BrandPK = 15'死都不會變
Line 229: End If
Line 230: If KindPK = Empty then
Line 231: KindPK = 11
Line 232: End If
Line 233: If ItemPK = Empty Then
Line 234: ItemPK = Request.Cookies("SL_Prod_ItemPK")
Line 235: If ItemPK = Empty Then
Line 236: ItemPK = 45
Line 237: Response.Cookies("SL_Prod_ItemPK") = ItemPK
Line 238: End If
Line 239: End If
Line 240: If SortFieldName <> Empty Then
Line 241: Response.Cookies("SortFieldName") = SortFieldName
Line 242: Else
Line 243: SortFieldName = Request.Cookies("SortFieldName")
Line 244: If SortFieldName = Empty Then SortFieldName = "SN"
Line 245: End If
Line 246: Set Conn = GetConnection(3)
Line 247: strSQL = "Select Name From SL_Brand Where PK = " & BrandPK
Line 248: Set Rs = Execute(strSQL)
Line 249: BrandName = Rs(0)
Line 250: Rs.Close
Line 251: Conn.Close
Line 252: Set Rs = Nothing
Line 253: Set Conn = Nothing
Line 254: End Sub
Line 255:
Line 256: 'LoadApplication
Line 257: 'Function ReLoadCache()
Line 258: ' Application(CacheName & "_IndexNewProducts") = LoadFile(2,"Index_NewProducts.htm")
Line 259: 'End Function
Line 260:
Line 261: '執行SQL
Line 262: Function Execute(strCommand)
Line 263: If ShowSQL = 1 Then
Line 264: Response.Write strCommand & "<br>"
Line 265: Response.End()
Line 266: Else
Line 267: 'Response.Write str_Command & "<br>"
Line 268: Set Execute = Conn.Execute(strCommand)
Line 269: If Err Then
Line 270: Err.Clear
Line 271: Set Conn = Nothing
Line 272: Response.Write "查詢資料的時候發現錯誤,請檢查您的查詢程式碼是否正確。"
Line 273: Response.End
Line 274: End If
Line 275: End If
Line 276: End Function
Line 277:
Line 278: '執行SQL放進Array
Line 279: Function ExecuteToArray(strCommand)
Line 280: Set Rs = CreateObject("ADODB.Recordset")
Line 281: 'response.write strCommand
Line 282: Rs.Open strCommand,Conn,1,1
Line 283: If Rs.EOF <> True Then
Line 284: DataArray = Rs.GetRows
Line 285: DataArrayCount = Ubound(DataArray,2)
Line 286: Else
Line 287: DataArray = Empty
Line 288: DataArrayCount = -1
Line 289: End If
Line 290: Rs.Close
Line 291: Set Rs = Nothing
Line 292: ExecuteToArray = DataArray
Line 293: End Function
Line 294:
Line 295: Function ExecuteToArray2(strCommand)
Line 296: Set Rs = CreateObject("ADODB.Recordset")
Line 297: 'response.write strCommand
Line 298: Rs.Open strCommand,Conn,1,1
Line 299: If Rs.EOF <> True Then
Line 300: DataArray2 = Rs.GetRows
Line 301: DataArrayCount2 = Ubound(DataArray2,2)
Line 302: Else
Line 303: DataArray2 = Empty
Line 304: DataArrayCount2 = -1
Line 305: End If
Line 306: Rs.Close
Line 307: Set Rs = Nothing
Line 308: ExecuteToArray2 = DataArray2
Line 309: End Function
Line 310:
Line 311: ' Cache
Line 312: Dim CacheName,CacheOverTime
Line 313:
Line 314: CacheName = "asir2019"
Line 315: CacheOverTime = 30
Line 316:
Line 317: Function loadWebCache(FileName)
Line 318: Err.Clear
Line 319: On Error Resume Next
Line 320: If Application(CacheName & "_Update") = False And DateDiff("s",Application(CacheName & "_UpdateTime"),Now()) < CacheOverTime Then
Line 321: If Application(CacheName & "_" & FileName) = Empty Or Application(CacheName & "_" & FileName) = "" Then
Line 322: loadWebCache = false
Line 323: loadWebCache = ReadTemplate(FileName)
Line 324: Else
Line 325: ' 讀取Cache
Line 326: 'loadWebCache = "<!-- " & Application(CacheName & "_UpdateTime") & " -->" & Application(CacheName & "_" & FileName)
Line 327: loadWebCache = Application(CacheName & "_" & FileName)
Line 328: End If
Line 329: Else
Line 330: loadWebCache = false
Line 331: loadWebCache = ReadTemplate(FileName)
Line 332: End If
Line 333: If Err Then
Line 334: strBody = "" & VBCRLF
Line 335: strBody = strBody & "Error at "&Time() &VBCRLF
Line 336: strBody = strBody & "Err.Line: " & Err.Line &VBCRLF
Line 337: strBody = strBody & "Err.Number: " & Err.Number &VBCRLF
Line 338: strBody = strBody & "Err.Description: " & Err.Description &VBCRLF
Line 339: strBody = strBody & "Err.Source: " & Err.Source &VBCRLF
Line 340: Response.Write VBCRLF & "Err=" & strBody
Line 341: Response.End
Line 342: Else
Line 343: 'Response.Write "NO ERR" & VBCRLF
Line 344: End If
Line 345: On Error Goto 0
Line 346: End Function
Line 347:
Line 348: Function setWebCache(FileName, Content)
Line 349:
Line 350: Err.Clear
Line 351: On Error Resume Next
Line 352: Application.Lock()
Line 353: Application(CacheName & "_Update") = True
Line 354: Application(CacheName & "_UpdateTime") = Now()
Line 355: Application(CacheName & "_Update") = False
Line 356: Application(CacheName & "_" & FileName) = Content
Line 357: Application.UnLock()
Line 358: setWebCache = True
Line 359: If Err Then
Line 360: strBody = "" & VBCRLF
Line 361: strBody = strBody & "Error at "&Time() &VBCRLF
Line 362: strBody = strBody & "Err.Line: " & Err.Line &VBCRLF
Line 363: strBody = strBody & "Err.Number: " & Err.Number &VBCRLF
Line 364: strBody = strBody & "Err.Description: " & Err.Description &VBCRLF
Line 365: strBody = strBody & "Err.Source: " & Err.Source &VBCRLF
Line 366: Response.Write VBCRLF & "Err=" & strBody
Line 367: Response.End
Line 368: Else
Line 369: 'Response.Write "NO ERR" & VBCRLF
Line 370: End If
Line 371: On Error Goto 0
Line 372: End Function
Line 373:
Line 374: 'ReadTemplate
Line 375: Function ReadTemplate(FileName)
Line 376: Folder = "1"
Line 377: If Application(CacheName & "_Update") = False And DateDiff("s",Application(CacheName & "_UpdateTime"),Now()) < CacheOverTime Then
Line 378: If Application(CacheName & "_" & FileName) = Empty Or Application(CacheName & "_" & FileName) = "" Then
Line 379: Application.Lock()
Line 380: Application(CacheName & "_" & FileName) = LoadFile(Folder, FileName)
Line 381: Application.UnLock()
Line 382: End If
Line 383: Else
Line 384: Application.Lock()
Line 385: Application(CacheName & "_Update") = True
Line 386: Application(CacheName & "_UpdateTime") = Now()
Line 387: Application(CacheName & "_Update") = False
Line 388: Application(CacheName & "_" & FileName) = LoadFile(Folder, FileName)
Line 389: Application.UnLock()
Line 390: End If
Line 391: ReadTemplate = Application(CacheName & "_" & FileName)
Line 392: End Function
Line 393:
Line 394: 'Load Template and Include_File
Line 395: Function LoadFile(Folder, FileName)
Line 396: Dim Str, FilePath
Line 397: Select Case Folder
Line 398: Case 1
Line 399: FilePath = TPPath
Line 400: Case 2
Line 401: FilePath = WFPath
Line 402: End Select
Line 403: FilePath = "Include_File\"
Line 404: Set ObjStream = Server.CreateObject("ADODB.Stream")
Line 405: 'Response.Write (Server.MapPath(FilePath & FileName)) & "<br>"
Line 406: 'Response.Write (FilePath & FileName) & "<br>"
Line 407: On Error Resume Next
Line 408: With ObjStream
Line 409: .Type = 2 'Return 1=Binary,2=Text
Line 410: .Mode = 3 'Read Model; 1=Read;2=Write;3=ReadWrite
Line 411: .Charset = "UTF-8"
Line 412: .Open()
Line 413: .LoadFromFile(Server.MapPath(FilePath & FileName))
Line 414: Str = .ReadText
Line 415: .Close
Line 416: End With
Line 417: If Err Then
Line 418: strBody = "" & VBCRLF
Line 419:
Line 420: strBody = strBody & "Error FileName: "&FileName &VBCRLF
Line 421: strBody = strBody & "Error at "&Time() &VBCRLF
Line 422: strBody = strBody & "Err.Line: " & Err.Line &VBCRLF
Line 423: strBody = strBody & "Err.Number: " & Err.Number &VBCRLF
Line 424: strBody = strBody & "Err.Description: " & Err.Description &VBCRLF
Line 425: strBody = strBody & "Err.Source: " & Err.Source &VBCRLF
Line 426: Response.Write VBCRLF & "<!-- Err=" & strBody & " -->"
Line 427: LoadFile = ""
Line 428: 'Response.End
Line 429: Else
Line 430: 'Response.Write "NO ERR" & VBCRLF
Line 431: End If
Line 432: On Error Goto 0
Line 433: 'Str = Replace(Str,"<iframe","<xiframe")
Line 434: 'Str = Replace(Str,"</iframe","</xiframe")
Line 435:
Line 436: ' 怕碰到不是HTML檔,例如JSON不能用換行和<!-- 符號
Line 437: If Instr(FileName,".htm") <> 0 Then
Line 438: ' 標註讀取時間
Line 439: Str = Str & vbCrLf & "<!-- " & FileName & " Load on " & Now & " -->"
Line 440: End If
Line 441:
Line 442: LoadFile = Str
Line 443: Set ObjStream = Nothing
Line 444: End Function
Line 445:
Line 446:
Line 447:
Line 448: 'Write Include_File
Line 449: Function WriteFile(FileName, strFileContent)
Line 450: 'Response.Write "File=" & Server.MapPath(FileName) & "<br/>"
Line 451: Set ObjStream = Server.CreateObject("ADODB.Stream")
Line 452: With ObjStream
Line 453: .Type = 2
Line 454: .Mode = 3
Line 455: .Charset = "UTF-8"
Line 456: .Open()
Line 457: .WriteText(strFileContent)
Line 458: .SaveToFile Server.MapPath(FileName),2
Line 459: .Close
Line 460: End With
Line 461: Set ObjStream = Nothing
Line 462: End Function
Line 463:
Line 464: 'Count PageView
Line 465: Function CountPageView(TableName, ColName, KeyName)
Line 466: On Error Resume Next
Line 467: Dim strUpSQL
Line 468: response.write TableName
Line 469: response.write ColName
Line 470: response.write KeyName
Line 471: response.write "<br>"
Line 472: strUpSQL = "Update " & TableName & " Set " & ColName & " = " & ColName + 1 & " Where Id = " & KeyName
Line 473: response.write strUpSQL
Line 474: response.End()
Line 475: Execute(strSQL)
Line 476: End Function
Line 477:
Line 478:
Line 479: '取得類別、項目名稱
Line 480: Function GetCategoryItemName()
Line 481: Dim strSQL
Line 482: strSQL = "Select k.Name as KindName,i.Name as ItemName From SL_Prod_Kind As k Inner Join SL_Prod_Item As i On k.PK = i.KindPK Where i.PK = "& ItemPK & " And k.Brand='" & BrandName & "'"
Line 483: Set Rs = Execute(strSQL)
Line 484: If Not Rs.Eof then
Line 485: KindName = Rs(0)
Line 486: ItemName = Rs(1)
Line 487: End If
Line 488: 'Rs.Close
Line 489: 'Set Rs = Nothing
Line 490: End Function
Line 491:
Line 492:
Line 493: Function CheckExp(patrn,strng,tagstr)
Line 494: Dim regEx,Matches
Line 495: Set regEx = New RegExp
Line 496: regEx.Pattern = patrn
Line 497: regEx.IgnoreCase = True
Line 498: regEx.Global = True
Line 499: regEx.Multiline = True
Line 500: Matches = regEx.replace(strng,tagstr)
Line 501: CheckExp = Matches
Line 502: End Function
Line 503:
Line 504: Function SetupPageMenu(URL)
Line 505: ' 上下頁更換
Line 506: If Page <= 1 Then
Line 507: PrePage = 1
Line 508: StrTempPrev = Replace(StrTempPrev, "{FornClass}", SpanClass1)
Line 509: Else
Line 510: PrePage = Page - 1
Line 511: StrTempPrev = Replace(Replace(StrTempPrev, "{FornClass}", SpanClass2), "Back", BackUrl)
Line 512: End If
Line 513: If Page >= TotalPage Then
Line 514: NextPage = TotalPage
Line 515: StrTempNext = Replace(StrTempNext, "{FornClass}", SpanClass1)
Line 516: Else
Line 517: NextPage = Page + 1
Line 518: StrTempNext = Replace(Replace(StrTempNext, "{FornClass}", SpanClass2), "Next", NextUrl)
Line 519: End If
Line 520:
Line 521: Mod_Page = Page Mod ShowNumber
Line 522: If Page <= ShowNumber Then
Line 523: MinShowPageNumber = 1
Line 524: If ShowNumber > TotalPage Then
Line 525: MaxShowPageNumber = TotalPage
Line 526: strGNPage = Replace(strTempGNext, "{FornClass}", SpanClass1)
Line 527: Else
Line 528: MaxShowPageNumber = ShowNumber
Line 529: strGPPage = Replace(strTempGPrev, "{FornClass}", SpanClass1)
Line 530: strGNPage = Replace(Replace(Replace(Replace(strTempGNext, "{FornClass}", SpanClass2), ">", NextUrl), "iii", ShowNumber+1), "Next", ">")
Line 531: End If
Line 532: strGPPage = Replace(strTempGPrev, "{FornClass}", SpanClass1)
Line 533: Else
Line 534: For i = 0 to ShowNumber - 1
Line 535: If(Page Mod ShowNumber) = 0 Then
Line 536: MinShowPageNumber = Page - (ShowNumber-1)
Line 537: MaxShowPageNumber = Page
Line 538: P_Page = Page - ShowNumber
Line 539: N_Page = Page + 1
Line 540: End If
Line 541: If(Page Mod ShowNumber) = 1 Then
Line 542: MinShowPageNumber = Page
Line 543: MaxShowPageNumber = Page + (ShowNumber-1)
Line 544: P_Page = Page - ShowNumber
Line 545: N_Page = Page + ShowNumber
Line 546: End If
Line 547: If(Page Mod ShowNumber) = 2 Then
Line 548: MinShowPageNumber = Page - 1
Line 549: MaxShowPageNumber = Page + 1
Line 550: P_Page = Page - (ShowNumber+1)
Line 551: N_Page = Page + (ShowNumber-1)
Line 552: End If
Line 553: Next
Line 554: If MaxShowPageNumber => TotalPage Then
Line 555: MaxShowPageNumber = TotalPage
Line 556: strGNPage = Replace(strTempGNext, "{FornClass}", SpanClass1)
Line 557: Else
Line 558: strGNPage = Replace(Replace(Replace(Replace(strTempGNext, "{FornClass}", SpanClass2), ">", NextUrl), "iii", N_Page), "Next", ">")
Line 559: End If
Line 560: strGPPage = Replace(Replace(Replace(Replace(strTempGPrev, "{FornClass}", SpanClass2), "<", BackUrl), "iii", P_Page), "Back", "<")
Line 561: End If
Line 562: Call ChangeShowPageNumber(MinShowPageNumber, MaxShowPageNumber, URL)
Line 563: End Function
Line 564:
Line 565: Sub ChangeShowPageNumber(MinNum, MaxNum, URL)
Line 566: For i = MinNum to MaxNum
Line 567: If i = Page then
Line 568: NumberClass = "pager-on"
Line 569: strSUrl = ""
Line 570: strEUrl = ""
Line 571: Else
Line 572: NumberClass = "pager"
Line 573: 'strSUrl = "<a href="""&URL&".asp?KindPK=" & KindPK & "&ItemPK=" & ItemPK & "&Page=" & i & """>"
Line 574: 'strSUrl = "<a href="""&URL&".asp?Page=" & i & """>"
Line 575: strSUrl = "<a href="""&URL&".asp?KindPK=" & KindPK & "&Page=" & i & """>"
Line 576: strEUrl = "</a>"
Line 577: End If
Line 578: strPageNumber = strPageNumber & "<span class=""" & NumberClass & """>" & strSUrl & i & strEUrl & "</span>"
Line 579: Next
Line 580: End Sub
Line 581:
Line 582: ' 檢查傳遞的參數是否合法
Line 583: Function CheckInput(str,strType)
Line 584: Dim strTmp
Line 585: strTmp = ""
Line 586: If strType ="s" Then
Line 587: strTmp = Replace(Trim(str),"'","''")
Line 588: ElseIf strType="i" Then
Line 589: If isNumeric(str)=False Then str="0"
Line 590: strTmp = str
Line 591: Else
Line 592: strTmp = str
Line 593: End If
Line 594: CheckInput = strTmp
Line 595: If str="0" then
Line 596: Response.Write "<script>alert('參數錯誤'); history.go(-1); </script>"
Line 597: Response.End
Line 598: End If
Line 599: End Function
Line 600:
Line 601: function fdate(d)
Line 602: If isdate(d) Then
Line 603: fdate = year(d)&"-"&right("0"&month(d),2)&"-"&right("0"&day(d),2)
Line 604: else
Line 605: fdate = d
Line 606: End If
Line 607: end function
Line 608:
Line 609: function fdate1(d)
Line 610: If isdate(d) Then
Line 611: fdate1 = year(d)-1911 & "." & right("0"&month(d),2) & "." & right("0"&day(d),2)
Line 612: else
Line 613: fdate1 = d
Line 614: End If
Line 615: end function
Line 616:
Line 617: function fdateX(d)
Line 618: If isdate(d) Then
Line 619: fdateX = year(d)&"/"&right("0"&month(d),2)&"/"&right("0"&day(d),2)
Line 620: else
Line 621: fdateX = d
Line 622: End If
Line 623: end function
Line 624:
Line 625: function fdateXZ(d)
Line 626: If isdate(d) Then
Line 627: fdateXZ = year(d)&""&right("0"&month(d),2)&""&right("0"&day(d),2)
Line 628: else
Line 629: fdateXZ = d
Line 630: End If
Line 631: end function
Line 632:
Line 633: function ftimeX(d)
Line 634: If isdate(d) Then
Line 635: ftimeX = right("00"&hour(d),2) & ":" & right("00"&minute(d),2) & ":" & right("00"&second(d),2)
Line 636: else
Line 637: ftimeX = d
Line 638: End If
Line 639: end function
Line 640:
Line 641: function ftimeX2(d)
Line 642: If isdate(d) Then
Line 643: ftimeX2 = right("00"&hour(d),2) & ":" & right("00"&minute(d),2)
Line 644: else
Line 645: ftimeX2 = d
Line 646: End If
Line 647: end function
Line 648:
Line 649: function fstring(string,n)
Line 650: Dim x,y,j
Line 651: x = 0
Line 652: y = 0
Line 653: for j = 1 to len(string)
Line 654: If asc(mid(string,j,1)) < 0 Then
Line 655: x = x + 2
Line 656: else
Line 657: x = x + 1
Line 658: End If
Line 659: y = y + 1
Line 660: If x => n Then exit for
Line 661: next
Line 662:
Line 663: If x => n Then
Line 664: fstring = left(string,y) & "...."
Line 665: else
Line 666: fstring = string
Line 667: End If
Line 668:
Line 669: end function
Line 670:
Line 671: Function GetUserIP
Line 672: Dim sIPAddress
Line 673: sIPAddress = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
Line 674: If sIPAddress="" Then sIPAddress = Request.ServerVariables("REMOTE_ADDR")
Line 675: GetUserIP = sIPAddress
Line 676: End Function
Line 677:
Line 678: Function GetUserIP2
Line 679: Dim sIPAddress
Line 680: sIPAddress = Request.ServerVariables("REMOTE_ADDR")
Line 681: GetUserIP2 = sIPAddress
Line 682: End Function
Line 683:
Line 684: Function AllowIP(Str)
Line 685: ' a135 pw=7962
Line 686: MyKeyWords = Ucase("220.135.187.194|175.180.128.72|211.76.139.61")
Line 687: KeyWords = Split(MyKeyWords,"|")
Line 688: 'Response.Write "傳入" & Str
Line 689: If Len(Str) < 1 Then
Line 690: AllowIP = false
Line 691: 'Response.Write "isnumeric"
Line 692: Exit Function
Line 693: End If
Line 694: StrTemp = Ucase(CStr(Str))
Line 695: Dim i
Line 696: For i = 0 To UBound(KeyWords) step 1
Line 697: 'Response.Write "KeyWords(" & i & ")=" & KeyWords(i) & "<br>"
Line 698: If StrTemp = KeyWords(i) Then
Line 699: ' 找到
Line 700: 'Mapgrpno = KeyWords(i+1) & "[" & Str & "]"
Line 701: AllowIP = true
Line 702: Exit Function
Line 703: End If
Line 704: Next
Line 705: AllowIP = false
Line 706: End Function
Line 707:
Line 708: Function AllowKeyword(Str)
Line 709: ' a135 pw=7962
Line 710: MyKeyWords = Ucase("減肥減重|減肥|減重|雷射溶脂|雷射減脂|雷溶|自體脂肪隆乳|自體脂肪|隆乳|胸部整形|眼鼻整形手術|醫美整型|面部輪廓|醫美療程|肌膚美容|機器人植髮|ARTAS植髮|ARTAS系統植髮|植髮|生髮|複合式生髮|最新消息|醫師專欄|診友心得|媒體報導|相關知識|名人素人分享|名人分享|素人分享|醫學美容|醫學整型|案例分享|痔瘡|痔瘡手術")
Line 711: KeyWords = Split(MyKeyWords,"|")
Line 712: 'Response.Write "傳入" & Str
Line 713: If Len(Str) < 1 Then
Line 714: AllowKeyword = false
Line 715: 'Response.Write "isnumeric"
Line 716: Exit Function
Line 717: End If
Line 718: StrTemp = Ucase(CStr(Str))
Line 719: Dim i
Line 720: For i = 0 To UBound(KeyWords) step 1
Line 721: 'Response.Write "KeyWords(" & i & ")=" & KeyWords(i) & "<br>"
Line 722: If StrTemp = KeyWords(i) Then
Line 723: ' 找到
Line 724: 'Mapgrpno = KeyWords(i+1) & "[" & Str & "]"
Line 725: AllowKeyword = true
Line 726: Exit Function
Line 727: End If
Line 728: Next
Line 729: AllowKeyword = false
Line 730: End Function
Line 731:
Line 732: Function get_time_name
Line 733: timestamp = now()
Line 734: timearr = split(timestamp , " ")
Line 735: time_a = replace(timearr(0) , "/" , "_")
Line 736: 'time_b = replace(timearr(2) , ":" , "_")
Line 737:
Line 738: Code = Right("00" & Second(Now) + Int((39 * Rnd)+1),2)
Line 739: Code = Code & Right("00" & Second(Now) + Int((39 * Rnd)+1) ,2)
Line 740: Code = Code & Right("00" & Second(Now) + Int((39 * Rnd)+1) ,2)
Line 741: Code = Code & Right("00" & Second(Now) + Int((39 * Rnd)+1) ,2)
Line 742: Code = Code & Right("00" & Second(Now) + Int((39 * Rnd)+1) ,2)
Line 743: Code = Code & Right("00" & Second(Now) + Int((39 * Rnd)+1) ,2)
Line 744: get_time_name = time_a & "_" & Code
Line 745: End Function
Line 746:
Line 747: function diginum(d)
Line 748: If isnumeric(d) Then
Line 749: diginum = Right("00000" & CStr(d),5)
Line 750: Else
Line 751: diginum = d
Line 752: End If
Line 753: end function
Line 754:
Line 755: Function SafeRequest(ParaName,ParaType)
Line 756: '--- 傳入參數 ---
Line 757: 'ParaName:參數名稱-字元型
Line 758: 'ParaType:參數類型-數字型(1表示參數是數字,0表示參數為字元)
Line 759: Dim ParaValue
Line 760: ParaValue = Trim(Request(ParaName))
Line 761:
Line 762: If IsNull(ParaValue) Or ParaValue = "" Then
Line 763: SafeRequest = ""
Line 764: Exit Function
Line 765: End If
Line 766:
Line 767: If ParaType = 1 then
Line 768: If Not isNumeric(ParaValue) Then
Line 769: Response.Write "參數" & ParaName & "必須為數字!<br>"
Line 770: Response.Write "<a href='javascript:window.history.go(-1);'>回上頁</a>"
Line 771: Response.End
Line 772: End if
Line 773: Else
Line 774: ParaValue=replace(ParaValue,"'","''")
Line 775: End if
Line 776: SafeRequest=ParaValue
Line 777: End Function
Line 778:
Line 779: Function SafeRequestCharMax(ParaName,ParaLength)
Line 780: SafeRequestCharMax = Replace(Trim(Request(ParaName) & " " ),"'","''")
Line 781: SafeRequestCharMax = SafeRequest(ParaName,0)
Line 782: SafeRequestCharMax = Trim(Right(SafeRequestCharMax,ParaLength))
Line 783: End Function
Line 784:
Line 785: '獲取當前Url參數的函數
Line 786: Function GetUrl()
Line 787: Dim ScriptAddress, Domain_Name, M_ItemUrl, M_item
Line 788: ScriptAddress = CStr(Request.ServerVariables("SCRIPT_NAME")) '取得當前位址
Line 789: Domain_Name = LCase(Request.ServerVariables("Server_Name"))
Line 790: M_ItemUrl = ""
Line 791: If (Request.QueryString <> "") Then
Line 792: ScriptAddress = ScriptAddress & "?"
Line 793: For Each M_item In Request.QueryString
Line 794: If InStr(page,M_Item)=0 Then
Line 795: M_ItemUrl = M_ItemUrl & M_Item &"="& Server.URLEncode(Request.QueryString(""&M_Item&"")) & "&"
Line 796: End If
Line 797: Next
Line 798: End If
Line 799: If Right(M_ItemUrl,1) = "&" Then
Line 800: M_ItemUrl = Left(M_ItemUrl,Len(M_ItemUrl)-1)
Line 801: End If
Line 802: GetUrl = "https://" & Domain_Name & ScriptAddress & M_ItemUrl
Line 803: ' 處理Rewrite ,如 https://a-sir.ezcare.com.tw/blog_inside.asp?id=315
Line 804: If ScriptAddress = "/blog_inside.asp?" Then
Line 805: M_ItemUrl = Replace(M_ItemUrl,"&page=1","")
Line 806: M_ItemUrl = Replace(M_ItemUrl,"&page=2","")
Line 807: M_ItemUrl = Replace(M_ItemUrl,"&page=3","")
Line 808: M_ItemUrl = Replace(M_ItemUrl,"&page=4","")
Line 809: M_ItemUrl = Replace(M_ItemUrl,"&page=5","")
Line 810: M_ItemUrl = Replace(M_ItemUrl,"&page=6","")
Line 811: M_ItemUrl = Replace(M_ItemUrl,"&page=7","")
Line 812: M_ItemUrl = Replace(M_ItemUrl,"&page=8","")
Line 813: M_ItemUrl = Replace(M_ItemUrl,"&page=9","")
Line 814: M_ItemUrl = Replace(M_ItemUrl,"&page=10","")
Line 815: aID = SafeRequestCharMax("id",20)
Line 816: GetUrl = "https://" & Domain_Name & "/article/" & aID & ".html"
Line 817: 'GetUrl = "https://" & Domain_Name & "/article/" & Replace(M_ItemUrl,"id=","") & ".html"
Line 818: 'GetUrl = "https://" & Domain_Name & ScriptAddress & M_ItemUrl
Line 819: 'GetUrl = ScriptAddress
Line 820: End If
Line 821: If ScriptAddress = "/blog_index.asp?" Then
Line 822: aClassification = SafeRequestCharMax("acs",20)
Line 823: aType = SafeRequestCharMax("ats",20)
Line 824: GetUrl = "https://" & Domain_Name & "/article/" & aClassification & "-" & aType
Line 825: 'GetUrl = "https://" & Domain_Name & ScriptAddress & M_ItemUrl
Line 826: 'GetUrl = ScriptAddress
Line 827: End If
Line 828: 'GetUrl = M_ItemUrl
Line 829: End Function
Line 830:
Line 831: Function Cur_Url() '獲取當前頁面URL的函數
Line 832: Domain_Name = LCase(Request.ServerVariables("Server_Name"))
Line 833: Page_Name = LCase(Request.ServerVariables("Script_Name"))
Line 834: Quary_Name = LCase(Request.ServerVariables("Quary_String"))
Line 835: If Quary_Name ="" Then
Line 836: Cur_Url = "http://"&Domain_Name&Page_Name
Line 837: Else
Line 838: Cur_Url = "http://"&Domain_Name&Page_Name&"?"&Quary_Name
Line 839: End If
Line 840: End Function
Line 841:
Line 842:
Line 843: #End ExternalSource
Line 844:
Line 845: #ExternalSource("C:\home\site\wwwroot\Inc\ChkFunction.asp",1)
Line 846:
Line 847: ' 檢查線上人數
Line 848: Call ChkOnline()
Line 849: Function ChkOnline()
Line 850: ChkOnline = True
Line 851: Set LoginRecordConn = GetConnection("asirdb")
Line 852: ' 先刪除登入紀錄
Line 853: LoginRecordSQL = "Delete From WebLoginInfo Where DATEDIFF(minute,UserLoginTime,GETDATE()) > 30"
Line 854: LoginRecordConn.execute(LoginRecordSQL)
Line 855: ' 更新線上紀錄
Line 856:
Line 857: LoginRecordSQL = "Select top 100 * From WebLoginInfo Order by UserLoginTime desc"
Line 858: Set LoginRecordRs = Server.CreateObject("Adodb.RecordSet")
Line 859:
Line 860: LoginRecordRs.Open LoginRecordSQL,LoginRecordConn,1,1
Line 861:
Line 862: OnlineRecordsString = ""
Line 863: If Not LoginRecordRs.EOF Then
Line 864:
Line 865: Do While LoginRecordRs.EOF <> True
Line 866: If OnlineRecordsString <> "" Then
Line 867: OnlineRecordsString = OnlineRecordsString & " , " & LoginRecordRs("UserName")
Line 868: Else
Line 869: OnlineRecordsString = LoginRecordRs("UserName")
Line 870: End If
Line 871: '
Line 872: LoginRecordRs.MoveNext
Line 873: Loop
Line 874: ChkOnline = OnlineRecordsString
Line 875: Else
Line 876: ChkOnline = False
Line 877: OnlineRecordsString = ""
Line 878: End If
Line 879:
Line 880: Application("ChkOnline") = OnlineRecordsString
Line 881: LoginRecordRs.Close
Line 882: LoginRecordConn.Close
Line 883: End Function
Line 884: ' 登入登出Session控制
Line 885: Function LoginSession(doWhat)
Line 886: If doWhat = "login" Then
Line 887: Session("UserID") = rs("UserID")
Line 888: Session("UserName") = rs("UserName")
Line 889: Session("UserGroup") = rs("UserGroup")
Line 890: Session("UserLoginTime") = Now()
Line 891: Session("UserAliveTime") = Now()
Line 892: Session("UserLevel") = rs("UserLevel")
Line 893:
Line 894: ' 紀錄線上登入者
Line 895: Call LoginRecord(doWhat)
Line 896: ' 紀錄使用者Log
Line 897: Call AddUserActionLog("登入","成功")
Line 898: Else
Line 899: ' 紀錄線上登入者
Line 900: Call LoginRecord(doWhat)
Line 901: ' 紀錄使用者Log
Line 902: Call AddUserActionLog("登出","成功")
Line 903: Session("UserID") = ""
Line 904: Session("UserName") = ""
Line 905: Session("UserGroup") = ""
Line 906: 'Session("PLoginBelongLeader") = ""
Line 907: Session("UserLoginTime") = ""
Line 908: Session("UserAliveTime") = ""
Line 909: Session("UserLevel") = ""
Line 910: End If
Line 911:
Line 912: End Function
Line 913: Function ChkLoginInfo()
Line 914: showmsg = "登入逾時,請重新登入"
Line 915: If Session("UserID") = "" Or Session("UserName") = "" Or Session("UserGroup") = "" Then
Line 916: 'Response.Write "<script language='javascript'>"
Line 917: 'Response.Write "var msg='" & showmsg & "';"
Line 918: 'Response.Write "alert(msg);window.location='userlogin.asp';</script>"
Line 919: 'Response.Write "<a href='userlogin.asp'>" & showmsg & "</a>"
Line 920: 'Response.End
Line 921: End If
Line 922: 'Call ChkLoginRecord()
Line 923: End Function
Line 924:
Line 925: ' 新版
Line 926: Function ChkLogin()
Line 927: showmsg = "登入逾時,請重新登入"
Line 928: If Session("UserID") = "" Or Session("UserName") = "" Or Session("UserGroup") = "" Then
Line 929: Response.Write "<script language='javascript'>"
Line 930: Response.Write "var msg='" & showmsg & "';"
Line 931: Response.Write "alert(msg);window.location='userlogin.asp';</script>"
Line 932: Response.Write "<a href='userlogin.asp'>" & showmsg & "</a>"
Line 933: Response.End
Line 934: End If
Line 935: Call ChkLoginRecord()
Line 936: End Function
Line 937:
Line 938: Function ChkLoginInfoTop()
Line 939: showmsg = "登入逾時,請重新登入!"
Line 940: If Session("UserID") = "" Or Session("UserName") = "" Or Session("UserGroup") = "" Then
Line 941: Response.Write "<script language='javascript'>"
Line 942: Response.Write "var msg='" & showmsg & "';"
Line 943: Response.Write "alert(msg);window.top.location='userlogin.asp';</script>"
Line 944: Response.Write "<a href='userlogin.asp'>" & showmsg & "</a>"
Line 945: Response.End
Line 946: End If
Line 947: Call ChkLoginRecord()
Line 948: End Function
Line 949:
Line 950: Function ChkLoginRecord()
Line 951: ChkLoginRecord = True
Line 952: Set LoginRecordConn = GetConnection("asirdb")
Line 953: ' 先刪除登入紀錄
Line 954: LoginRecordSQL = "Delete From WebLoginInfo Where DATEDIFF(minute,UserLoginTime,GETDATE()) > 30"
Line 955: LoginRecordConn.execute(LoginRecordSQL)
Line 956: ' 更新線上紀錄
Line 957: LoginRecordSQL = "Select top 1 * From WebLoginInfo Where UserID='" & Session("UserID") & "' Order by PK desc"
Line 958: Set LoginRecordRs = Server.CreateObject("Adodb.RecordSet")
Line 959: LoginRecordRs.Open LoginRecordSQL,LoginRecordConn,3,3
Line 960: If Not LoginRecordRs.EOF Then
Line 961: 'If Session("UserLoginTime") <> LoginRecordRs("UserLoginTime") Then
Line 962: ' ChkLoginRecord = False
Line 963: 'End If
Line 964: Response.Write "<!-- Login登入 -->"
Line 965: Response.Write "<!--" & Session("UserLoginTime") & "/" & LoginRecordRs("UserLoginTime") & "-->"
Line 966: thisUserLoginTime = Now()
Line 967: LoginRecordRs("UserLoginTime") = thisUserLoginTime
Line 968: Session("UserLoginTime") = thisUserLoginTime
Line 969: Session("UserAliveTime") = thisUserLoginTime
Line 970: LoginRecordRs.Update
Line 971: Else
Line 972: ChkLoginRecord = False
Line 973: End If
Line 974: LoginRecordRs.Close
Line 975: LoginRecordConn.Close
Line 976: ' 重複登入或沒有資料
Line 977: showmsg = "登入逾時,請重新登入"
Line 978: If ChkLoginRecord = False Then
Line 979: Response.Write "<script language='javascript'>"
Line 980: Response.Write "var msg='" & showmsg & "';"
Line 981: Response.Write "alert(msg);window.location='userlogin.asp';</script>"
Line 982: Response.Write "<a href='userlogin.asp'>" & showmsg & "</a>"
Line 983: Response.End
Line 984: End If
Line 985: End Function
Line 986:
Line 987: Function LoginRecord(doWhat)
Line 988: 'exit function
Line 989: If doWhat = "login" Then
Line 990: Err.Clear
Line 991: On Error Resume Next
Line 992: Set LoginRecordConn = GetConnection("asirdb")
Line 993: '錯誤處理
Line 994: If Err.Number <> 0 Then
Line 995: '清除頁面
Line 996: Response.Clear
Line 997:
Line 998:
Line 999: #End ExternalSource
Line 1000: __w.Write(""&Global.Microsoft.VisualBasic.ChrW(13)&Global.Microsoft.VisualBasic.ChrW(10)&Global.Microsoft.VisualBasic.ChrW(9)&Global.Microsoft.VisualBasic.ChrW(9)&Global.Microsoft.VisualBasic.ChrW(9)&"LoginRecord function 資料庫開啟失敗<BR>"&Global.Microsoft.VisualBasic.ChrW(13)&Global.Microsoft.VisualBasic.ChrW(10)&Global.Microsoft.VisualBasic.ChrW(9)&Global.Microsoft.VisualBasic.ChrW(9)&Global.Microsoft.VisualBasic.ChrW(9)&"錯誤 Number: ")
Line 1001:
Line 1002: #ExternalSource("C:\home\site\wwwroot\Inc\ChkFunction.asp",154)
Line 1003: __w.Write( Err.Number )
Line 1004:
Line 1005:
Line 1006: #End ExternalSource
Line 1007: __w.Write("<BR> "&Global.Microsoft.VisualBasic.ChrW(13)&Global.Microsoft.VisualBasic.ChrW(10)&Global.Microsoft.VisualBasic.ChrW(9)&Global.Microsoft.VisualBasic.ChrW(9)&Global.Microsoft.VisualBasic.ChrW(9)&"錯誤信息: ")
Line 1008:
Line 1009: #ExternalSource("C:\home\site\wwwroot\Inc\ChkFunction.asp",155)
Line 1010: __w.Write( Err.Description )
Line 1011:
Line 1012:
Line 1013: #End ExternalSource
Line 1014: __w.Write("<BR> "&Global.Microsoft.VisualBasic.ChrW(13)&Global.Microsoft.VisualBasic.ChrW(10)&Global.Microsoft.VisualBasic.ChrW(9)&Global.Microsoft.VisualBasic.ChrW(9)&Global.Microsoft.VisualBasic.ChrW(9)&"出錯文件: ")
Line 1015:
Line 1016: #ExternalSource("C:\home\site\wwwroot\Inc\ChkFunction.asp",156)
Line 1017: __w.Write( Err.Source )
Line 1018:
Line 1019:
Line 1020: #End ExternalSource
Line 1021: __w.Write("<BR> "&Global.Microsoft.VisualBasic.ChrW(13)&Global.Microsoft.VisualBasic.ChrW(10)&Global.Microsoft.VisualBasic.ChrW(9)&Global.Microsoft.VisualBasic.ChrW(9)&Global.Microsoft.VisualBasic.ChrW(9)&"出錯行: ")
Line 1022:
Line 1023: #ExternalSource("C:\home\site\wwwroot\Inc\ChkFunction.asp",157)
Line 1024: __w.Write( Err.Line )
Line 1025:
Line 1026:
Line 1027: #End ExternalSource
Line 1028: __w.Write("<BR> "&Global.Microsoft.VisualBasic.ChrW(13)&Global.Microsoft.VisualBasic.ChrW(10)&Global.Microsoft.VisualBasic.ChrW(9)&Global.Microsoft.VisualBasic.ChrW(9)&Global.Microsoft.VisualBasic.ChrW(9))
Line 1029:
Line 1030: #ExternalSource("C:\home\site\wwwroot\Inc\ChkFunction.asp",158)
Line 1031:
Line 1032: Response.End
Line 1033: End If
Line 1034: On Error Goto 0
Line 1035:
Line 1036: Err.Clear
Line 1037: On Error Resume Next
Line 1038: ' 先刪除登入紀錄
Line 1039: LoginRecordSQL = "Delete From WebLoginInfo Where UserID='" & Session("UserID") & "'"
Line 1040: LoginRecordConn.execute(LoginRecordSQL)
Line 1041: '錯誤處理
Line 1042: If Err.Number <> 0 Then
Line 1043: '清除頁面
Line 1044: Response.Clear
Line 1045:
Line 1046:
Line 1047: #End ExternalSource
Line 1048: __w.Write(""&Global.Microsoft.VisualBasic.ChrW(13)&Global.Microsoft.VisualBasic.ChrW(10)&Global.Microsoft.VisualBasic.ChrW(9)&Global.Microsoft.VisualBasic.ChrW(9)&Global.Microsoft.VisualBasic.ChrW(9)&"LoginRecord function 資料庫Delete失敗<BR>"&Global.Microsoft.VisualBasic.ChrW(13)&Global.Microsoft.VisualBasic.ChrW(10)&Global.Microsoft.VisualBasic.ChrW(9)&Global.Microsoft.VisualBasic.ChrW(9)&Global.Microsoft.VisualBasic.ChrW(9)&"錯誤 Number: ")
Line 1049:
Line 1050: #ExternalSource("C:\home\site\wwwroot\Inc\ChkFunction.asp",174)
Line 1051: __w.Write( Err.Number )
Line 1052:
Line 1053:
Line 1054: #End ExternalSource
Line 1055: __w.Write("<BR> "&Global.Microsoft.VisualBasic.ChrW(13)&Global.Microsoft.VisualBasic.ChrW(10)&Global.Microsoft.VisualBasic.ChrW(9)&Global.Microsoft.VisualBasic.ChrW(9)&Global.Microsoft.VisualBasic.ChrW(9)&"錯誤信息: ")
Line 1056:
Line 1057: #ExternalSource("C:\home\site\wwwroot\Inc\ChkFunction.asp",175)
Line 1058: __w.Write( Err.Description )
Line 1059:
Line 1060:
Line 1061: #End ExternalSource
Line 1062: __w.Write("<BR> "&Global.Microsoft.VisualBasic.ChrW(13)&Global.Microsoft.VisualBasic.ChrW(10)&Global.Microsoft.VisualBasic.ChrW(9)&Global.Microsoft.VisualBasic.ChrW(9)&Global.Microsoft.VisualBasic.ChrW(9)&"出錯文件: ")
Line 1063:
Line 1064: #ExternalSource("C:\home\site\wwwroot\Inc\ChkFunction.asp",176)
Line 1065: __w.Write( Err.Source )
Line 1066:
Line 1067:
Line 1068: #End ExternalSource
Line 1069: __w.Write("<BR> "&Global.Microsoft.VisualBasic.ChrW(13)&Global.Microsoft.VisualBasic.ChrW(10)&Global.Microsoft.VisualBasic.ChrW(9)&Global.Microsoft.VisualBasic.ChrW(9)&Global.Microsoft.VisualBasic.ChrW(9)&"出錯行: ")
Line 1070:
Line 1071: #ExternalSource("C:\home\site\wwwroot\Inc\ChkFunction.asp",177)
Line 1072: __w.Write( Err.Line )
Line 1073:
Line 1074:
Line 1075: #End ExternalSource
Line 1076: __w.Write("<BR> "&Global.Microsoft.VisualBasic.ChrW(13)&Global.Microsoft.VisualBasic.ChrW(10)&Global.Microsoft.VisualBasic.ChrW(9)&Global.Microsoft.VisualBasic.ChrW(9)&Global.Microsoft.VisualBasic.ChrW(9))
Line 1077:
Line 1078: #ExternalSource("C:\home\site\wwwroot\Inc\ChkFunction.asp",178)
Line 1079:
Line 1080: Response.End
Line 1081: End If
Line 1082: On Error Goto 0
Line 1083:
Line 1084: Err.Clear
Line 1085: On Error Resume Next
Line 1086: ' 新增登入紀錄
Line 1087: 'sql = "Select * from WebLoginInfo Where uid='" & id & "'"
Line 1088: LoginRecordSQL = "WebLoginInfo"
Line 1089: Set LoginRecordRs = Server.CreateObject("Adodb.RecordSet")
Line 1090: LoginRecordRs.Open LoginRecordSQL,LoginRecordConn,3,3
Line 1091:
Line 1092: LoginRecordRs.AddNew
Line 1093: LoginRecordRs("UserID") = Session("UserID")
Line 1094: LoginRecordRs("UserName") = Session("UserName")
Line 1095: LoginRecordRs("UserLevel") = Session("UserLevel")
Line 1096: LoginRecordRs("UserGroup") = Session("UserGroup")
Line 1097: LoginRecordRs("UserLoginTime") = Session("UserLoginTime")
Line 1098: LoginRecordRs("UserAliveTime") = Session("UserLoginTime")
Line 1099: LoginRecordRs("UserIP") = GetUserIP()
Line 1100: LoginRecordRs.Update
Line 1101: 'LoginRecordRs.Close
Line 1102: 'LoginRecordConn.Close
Line 1103: 'Set LoginRecordRs = Nothing
Line 1104: 'Set LoginRecordConn = Nothing
Line 1105:
Line 1106: '錯誤處理
Line 1107: If Err.Number <> 0 And Err.Number <> -2147217887 Then
Line 1108: '清除頁面
Line 1109: Response.Clear
Line 1110:
Line 1111:
Line 1112: #End ExternalSource
Line 1113: __w.Write(""&Global.Microsoft.VisualBasic.ChrW(13)&Global.Microsoft.VisualBasic.ChrW(10)&Global.Microsoft.VisualBasic.ChrW(9)&Global.Microsoft.VisualBasic.ChrW(9)&Global.Microsoft.VisualBasic.ChrW(9)&"LoginRecord function 資料庫AddNew失敗<BR>"&Global.Microsoft.VisualBasic.ChrW(13)&Global.Microsoft.VisualBasic.ChrW(10)&Global.Microsoft.VisualBasic.ChrW(9)&Global.Microsoft.VisualBasic.ChrW(9)&Global.Microsoft.VisualBasic.ChrW(9)&"錯誤 Number: ")
Line 1114:
Line 1115: #ExternalSource("C:\home\site\wwwroot\Inc\ChkFunction.asp",211)
Line 1116: __w.Write( Err.Number )
Line 1117:
Line 1118:
Line 1119: #End ExternalSource
Line 1120: __w.Write("<BR> "&Global.Microsoft.VisualBasic.ChrW(13)&Global.Microsoft.VisualBasic.ChrW(10)&Global.Microsoft.VisualBasic.ChrW(9)&Global.Microsoft.VisualBasic.ChrW(9)&Global.Microsoft.VisualBasic.ChrW(9)&"錯誤信息: ")
Line 1121:
Line 1122: #ExternalSource("C:\home\site\wwwroot\Inc\ChkFunction.asp",212)
Line 1123: __w.Write( Err.Description )
Line 1124:
Line 1125:
Line 1126: #End ExternalSource
Line 1127: __w.Write("<BR> "&Global.Microsoft.VisualBasic.ChrW(13)&Global.Microsoft.VisualBasic.ChrW(10)&Global.Microsoft.VisualBasic.ChrW(9)&Global.Microsoft.VisualBasic.ChrW(9)&Global.Microsoft.VisualBasic.ChrW(9)&"出錯文件: ")
Line 1128:
Line 1129: #ExternalSource("C:\home\site\wwwroot\Inc\ChkFunction.asp",213)
Line 1130: __w.Write( Err.Source )
Line 1131:
Line 1132:
Line 1133: #End ExternalSource
Line 1134: __w.Write("<BR> "&Global.Microsoft.VisualBasic.ChrW(13)&Global.Microsoft.VisualBasic.ChrW(10)&Global.Microsoft.VisualBasic.ChrW(9)&Global.Microsoft.VisualBasic.ChrW(9)&Global.Microsoft.VisualBasic.ChrW(9)&"出錯行: ")
Line 1135:
Line 1136: #ExternalSource("C:\home\site\wwwroot\Inc\ChkFunction.asp",214)
Line 1137: __w.Write( Err.Line )
Line 1138:
Line 1139:
Line 1140: #End ExternalSource
Line 1141: __w.Write("<BR> "&Global.Microsoft.VisualBasic.ChrW(13)&Global.Microsoft.VisualBasic.ChrW(10)&Global.Microsoft.VisualBasic.ChrW(9)&Global.Microsoft.VisualBasic.ChrW(9)&Global.Microsoft.VisualBasic.ChrW(9))
Line 1142:
Line 1143: #ExternalSource("C:\home\site\wwwroot\Inc\ChkFunction.asp",215)
Line 1144:
Line 1145: Response.End
Line 1146: End If
Line 1147: On Error Goto 0
Line 1148: 'exit function
Line 1149: Else
Line 1150: ' 登出
Line 1151: Set LoginRecordConn = GetConnection("asirdb")
Line 1152: 'sql = "Select * from WebLoginInfo Where UserID='" & Session("UserID") & "'"
Line 1153: LoginRecordSQL = "Delete From WebLoginInfo Where UserID='" & Session("UserID") & "'"
Line 1154: 'Response.Write LoginRecordSQL
Line 1155: LoginRecordConn.execute(LoginRecordSQL)
Line 1156: 'Response.End
Line 1157: End If
Line 1158: End Function
Line 1159: ' WebActionLog 使用者動作紀錄
Line 1160: Function AddUserActionLog(doWhat,doResult)
Line 1161: 'exit function
Line 1162: If Session("UserID") <> "" Then
Line 1163: Set AddUserActionLogConn = GetConnection("asirdb")
Line 1164: AddUserActionLogSQL = "WebActionLog"
Line 1165: ' 新增紀錄
Line 1166: Set AddUserActionLogRs = Server.CreateObject("Adodb.RecordSet")
Line 1167: AddUserActionLogRs.Open AddUserActionLogSQL,AddUserActionLogConn,3,3
Line 1168: AddUserActionLogRs.AddNew
Line 1169: AddUserActionLogRs("UserID") = Session("UserID")
Line 1170: AddUserActionLogRs("UserName") = Session("UserName")
Line 1171: AddUserActionLogRs("UserLevel") = Session("UserLevel")
Line 1172: AddUserActionLogRs("UserGroup") = Session("UserGroup")
Line 1173: AddUserActionLogRs("UserLoginTime") = Now()
Line 1174: AddUserActionLogRs("UserAliveTime") = Now()
Line 1175: AddUserActionLogRs("UserIP") = GetUserIP()
Line 1176: AddUserActionLogRs("UserAction") = doWhat
Line 1177: AddUserActionLogRs("UserActionDetail") = doResult
Line 1178: AddUserActionLogRs.Update
Line 1179:
Line 1180: AddUserActionLogRs.Close
Line 1181: AddUserActionLogConn.Close
Line 1182: Set AddUserActionLogRs = Nothing
Line 1183: Set AddUserActionLogConn = Nothing
Line 1184: End If
Line 1185: End Function
Line 1186:
Line 1187: Function AddUserAction2Log(doWhat,doResult,doDetail)
Line 1188: exit function
Line 1189: If Session("UserID") <> "" Then
Line 1190: Set AddUserActionLogConn = GetConnection("asirdb")
Line 1191: AddUserActionLogSQL = "WebActionLog"
Line 1192: ' 新增紀錄
Line 1193: Set AddUserActionLogRs = Server.CreateObject("Adodb.RecordSet")
Line 1194: AddUserActionLogRs.Open AddUserActionLogSQL,AddUserActionLogConn,3,3
Line 1195: AddUserActionLogRs.AddNew
Line 1196: AddUserActionLogRs("UserID") = Session("UserID")
Line 1197: AddUserActionLogRs("UserName") = Session("UserName")
Line 1198: AddUserActionLogRs("UserLevel") = Session("UserLevel")
Line 1199: AddUserActionLogRs("UserGroup") = Session("UserGroup")
Line 1200: AddUserActionLogRs("UserLoginTime") = Now()
Line 1201: AddUserActionLogRs("UserAliveTime") = Now()
Line 1202: AddUserActionLogRs("UserIP") = GetUserIP()
Line 1203: AddUserActionLogRs("UserAction") = doWhat
Line 1204: AddUserActionLogRs("UserActionDetail") = doResult
Line 1205: AddUserActionLogRs("UserActionDetail2") = doDetail
Line 1206: AddUserActionLogRs.Update
Line 1207:
Line 1208: AddUserActionLogRs.Close
Line 1209: AddUserActionLogConn.Close
Line 1210: Set AddUserActionLogRs = Nothing
Line 1211: Set AddUserActionLogConn = Nothing
Line 1212: End If
Line 1213: End Function
Line 1214:
Line 1215:
Line 1216: #End ExternalSource
Line 1217:
Line 1218: #ExternalSource("C:\home\site\wwwroot\outpatient.aspx",7)
Line 1219:
Line 1220: ' 檢查是否登入
Line 1221: 'Call ChkLoginInfo()
Line 1222: 'On Error Resume Next
Line 1223:
Line 1224: '------------------------------------------------------------------------------------------------------------------------------------------------------
Line 1225: ' 定義是否除錯模式
Line 1226: '------------------------------------------------------------------------------------------------------------------------------------------------------
Line 1227: DebugMode = False
Line 1228:
Line 1229: JSONMode = SafeRequestCharMax("JSONMode",1)
Line 1230: If JSONMode = "0" Then
Line 1231: JSONMode = False
Line 1232: Else
Line 1233: JSONMode = True
Line 1234: End If
Line 1235: JSONMode = False
Line 1236:
Line 1237: '------------------------------------------------------------------------------------------------------------------------------------------------------
Line 1238: ' 有用到圖檔時,定義本頁路徑
Line 1239: '------------------------------------------------------------------------------------------------------------------------------------------------------
Line 1240: WebURL = "http://a-sir.ezcare.com.tw/"
Line 1241: FilePath = "./upload"
Line 1242: httpURL = WebURL & "upload/"
Line 1243:
Line 1244: '------------------------------------------------------------------------------------------------------------------------------------------------------
Line 1245: ' 接收資料
Line 1246: '------------------------------------------------------------------------------------------------------------------------------------------------------
Line 1247: aClassification = SafeRequestCharMax("acs",20)
Line 1248: aType = SafeRequestCharMax("ats",20)
Line 1249: If aClassification <> "" And AllowKeyword(aClassification) <> True Then
Line 1250: Response.Redirect "https://a-sir.ezcare.com.tw/artas.html"
Line 1251: End If
Line 1252: If aType <> "" And AllowKeyword(aType) <> True Then
Line 1253: Response.Redirect "https://a-sir.ezcare.com.tw/artas.html"
Line 1254: End If
Line 1255: If aClassification = "" Then
Line 1256: aClassification = "ARTAS系統植髮"
Line 1257: End If
Line 1258: If aType = "" Then
Line 1259: aType = "醫師專欄"
Line 1260: End If
Line 1261:
Line 1262: aTypeLink = "blog_index.asp?acs=" & aClassification & "&ats=" & aType & ""
Line 1263: page = Trim(Request("page"))
Line 1264: If isNumeric(page) = False Then
Line 1265: page = 1
Line 1266: End If
Line 1267: If Len(page) = 0 Or IsNull(page) Or IsEmpty(page) Then
Line 1268: page = 1
Line 1269: End If
Line 1270: If Is_Lng(page) = False Then
Line 1271: page = 1
Line 1272: End If
Line 1273:
Line 1274: Err.Clear
Line 1275: On Error Resume Next
Line 1276: page = CLng(page)
Line 1277: If Err Then
Line 1278: 'strBody = "" & VBCRLF
Line 1279: 'strBody = strBody & "Error at "&Time() &VBCRLF
Line 1280: 'strBody = strBody & "Err.Line: " & Err.Line &VBCRLF
Line 1281: 'strBody = strBody & "Err.Number: " & Err.Number &VBCRLF
Line 1282: 'strBody = strBody & "Err.Description: " & Err.Description &VBCRLF
Line 1283: 'strBody = strBody & "Err.Source: " & Err.Source &VBCRLF
Line 1284: 'Response.Write VBCRLF & "Err=" & strBody
Line 1285: 'Response.End
Line 1286: page = 1
Line 1287: Else
Line 1288: 'Response.Write "NO ERR" & VBCRLF
Line 1289: End If
Line 1290: On Error goto 0
Line 1291:
Line 1292:
Line 1293:
Line 1294: ' 排序欄位
Line 1295: sidx = "ShowDay"
Line 1296: sord = "desc"
Line 1297:
Line 1298: LimitRecordCounter = 1 ' Or 0
Line 1299: QueryDatabaseName = "Webcontent"
Line 1300:
Line 1301: OrderMethod = "Order by " & sidx & " " & sord
Line 1302: SqlSearchString = ""
Line 1303:
Line 1304: ' 申 請 日 期(自動帶入)
Line 1305: 'PROD_DATE = fdateXZ(Now())
Line 1306: PROD_DATE = fdateX(Now())
Line 1307: PROD_TIME = ftimeX(Now())
Line 1308:
Line 1309: '-------------------------------------------------------------------------------------------------------------------------
Line 1310: ' 檢查資料
Line 1311: '-------------------------------------------------------------------------------------------------------------------------
Line 1312: ShowMsg = ""
Line 1313: nline = "\n"
Line 1314:
Line 1315: '-------------------------------------------------------------------------------------------------------------------------
Line 1316: ' 輸出
Line 1317: '-------------------------------------------------------------------------------------------------------------------------
Line 1318:
Line 1319: ' 表示有資料可找
Line 1320: Set conn = GetConnection("asirdb")
Line 1321: ' 開RecordSet
Line 1322: Set rs = Server.CreateObject("Adodb.RecordSet")
Line 1323: ' 最新五篇(近期消息)
Line 1324: sql = "select top 10 * from " & QueryDatabaseName & " Where [DocType]='announce' And [DocShow] = 'T' Order By Pk desc"
Line 1325: rs.Open sql,conn,1,1
Line 1326: aTop5newslist = ""
Line 1327:
Line 1328: ' 加第一則固定 地址資訊
Line 1329: aTop5newslist = aTop5newslist & "<li><a href='/map.html'>"
Line 1330: aTop5newslist = aTop5newslist & "各院所資訊、地址查詢"
Line 1331: aTop5newslist = aTop5newslist & "</a></li>"
Line 1332: Do While rs.EOF <> True
Line 1333: 'aTop5newslist = aTop5newslist & "<li><a href='announce_inside.asp?id=" & Trim(rs("Pk")) & "'>"
Line 1334: aTop5newslist = aTop5newslist & "<li><a href='/announce/" & Trim(rs("Pk")) & ".html'>"
Line 1335: aTop5newslist = aTop5newslist & Trim(rs("DocTitle"))
Line 1336: aTop5newslist = aTop5newslist & "</a></li>"
Line 1337: rs.MoveNext
Line 1338: Loop
Line 1339: rs.Close
Line 1340:
Line 1341:
Line 1342: 'Response.Write "<br/>["
Line 1343: 'Response.Write aDocSummary
Line 1344: 'Response.Write "]<br/>"
Line 1345: 'Response.End
Line 1346:
Line 1347: ' 自動抓目前網址 for FB 之類的 meta
Line 1348: aCur_Url = GetUrl()
Line 1349: ' 介紹頁網址對應 及 列表頁面預設圖片
Line 1350: Domain_Name = "http://" & LCase(Request.ServerVariables("Server_Name")) & "/"
Line 1351: Domain_Name = "./"
Line 1352: aFBFanPage = ""
Line 1353: Select Case aClassification
Line 1354: Case "機器人植髮","ARTAS系統植髮"
Line 1355: aClassificationIntroUrl = Domain_Name & "artas.html"
Line 1356: ' 列表頁面預設圖片
Line 1357: aDocPicture = "https://a-sir.ezcare.com.tw/photo/look-up-63588988.jpg"
Line 1358: aFBFanPage = "<div class=""fb-page"" data-href=""https://www.facebook.com/HAIRMEDICINE"" data-width=""200"" data-height=""600"" data-small-header=""false"" data-adapt-container-width=""true"" data-hide-cover=""false"" data-show-facepile=""true"" data-show-posts=""true""><div class=""fb-xfbml-parse-ignore""><blockquote cite=""https://www.facebook.com/HAIRMEDICINE""><a href=""https://www.facebook.com/HAIRMEDICINE"">機器人植髮俱樂部</a></blockquote></div></div>"
Line 1359: Case "自體脂肪隆乳"
Line 1360: aClassificationIntroUrl = Domain_Name & "breast.html"
Line 1361: aDocPicture = "https://a-sir.ezcare.com.tw/photo/look-up-63588988.jpg"
Line 1362: Case "雷射溶脂"
Line 1363: aClassificationIntroUrl = Domain_Name & "smartlipo.html"
Line 1364: aDocPicture = "https://diet.a-sir.com.tw/wp-content/uploads/2013/09/1109867462b2f0f0470df8386036243c.jpg"
Line 1365: End Select
Line 1366:
Line 1367:
Line 1368: beLoadFile = "news_list.html"
Line 1369: ShowHTML = LoadFile(1,beLoadFile)
Line 1370:
Line 1371: ShowHTML = Replace(ShowHTML,"{aMode}",aMode)
Line 1372: ShowHTML = Replace(ShowHTML,"{aPK}",aPK)
Line 1373:
Line 1374: ShowHTML = Replace(ShowHTML,"{aClassification}",aClassification)
Line 1375: ShowHTML = Replace(ShowHTML,"{aClassificationIntroUrl}",aClassificationIntroUrl)
Line 1376: ShowHTML = Replace(ShowHTML,"{aType}",aType)
Line 1377: ShowHTML = Replace(ShowHTML,"{aTypeLink}",aTypeLink)
Line 1378: ShowHTML = Replace(ShowHTML,"{aShowDay}",aShowDay)
Line 1379: ShowHTML = Replace(ShowHTML,"{aShowTime}",aShowTime)
Line 1380: ShowHTML = Replace(ShowHTML,"{aShowTimeAllday}",aShowTimeAllday)
Line 1381: ShowHTML = Replace(ShowHTML,"{aShowDay2}",aShowDay2)
Line 1382: ShowHTML = Replace(ShowHTML,"{aShowTime2}",aShowTime2)
Line 1383:
Line 1384: ShowHTML = Replace(ShowHTML,"{aDocDate}",aDocDate)
Line 1385: ShowHTML = Replace(ShowHTML,"{aDocDateYear}",aDocDateYear)
Line 1386: 'ShowHTML = Replace(ShowHTML,"{aDocDateMonth}",aDocDateMonth)
Line 1387: ShowHTML = Replace(ShowHTML,"{aDocDateMonth}",aDocDateMonthEng)
Line 1388:
Line 1389: ShowHTML = Replace(ShowHTML,"{aDocDateDay}",aDocDateDay)
Line 1390: ShowHTML = Replace(ShowHTML,"{aDocAuthor}",aDocAuthor)
Line 1391: ShowHTML = Replace(ShowHTML,"{aDocTitle}",aDocTitle)
Line 1392: ShowHTML = Replace(ShowHTML,"{aDocSummary}",aDocSummary)
Line 1393: ShowHTML = Replace(ShowHTML,"{aDocContent}",aDocContent)
Line 1394:
Line 1395: ShowHTML = Replace(ShowHTML,"{aDocKeyword}",aDocKeyword)
Line 1396: ShowHTML = Replace(ShowHTML,"{aDocPicture}",aDocPicture)
Line 1397:
Line 1398: ' 近期消息
Line 1399: ShowHTML = Replace(ShowHTML,"{aTop5newslist}",aTop5newslist)
Line 1400:
Line 1401: ' 登入者
Line 1402: ShowHTML = Replace(ShowHTML,"{aPLoginID}",aPLoginID)
Line 1403: ' 等帳號整合後自動帶入
Line 1404: 'ShowHTML = Replace(ShowHTML,"{aPLoginID}",Session("PLoginID"))
Line 1405:
Line 1406: ShowHTML = Replace(ShowHTML,"{aDocTop}",aDocTop)
Line 1407: ShowHTML = Replace(ShowHTML,"{aDocShow}",aDocShow)
Line 1408: ShowHTML = Replace(ShowHTML,"{aCur_Url}",aCur_Url)
Line 1409: 'ShowHTML = Replace(ShowHTML,"{aFieldWorkerFlag}",chkReadOnly(aFieldWorker))
Line 1410: 'ShowHTML = Replace(ShowHTML,"{aE_C_MEMO}",aE_C_MEMO)
Line 1411:
Line 1412: ' 暫時情況
Line 1413: ShowHTML = Replace(ShowHTML,"index.html","artas.html")
Line 1414:
Line 1415: ' 單獨執行狀況
Line 1416: If Len(jscode) <> 0 Then
Line 1417: ShowHTML = Replace(ShowHTML,"<!--jscode-->",jscode)
Line 1418: ' 輔助js判斷是否單獨執行
Line 1419: ShowHTML = Replace(ShowHTML,"{aAlone}","1")
Line 1420: Else
Line 1421: ShowHTML = Replace(ShowHTML,"{aAlone}","0")
Line 1422: End If
Line 1423:
Line 1424: ' 粉絲團
Line 1425: ShowHTML = Replace(ShowHTML,"<!--aFBFanPage-->",aFBFanPage)
Line 1426:
Line 1427:
Line 1428: ' 特別處理Menu Div問題
Line 1429: 'SomeCode = "<!-- ======== Menu處理 By flash2u ======== -->" & "<script type=""text/javascript"">$(document).ready(function(){ $(""#mobilemenu"").show();$(""#main_menu"").show(); });</script>"
Line 1430: 'ShowHTML = Replace(ShowHTML,"<nav id=""main_menu"">","<nav id=""main_menu"" style=""display:none;""><!--main_menu-->")
Line 1431: 'ShowHTML = Replace(ShowHTML,"<nav id=""mobilemenu"">","<nav id=""mobilemenu"" style=""display:none;""><!--mobilemenu-->")
Line 1432: 'ShowHTML = Replace(ShowHTML,"</body>",SomeCode & "</body>")
Line 1433:
Line 1434: Response.Write ShowHTML
Line 1435: Response.End
Line 1436:
Line 1437: 'rs.Close
Line 1438:
Line 1439: Function MonthtoEng(MonthNum)
Line 1440: ' a135 pw=7962
Line 1441: MonthNum = CInt(MonthNum)
Line 1442: MyKeyWords = Ucase("Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec")
Line 1443: KeyWords = Split(MyKeyWords,",")
Line 1444: MonthtoEng = KeyWords(MonthNum-1)
Line 1445: End Function
Line 1446:
Line 1447: Function chkReadOnly(Str)
Line 1448: If Len(Str) <> 0 Then
Line 1449: chkReadOnly = "readonly"
Line 1450: Else
Line 1451: chkReadOnly = ""
Line 1452: End If
Line 1453: End Function
Line 1454:
Line 1455: Function AlertShow(showmsg)
Line 1456: Response.Write "<script language='javascript'>"
Line 1457: Response.Write "var msg='" & showmsg & "';"
Line 1458: Response.Write "alert(msg);window.history.go(-1);</script>"
Line 1459: 'Response.Write "result=false&msg=" & ShowMsg
Line 1460: 'Response.Redirect "/yadmin.asp?yContent=carno_search2"
Line 1461: 'Response.Write "<script>location.href = '/yadmin.asp?yContent=carno_search2';</script>"
Line 1462: Response.End
Line 1463: End Function
Line 1464:
Line 1465: '檢測字元串是否是整數
Line 1466: function Is_Int(a_str)
Line 1467: if not isnumeric(a_str) or len(str) > 5 then
Line 1468: Is_Int = false
Line 1469: exit function
Line 1470: elseif len(str) < 5 then
Line 1471: Is_Int = true
Line 1472: exit function
Line 1473: end if
Line 1474: if cint(left(a_str , 4)) > 3276 then
Line 1475: Is_Int = false
Line 1476: exit function
Line 1477: elseif cint(left(a_str , 4)) = 3276 and cint(right(a_str , 1)) > 7 then
Line 1478: Is_Int = false
Line 1479: exit function
Line 1480: else
Line 1481: Is_Int = true
Line 1482: exit function
Line 1483: end if
Line 1484: end function
Line 1485:
Line 1486: '檢測是否是長整數
Line 1487: function Is_Lng(a_str)
Line 1488: if not isnumeric(a_str) or len(str) > 10 then
Line 1489: Is_Lng = false
Line 1490: exit function
Line 1491: elseif len(str) < 10 then
Line 1492: Is_Lng = true
Line 1493: exit function
Line 1494: end if
Line 1495: if clng(left(a_str , 9)) > 214748367 then
Line 1496: Is_Lng = false
Line 1497: exit function
Line 1498: elseif clng(left(a_str , 9)) = 214748367 and clng(right(a_str , 1)) > 7 then
Line 1499: Is_Lng = false
Line 1500: exit function
Line 1501: else
Line 1502: Is_Lng = true
Line 1503: exit function
Line 1504: end if
Line 1505: end function
Line 1506:
Line 1507:
Line 1508: #End ExternalSource
Line 1509: End Sub
Line 1510:
Line 1511: <System.Diagnostics.DebuggerNonUserCodeAttribute()> _
Line 1512: Protected Overrides Sub FrameworkInitialize()
Line 1513: MyBase.FrameworkInitialize
Line 1514: Me.__BuildControlTree(Me)
Line 1515: Me.AddWrappedFileDependencies(Global.ASP.outpatient_aspx.__fileDependencies)
Line 1516: Me.Request.ValidateInput
Line 1517: End Sub
Line 1518:
Line 1519: <System.Diagnostics.DebuggerNonUserCodeAttribute()> _
Line 1520: Public Overrides Function GetTypeHashCode() As Integer
Line 1521: Return 492426376
Line 1522: End Function
Line 1523:
Line 1524: <System.Diagnostics.DebuggerNonUserCodeAttribute()> _
Line 1525: Public Overrides Sub ProcessRequest(ByVal context As System.Web.HttpContext)
Line 1526: MyBase.ProcessRequest(context)
Line 1527: End Sub
Line 1528: End Class
Line 1529: End Namespace
Line 1530:
|