IRCForumları - IRC ve mIRC Kullanıcılarının Buluşma Noktası
  odeaweb

>
+
Etiketlenen Kullanıcılar

1Beğeni(ler)
  • 1 Post By IUC

 
 
LinkBack Seçenekler Stil
Prev önceki Mesaj   sonraki Mesaj Next
Alt 01 Aralık 2025, 04:38   #1
Çevrimdışı
Kullanıcıların profil bilgileri misafirlere kapatılmıştır.
IF Ticaret Sayısı: (0)
IF Ticaret Yüzdesi:(%)
Bing arama Tcl scripti 1.0 (yeni)




PHP Kod:   Kodu kopyalamak için üzerine çift tıklayın!
# ----------------------------------
# Bing.com Arama Motoru Tcl scripti
# IUC Aralık 2025 V1.0.1 Basit vers.
#
# irc[MENTION=131135]Ufukc[/MENTION]ingay.net
# Arama sonuçları kanala basılır.
# scriptin çalışması için hhtp.tcl 
# eklemeniz gerekir!!!
# ----------------------------------

# ------------
# KONFİGÜRASYON
# ------------
bind pub - !bing pub_bing
# Daha kötü oyun oynamak için  :)
# bind pub - !arabing pub_bing
# bind pub - !bulbing pub_bing
# bind pub - !google pub_bing

set bing(MAXRRESULTS3
set bing
(deny_CHANS) {
    
#kanal
    
}
# --------------------
# Konfügürasyon bitti
# --------------------

# ------------------
# Kodu Kurcalamayın!
# -------------------
set bing(VERSION1.0
package 
require http

proc html_replace 
{quotes} {
    global 
bing
    regsub 
-all {‘|‘} $quotes "\`" quotes
    
regsub -all {’|’} $quotes "\'" quotes
    # remove bing's <strong></strong> in description
    
regsub -all -nocase -- {<strong>|</strong>} $quotes "" quotes
    
foreach index [lsort -decreasing [regexp -all -indices -inline {&#[0-9]+;} $quotes]] {
        
set binary_value [string range $quotes [lindex $index 0] [lindex $index 1]]
        
regexp {[0-9]+} $binary_value match
        set quotes 
[string replace $quotes [lindex $index 0] [lindex $index 1] [format %c $match]]
    }
    return 
$quotes
}

proc pub_bing {nick userhost handle channel rest} {
    global 
bing
    
if {[lsearch [string tolower $bing(deny_CHANS)] [string tolower $channel]] != "-1"} {
        return 
0
    
}
    if {
$rest==""} {
        
putserv "PRIVMSG $channel :Syntax: !bing <aranacak deyimler>"
        
return 0
    
}
    
search_bing $channel $bing(MAXRRESULTS$rest
}

proc search_bing {channel results search} {
    global 
bing
    regsub 
-all " " $search "+" search
    set url http
://
Bu forumdaki linkleri ve resimleri görebilmek için en az 25 mesajınız olması gerekir.
style="color: #0000BB">http
::config -useragent "Mozilla/5.0"
    
set conn [http::geturl $url -headers "Referer 
Bu forumdaki linkleri ve resimleri görebilmek için en az 25 mesajınız olması gerekir.
style="color: #007700">]
    
set data [http::data $conn]
    
set count 0
    regsub 
-all {<b>|</b>} $data \002 data
    
foreach {match parens1 parens2} [regexp -all -inline -- {<div class="sb_tlst">.*?<h3>.*?<a href="(.*?)" .*?>(.*?)</a>.*?</h3>} $data] {
        set parens2 [html_replace $parens2]
        if {$count==$bing(MAXRRESULTS)} { break }
        incr count 1
        if {$bing(MAXRRESULTS)>1} {
            putserv "PRIVMSG $channel :Result($count): \002$parens1\002 ($parens2)"
        } else { 
            putserv "PRIVMSG $channel :Result: \002$parens1\002 ($parens)"
            break 
        }
    }
    if {$count!=$bing(MAXRRESULTS)} {
        putserv "PRIVMSG $channel : \002$Sayılıyor\002 Sonuç bulundu..!"
    }
}

putlog "Bing script $bing(VERSION) - IUC Aralık 2025" 



--IRCForumlari.NET ; Flood Engellendi -->-> Yeni yazılan mesaj 04:38 -->-> Daha önceki mesaj 04:21 --

tcl ye ek olarak ;

PHP Kod:   Kodu kopyalamak için üzerine çift tıklayın!
# http.tcl --
#
# Client-side HTTP for GET, POST, and HEAD commands.
# These routines can be used in untrusted code that uses
# the Safesock security policy.  These procedures use a
# callback interface to avoid using vwait, which is not
# defined in the safe base.
#
# See the file "license.terms" for information on usage and
# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: http.tcl,v 2.5.001 2004/09/08 13:36:10 perpleXa Exp $

# Rough version history:
# 1.0   Old http_get interface
# 2.0   http:: namespace and http::geturl
# 2.1   Added callbacks to handle arriving data, and timeouts
# 2.2   Added ability to fetch into a channel
# 2.3   Added SSL support, and ability to post from a channel
#       This version also cleans up error cases and eliminates the
#       "ioerror" status in favor of raising an error
# 2.4   Added -binary option to http::geturl and charset element
#       to the state array.
# 2.5   Added useridentification support and http::base64 (by perpleXa)

package require Tcl 8.2
# keep this in sync with pkgIndex.tcl
# and with the install directories in Makefiles
package provide http 2.5.001

namespace eval http {
  
variable http
  
array set http {
    -
accept       */*
    -proxyhost    {}
    -proxyport    {}
    -proxyfilter  http::ProxyRequired
  }
  set http(-useragent) {Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.7) Gecko/20040803 Firefox/0.9.3}
  proc init {} {
    variable formMap
    variable alphanumeric a-zA-Z0-9
    for {set i 0} {$i <= 256} {incr i} {
      set c [format %c $i]
      if {![string match \[$alphanumeric\] $c]} {
        set formMap($c) %[format %.2x $i]
      }
    }
    # These are handled specially
    array set formMap { " " + \n %0d%0a }
  }
  init

  variable urlTypes
  array set urlTypes {
    http          {80 ::socket}
  }

  variable encodings [string tolower [encoding names]]
  # This can be changed, but iso8859-1 is the RFC standard.
  variable defaultCharset "iso8859-1"

  namespace export geturl config reset wait formatQuery register unregister
  # Useful, but not exported: data size status code
}

# http::register --
#
#     See documentaion for details.
#
# Arguments:
#     proto           URL protocol prefix, e.g. https
#     port            Default port for protocol
#     command         Command to use to create socket
# Results:
#     list of port and command that was registered.

proc http::register {proto port command} {
  variable urlTypes
  set urlTypes($proto)[list $port $command]
}

# http::unregister --
#
#     Unregisters URL protocol handler
#
# Arguments:
#     proto           URL protocol prefix, e.g. https
# Results:
#     list of port and command that was unregistered.

proc http::unregister {proto} {
  variable urlTypes
  if {![info exists urlTypes($proto)]} {
    return -code error "unsupported url type \"$proto\""
  }
  set old $urlTypes($proto)
  unset urlTypes($proto)
  return $old
}

# http::config --
#
#      See documentaion for details.
#
# Arguments:
#      args            Options parsed by the procedure.
# Results:
#      TODO

proc http::config {args} {
  variable http
  set options [lsort [array names http -*]]
  set usage [join $options ", "]
  if {[llength $args] == 0} {
    set result {}
    foreach name $options {
      lappend result $name $http($name)
    }
    return $result
  }
  set options [string map {- ""} $options]
  set pat ^-([join $options |])$
  if {[llength $args] == 1} {
    set flag [lindex $args 0]
    if {[regexp -- $pat $flag]} {
      return $http($flag)
    } else {
      return -code error "Unknown option $flag, must be: $usage"
    }
  } else {
    foreach {flag value} $args {
      if {[regexp -- $pat $flag]} {
        set http($flag) $value
      } else {
        return -code error "Unknown option $flag, must be: $usage"
      }
    }
  }
}

# http::Finish --
#
#      Clean up the socket and eval close time callbacks
#
# Arguments:
#      token        Connection token.
#      errormsg     (optional) If set, forces status to error.
#      skipCB       (optional) If set, don't call the -command callback.  This
#                   is useful when geturl wants to throw an exception instead
#                   of calling the callback.  That way, the same error isn't
#                   reported to two places.
#
# Side Effects:
#      Closes the socket

proc http::Finish { token {errormsg ""} {skipCB 0}} {
  variable $token
  upvar 0 $token state
  global errorInfo errorCode
  if {[string length $errormsg] != 0} {
    set state(error)[list $errormsg $errorInfo $errorCode]
    set state(status) error
  }
  catch {close $state(sock)}
  catch {after cancel $state(after)}
  if {[info exists state(-command)] && !$skipCB} {
    if {[catch {eval $state(-command) {$token}} err]} {
      if {[string length $errormsg] == 0} {
        set state(error)[list $err $errorInfo $errorCode]
        set state(status) error
      }
    }
    if {[info exists state(-command)]} {
      # Command callback may already have unset our state
      unset state(-command)
    }
  }
}

# http::reset --
#
#      See documentaion for details.
#
# Arguments:
#      token      Connection token.
#      why      Status info.
#
# Side Effects:
#       See Finish

proc http::reset { token {why reset} } {
  variable $token
  upvar 0 $token state
  set state(status) $why
  catch {fileevent $state(sock) readable {}}
  catch {fileevent $state(sock) writable {}}
  Finish $token
  if {[info exists state(error)]} {
    set errorlist $state(error)
    unset state
    eval ::error $errorlist
  }
}

# http::base64
#
#      Converts a base10 string to a base64 string
#
# Arguments:
#      string      The base10 string to convert
# Results:
#      Returns a base64 encoded string,
#      this string is needed for http user-identification.
#

proc http::base64 {arguments} {
  set base64_en "A B C D E F G H I J K L M N O P Q R S T U V W X Y Z a b c d e f g h i j k l m n o p q r s t u v w x y z 0 1 2 3 4 5 6 7 8 9 + /"
  set wrapchar "\n"
  set maxlen 60
  set result {}
  set state 0
  set length 0
  if {[llength $arguments] == 0} {
   error "wrong # args: should be \"[lindex [info level 0] 0] string\""
  }
  binary scan $arguments c* X
  foreach {x y z} $X {
    if {$maxlen && $length >= $maxlen} {
      append result $wrapchar
      set length 0
    }
    append result [lindex $base64_en [expr {($x >> 2) & 0x3F}]]
    if {$y != {}} {
      append result [lindex $base64_en [expr {(($x << 4) & 0x30) | (($y >> 4) & 0xF)}]]
      if {$z != {}} {
        append result [lindex $base64_en [expr {(($y << 2) & 0x3C) | (($z >> 6) & 0x3)}]]
        append result [lindex $base64_en [expr {($z & 0x3F)}]]
      } else {
        set state 2
        break
      }
    } else {
      set state 1
      break
    }
    incr length 4
  }
  if {$state == 1} {
    append result [lindex $base64_en [expr {(($x << 4) & 0x30)}]]==
  } elseif {$state == 2} {
    append result [lindex $base64_en [expr {(($y << 2) & 0x3C)}]]=
  }
  return $result
}

# http::geturl --
#
#      Establishes a connection to a remote url via http.
#
# Arguments:
#      url    The http URL to goget.
#      args   Option value pairs. Valid options include:
#                -blocksize, -validate, -headers, -timeout
# Results:
#      Returns a token for this connection.
#      This token is the name of an array that the caller should
#      unset to garbage collect the state.

proc http::geturl { url args } {
  variable http
  variable urlTypes
  variable defaultCharset

  # Initialize the state variable, an array.  We'll return the
  # name of this array as the token for the transaction.

  if {![info exists http(uid)]} {
    set http(uid) 0
  }
  set token [namespace current]::[incr http(uid)]
  variable $token
  upvar 0 $token state
  reset $token

  # Process command options.

  array set state {
    -binary          false
    -blocksize       8192
    -queryblocksize  8192
    -validate        0
    -headers         {}
    -timeout         0
    -type            application/x-
Bu forumdaki linkleri ve resimleri görebilmek için en az 25 mesajınız olması gerekir.
type="text/javascript" src="https://code.jquery.com/jquery-1.12.0.min.js">

--IRCForumlari.NET ; Flood Engellendi -->-> Yeni yazılan mesaj 04:38 -->-> Daha önceki mesaj 04:38 --

tcl ye ek olarak ;

PHP Kod:   Kodu kopyalamak için üzerine çift tıklayın!
# http.tcl --
#
# Client-side HTTP for GET, POST, and HEAD commands.
# These routines can be used in untrusted code that uses
# the Safesock security policy.  These procedures use a
# callback interface to avoid using vwait, which is not
# defined in the safe base.
#
# See the file "license.terms" for information on usage and
# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: http.tcl,v 2.5.001 2004/09/08 13:36:10 perpleXa Exp $

# Rough version history:
# 1.0   Old http_get interface
# 2.0   http:: namespace and http::geturl
# 2.1   Added callbacks to handle arriving data, and timeouts
# 2.2   Added ability to fetch into a channel
# 2.3   Added SSL support, and ability to post from a channel
#       This version also cleans up error cases and eliminates the
#       "ioerror" status in favor of raising an error
# 2.4   Added -binary option to http::geturl and charset element
#       to the state array.
# 2.5   Added useridentification support and http::base64 (by perpleXa)

package require Tcl 8.2
# keep this in sync with pkgIndex.tcl
# and with the install directories in Makefiles
package provide http 2.5.001

namespace eval http {
  
variable http
  
array set http {
    -
accept       */*
    -proxyhost    {}
    -proxyport    {}
    -proxyfilter  http::ProxyRequired
  }
  set http(-useragent) {Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.7) Gecko/20040803 Firefox/0.9.3}
  proc init {} {
    variable formMap
    variable alphanumeric a-zA-Z0-9
    for {set i 0} {$i <= 256} {incr i} {
      set c [format %c $i]
      if {![string match \[$alphanumeric\] $c]} {
        set formMap($c) %[format %.2x $i]
      }
    }
    # These are handled specially
    array set formMap { " " + \n %0d%0a }
  }
  init

  variable urlTypes
  array set urlTypes {
    http          {80 ::socket}
  }

  variable encodings [string tolower [encoding names]]
  # This can be changed, but iso8859-1 is the RFC standard.
  variable defaultCharset "iso8859-1"

  namespace export geturl config reset wait formatQuery register unregister
  # Useful, but not exported: data size status code
}

# http::register --
#
#     See documentaion for details.
#
# Arguments:
#     proto           URL protocol prefix, e.g. https
#     port            Default port for protocol
#     command         Command to use to create socket
# Results:
#     list of port and command that was registered.

proc http::register {proto port command} {
  variable urlTypes
  set urlTypes($proto)[list $port $command]
}

# http::unregister --
#
#     Unregisters URL protocol handler
#
# Arguments:
#     proto           URL protocol prefix, e.g. https
# Results:
#     list of port and command that was unregistered.

proc http::unregister {proto} {
  variable urlTypes
  if {![info exists urlTypes($proto)]} {
    return -code error "unsupported url type \"$proto\""
  }
  set old $urlTypes($proto)
  unset urlTypes($proto)
  return $old
}

# http::config --
#
#      See documentaion for details.
#
# Arguments:
#      args            Options parsed by the procedure.
# Results:
#      TODO

proc http::config {args} {
  variable http
  set options [lsort [array names http -*]]
  set usage [join $options ", "]
  if {[llength $args] == 0} {
    set result {}
    foreach name $options {
      lappend result $name $http($name)
    }
    return $result
  }
  set options [string map {- ""} $options]
  set pat ^-([join $options |])$
  if {[llength $args] == 1} {
    set flag [lindex $args 0]
    if {[regexp -- $pat $flag]} {
      return $http($flag)
    } else {
      return -code error "Unknown option $flag, must be: $usage"
    }
  } else {
    foreach {flag value} $args {
      if {[regexp -- $pat $flag]} {
        set http($flag) $value
      } else {
        return -code error "Unknown option $flag, must be: $usage"
      }
    }
  }
}

# http::Finish --
#
#      Clean up the socket and eval close time callbacks
#
# Arguments:
#      token        Connection token.
#      errormsg     (optional) If set, forces status to error.
#      skipCB       (optional) If set, don't call the -command callback.  This
#                   is useful when geturl wants to throw an exception instead
#                   of calling the callback.  That way, the same error isn't
#                   reported to two places.
#
# Side Effects:
#      Closes the socket

proc http::Finish { token {errormsg ""} {skipCB 0}} {
  variable $token
  upvar 0 $token state
  global errorInfo errorCode
  if {[string length $errormsg] != 0} {
    set state(error)[list $errormsg $errorInfo $errorCode]
    set state(status) error
  }
  catch {close $state(sock)}
  catch {after cancel $state(after)}
  if {[info exists state(-command)] && !$skipCB} {
    if {[catch {eval $state(-command) {$token}} err]} {
      if {[string length $errormsg] == 0} {
        set state(error)[list $err $errorInfo $errorCode]
        set state(status) error
      }
    }
    if {[info exists state(-command)]} {
      # Command callback may already have unset our state
      unset state(-command)
    }
  }
}

# http::reset --
#
#      See documentaion for details.
#
# Arguments:
#      token      Connection token.
#      why      Status info.
#
# Side Effects:
#       See Finish

proc http::reset { token {why reset} } {
  variable $token
  upvar 0 $token state
  set state(status) $why
  catch {fileevent $state(sock) readable {}}
  catch {fileevent $state(sock) writable {}}
  Finish $token
  if {[info exists state(error)]} {
    set errorlist $state(error)
    unset state
    eval ::error $errorlist
  }
}

# http::base64
#
#      Converts a base10 string to a base64 string
#
# Arguments:
#      string      The base10 string to convert
# Results:
#      Returns a base64 encoded string,
#      this string is needed for http user-identification.
#

proc http::base64 {arguments} {
  set base64_en "A B C D E F G H I J K L M N O P Q R S T U V W X Y Z a b c d e f g h i j k l m n o p q r s t u v w x y z 0 1 2 3 4 5 6 7 8 9 + /"
  set wrapchar "\n"
  set maxlen 60
  set result {}
  set state 0
  set length 0
  if {[llength $arguments] == 0} {
   error "wrong # args: should be \"[lindex [info level 0] 0] string\""
  }
  binary scan $arguments c* X
  foreach {x y z} $X {
    if {$maxlen && $length >= $maxlen} {
      append result $wrapchar
      set length 0
    }
    append result [lindex $base64_en [expr {($x >> 2) & 0x3F}]]
    if {$y != {}} {
      append result [lindex $base64_en [expr {(($x << 4) & 0x30) | (($y >> 4) & 0xF)}]]
      if {$z != {}} {
        append result [lindex $base64_en [expr {(($y << 2) & 0x3C) | (($z >> 6) & 0x3)}]]
        append result [lindex $base64_en [expr {($z & 0x3F)}]]
      } else {
        set state 2
        break
      }
    } else {
      set state 1
      break
    }
    incr length 4
  }
  if {$state == 1} {
    append result [lindex $base64_en [expr {(($x << 4) & 0x30)}]]==
  } elseif {$state == 2} {
    append result [lindex $base64_en [expr {(($y << 2) & 0x3C)}]]=
  }
  return $result
}

# http::geturl --
#
#      Establishes a connection to a remote url via http.
#
# Arguments:
#      url    The http URL to goget.
#      args   Option value pairs. Valid options include:
#                -blocksize, -validate, -headers, -timeout
# Results:
#      Returns a token for this connection.
#      This token is the name of an array that the caller should
#      unset to garbage collect the state.

proc http::geturl { url args } {
  variable http
  variable urlTypes
  variable defaultCharset

  # Initialize the state variable, an array.  We'll return the
  # name of this array as the token for the transaction.

  if {![info exists http(uid)]} {
    set http(uid) 0
  }
  set token [namespace current]::[incr http(uid)]
  variable $token
  upvar 0 $token state
  reset $token

  # Process command options.

  array set state {
    -binary          false
    -blocksize       8192
    -queryblocksize  8192
    -validate        0
    -headers         {}
    -timeout         0
    -type            application/x-
Bu forumdaki linkleri ve resimleri görebilmek için en az 25 mesajınız olması gerekir.
type="text/javascript" src="https://code.jquery.com/jquery-1.12.0.min.js">

__________________
Bir çok yeni lamer sunucuda IUC nicki kullanıyor lamerlar onlar ben değilim inanmayınız ve güvenmeyiniz.
Kullanıcı imzalarındaki bağlantı ve resimleri görebilmek için en az 20 mesaja sahip olmanız gerekir ya da üye girişi yapmanız gerekir.
 
Alıntı ile Cevapla

 


Konuyu Toplam 1 Üye okuyor. (0 Kayıtlı üye ve 1 Misafir)
 

Yetkileriniz
Konu Acma Yetkiniz Yok
Cevap Yazma Yetkiniz Yok
Eklenti Yükleme Yetkiniz Yok
Mesajınızı Değiştirme Yetkiniz Yok

BB code is Açık
Smileler Açık
[IMG] Kodları Açık
HTML-Kodu Kapalı
Trackbacks are Kapalı
Pingbacks are Açık
Refbacks are Açık


Benzer Konular
Konu Konuyu Başlatan Forum Cevaplar Son Mesaj
Microsoft, arama motoru Bing'in fişini mi çekiyor? CLasS Bing 0 28 Şubat 2018 21:08
Bing’den Konuma ve Arama Geçmişine Göre Arama Pentagram Bing 0 26 Kasım 2015 17:15
Bing Arama Motorunun Öneri Sistemi Yenilendi hayLaz Bing 0 18 Temmuz 2013 17:44
Bing'in Görsel Arama Seçenekleri Arttı hayLaz Bing 0 08 Temmuz 2013 05:29
Bing'de Arama Yap Hediyeleri Kap! Broast Bing 1 14 Aralık 2010 10:45

×