⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 un_main.dfm

📁 局域网的一个聊天程序
💻 DFM
📖 第 1 页 / 共 3 页
字号:
🔍
123 
  end
  object idhtp: TIdHTTPServer
    Active = True
    Bindings = <
      item
        IP = '0.0.0.0'
        Port = 3000
      end>
    CommandHandlers = <>
    DefaultPort = 3000
    Greeting.NumericCode = 0
    ListenQueue = 20
    MaxConnectionReply.NumericCode = 0
    ReplyExceptionCode = 0
    ReplyTexts = <>
    ReplyUnknownCommand.NumericCode = 0
    TerminateWaitTime = 60000
    ThreadMgr = IdThreadMgrDefault1
    OnCommandGet = idhtpCommandGet
    Left = 40
    Top = 72
  end
  object pp_chat_main: TPageProducer
    HTMLDoc.Strings = (
      '<html>'
      ''
      '<head>'
      '<title></title>'
      '</head>'
      ''
      
        '<frameset rows="*,0" framespacing="0" border="0" frameborder="0"' +
        '>'
      '  <frame name="frame_msg" scrolling="yes" noresize >'
      
        '  <frame name="frame_script" scrolling="no"  src="http://127.0.0' +
        '.1:3000/chat_script">'
      '  <noframes>'
      '  <body>'
      '  </body>'
      '  </noframes>'
      '</frameset>'
      '</html>')
    Left = 72
    Top = 8
  end
  object pp_chat_script: TPageProducer
    HTMLDoc.Strings = (
      '<html>'
      '<body>'
      '<script language="vbscript">'
      ''
      'function htmlencode(str)'
      '    dim htmlresult'
      '    dim l'
      '    if isNULL(str) then '
      '       htmlencode=""'
      '       exit function'
      '    end if'
      '    l=len(str)'
      '    htmlresult=""'
      #9'dim i'
      #9'for i = 1 to l'
      #9'    select case mid(str,i,1)'
      #9'           case "<"'
      #9'                htmlresult=htmlresult+"&lt;"'
      #9'           case ">"'
      #9'                htmlresult=htmlresult+"&gt;"'
      '              case chr(13)'
      #9'                htmlresult=htmlresult+"<br>"'
      #9'           case chr(34)'
      #9'                htmlresult=htmlresult+"&quot;"'
      #9'           case "&"'
      #9'                htmlresult=htmlresult+"&amp;"'
      '              case chr(32)'#9'           '
      #9'                '#39'htmlresult=htmlresult+"&nbsp;"'
      #9'                if i+1<=l and i-1>0 then'
      
        #9'                   if mid(str,i+1,1)=chr(32) or mid(str,i+1,1)=' +
        'chr(9) or mid(str,i-1,1)=chr(32) or mid(str,i-1,1)=chr(9)  then'#9 +
        '                      '
      #9'                      htmlresult=htmlresult+"&nbsp;"'
      #9'                   else'
      #9'                      htmlresult=htmlresult+" "'
      #9'                   end if'
      #9'                else'
      
        #9'                   htmlresult=htmlresult+"&nbsp;"'#9'             ' +
        '       '
      #9'                end if'
      #9'           case chr(9)'
      #9'                htmlresult=htmlresult+"    "'
      #9'           case else'
      #9'                htmlresult=htmlresult+mid(str,i,1)'
      '         end select'
      '       next '
      '       htmlencode=htmlresult'
      '   end function'
      ''
      ''
      'function sustainhtml(str)'
      '    dim htmlresult'
      '    dim l'
      '    if isNULL(str) then '
      '       sustainhtml=""'
      '       exit function'
      '    end if'
      '    l=len(str)'
      '    htmlresult=""'
      #9'dim i'
      #9'for i = 1 to l'
      #9'    select case mid(str,i,1)'
      #9'           case chr(13)'
      #9'                htmlresult=htmlresult+"<br>"'
      #9'           case chr(34)'
      #9'                htmlresult=htmlresult+"&quot;"'
      '                   case chr(32)'#9'           '
      #9'                '#39'htmlresult=htmlresult+"&nbsp;"'
      #9'                if i+1<=l and i-1>0 then'
      
        #9'                   if mid(str,i+1,1)=chr(32) or mid(str,i+1,1)=' +
        'chr(9) or mid(str,i-1,1)=chr(32) or mid(str,i-1,1)=chr(9)  then'#9 +
        '                      '
      #9'                      htmlresult=htmlresult+"&nbsp;"'
      #9'                   else'
      #9'                      htmlresult=htmlresult+" "'
      #9'                   end if'
      #9'                else'
      
        #9'                   htmlresult=htmlresult+"&nbsp;"'#9'             ' +
        '       '
      #9'                end if'
      #9'           case "&"'
      #9'                htmlresult=htmlresult+"&amp;"'
      #9'           case chr(9)'
      #9'                htmlresult=htmlresult+"    "'
      #9'           case else'
      #9'                htmlresult=htmlresult+mid(str,i,1)'
      '         end select'
      '       next '
      '       sustainhtml=htmlresult'
      '   end function'
      ''
      ' '#39' '#26816#26597'sql'#23383#31526#20018#20013#26159#21542#26377#21333#24341#21495#65292#26377#21017#36827#34892#36716#21270
      '   function CheckStr(str)'
      '       dim tstr,l,i,ch'
      #9'   l=len(str)'
      #9'   for i=1 to l'
      #9'       ch=mid(str,i,1)'
      #9'       if ch="'#39'" then'
      #9#9'      tstr=tstr+"'#39'"'
      #9#9'   end if'
      #9#9'   tstr=tstr+ch'
      #9'   next'
      #9'   CheckStr=tstr'
      '   end function'
      ''
      #39'email'#26377#25928#24615#26816#26597
      'function IsValidEmail(email)'
      ''
      'dim names, name, i, c'
      ''
      #39'Check for valid syntax in an email address.'
      ''
      'IsValidEmail = true'
      'names = Split(email, "@")'
      'if UBound(names) <> 1 then'
      '   IsValidEmail = false'
      '   exit function'
      'end if'
      'for each name in names'
      '   if Len(name) <= 0 then'
      '     IsValidEmail = false'
      '     exit function'
      '   end if'
      '   for i = 1 to Len(name)'
      '     c = Lcase(Mid(name, i, 1))'
      
        '     if InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 and not I' +
        'sNumeric(c) then'
      '       IsValidEmail = false'
      '       exit function'
      '     end if'
      '   next'
      '   if Left(name, 1) = "." or Right(name, 1) = "." then'
      '      IsValidEmail = false'
      '      exit function'
      '   end if'
      'next'
      'if InStr(names(1), ".") <= 0 then'
      '   IsValidEmail = false'
      '   exit function'
      'end if'
      'i = Len(names(1)) - InStrRev(names(1), ".")'
      'if i <> 2 and i <> 3 then'
      '   IsValidEmail = false'
      '   exit function'
      'end if'
      'if InStr(email, "..") > 0 then'
      '   IsValidEmail = false'
      'end if'
      ''
      'end function'
      ''
      #39#23558#19968#25991#23383#20013#30340'HTML'#30340#26631#35782#21435#25481
      'Function FilterHTML(strToFilter)'
      'Dim strTemp'
      'strTemp = strToFilter'
      'While Instr(1,strTemp,"<") AND Instr(1, strTemp, ">")'
      
        'strTemp = Left(strTemp, Instr(1, strTemp, "<")-1) & Right(strTem' +
        'p, Len(strTemp)-Instr(1,strTemp, ">"))'
      'WEnd'
      'FilterHTML = strTemp'
      'End Function'
      ''
      ''
      ''
      ''
      ''
      #39#36716#25442'UBB'#20195#30721
      'function ubb(strContent)'
      'strContent = htmlencode(strContent)'
      'dim re,ii,po'
      'dim reContent'
      'Set re=new RegExp'
      #39#23450#20041#27491#21017#34920#36798#24335
      're.IgnoreCase =true'
      're.Global=True'
      ''
      're.Pattern="(javascript)"'
      'strContent=re.Replace(strContent,"<I>&#106avascript</I>")'
      're.Pattern="(jscript:)"'
      'strContent=re.Replace(strContent,"<I>&#106script:</I>")'
      're.Pattern="(js:)"'
      'strContent=re.Replace(strContent,"<I>&#106s:</I>")'
      're.Pattern="(value)"'
      'strContent=re.Replace(strContent,"<I>&#118alue</I>")'
      're.Pattern="(about:)"'
      'strContent=re.Replace(strContent,"<I>about&#58</I>")'
      're.Pattern="(file:)"'
      'strContent=re.Replace(strContent,"<I>file&#58</I>")'
      're.Pattern="(document.cookie)"'
      'strContent=re.Replace(strContent,"<I>documents&#46cookie</I>")'
      're.Pattern="(vbscript:)"'
      'strContent=re.Replace(strContent,"<I>&#118bscript:</I>")'
      're.Pattern="(vbs:)"'
      'strContent=re.Replace(strContent,"<I>&#118bs:</I>")'
      're.Pattern="(on(mouse|exit|error|click|key))"'
      'strContent=re.Replace(strContent,"<I>&#111n$2</I>")'
      #39#22270#29255
      're.Pattern="\[IMG\](.[^\[]*)\[\/IMG\]"'
      'strContent=re.Replace(strContent,"<IMG SRC=""$1"" border=0>")'
      're.Pattern="\[IMG=*([0-9]*),*([0-9]*)\](.[^\[]*)\[\/IMG\]"'
      
        'strContent=re.Replace(strContent,"<IMG SRC=""$3"" border=0 heigh' +
        't=""$1"" width=""$2"">")'
      #39'flash'#25773#25918
      're.Pattern="(\[FLASH\])(.[^\[]*)(\[\/FLASH\])"'
      
        'strContent= re.Replace(strContent,"<a href=""$2"" TARGET=_blank>' +
        '['#20840#23631#27427#36175']</a><br><OBJECT codeBase=./download/swflash.cab#version=6,' +
        '0,29,0 classid=clsid:D27CDB6E-AE6D-11cf-96B8-444553540000 width=' +
        '500 height=400><PARAM NAME=movie VALUE=""$2""><PARAM NAME=qualit' +
        'y VALUE=high><embed src=""$2"" quality=high pluginspage='#39'http://' +
        'www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=' +
        'ShockwaveFlash'#39' type='#39'application/x-shockwave-flash'#39' width=500 h' +
        'eight=400>$2</embed></OBJECT><br>")'
      
        're.Pattern="(\[FLASH=*([0-9]*),*([0-9]*)\])(.[^\[]*)(\[\/FLASH\]' +
        ')"'
      
        'strContent= re.Replace(strContent,"<a href=""$4"" TARGET=_blank>' +
        '['#20840#23631#27427#36175']</a><br><OBJECT codeBase=./download/swflash.cab#version=6,' +
        '0,29,0 classid=clsid:D27CDB6E-AE6D-11cf-96B8-444553540000 width=' +
        '$2 height=$3><PARAM NAME=movie VALUE=""$4""><PARAM NAME=quality ' +
        'VALUE=high><embed src=""$4"" quality=high pluginspage='#39'http://ww' +
        'w.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=Sh' +
        'ockwaveFlash'#39' type='#39'application/x-shockwave-flash'#39' width=$2 heig' +
        'ht=$3>$4</embed></OBJECT><br>")'
      ''
      #39#22810#23186#20307#26631#31614
      're.Pattern="\[DIR=*([0-9]*),*([0-9]*)\](.[^\[]*)\[\/DIR]"'
      
        'strContent=re.Replace(strContent,"<object classid=clsid:166B1BCA' +
        '-3F9C-11CF-8075-444553540000 codebase=http://download.macromedia' +
        '.com/pub/shockwave/cabs/director/sw.cab#version=7,0,2,0 width=$1' +
        ' height=$2><param name=src value=$3><embed src=$3 pluginspage=ht' +
        'tp://www.macromedia.com/shockwave/download/ width=$1 height=$2><' +
        '/embed></object>")'
      're.Pattern="\[QT=*([0-9]*),*([0-9]*)\](.[^\[]*)\[\/QT]"'
      
        'strContent=re.Replace(strContent,"<embed src=$3 width=$1 height=' +
        '$2 autoplay=true loop=false controller=true playeveryframe=false' +
        ' cache=false scale=TOFIT bgcolor=#000000 kioskmode=false targetc' +
        'ache=false pluginspage=http://www.apple.com/quicktime/>")'
      're.Pattern="\[MP=*([0-9]*),*([0-9]*)\](.[^\[]*)\[\/MP]"'
      
        'strContent=re.Replace(strContent,"<object align=middle classid=C' +
        'LSID:22d6f312-b0f6-11d0-94ab-0080c74c7e95 class=OBJECT id=MediaP' +
        'layer width=$1 height=$2 ><param name=ShowStatusBar value=-1><pa' +
        'ram name=Filename value=$3><embed type=application/x-oleobject c' +
        'odebase=http://activex.microsoft.com/activex/controls/mplayer/en' +
        '/nsmp2inf.cab#Version=5,1,52,701 flename=mp src=$3 width=$1 heig' +
        'ht=$2></embed></object>")'
123

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -