Bing arama Tcl scripti 1.0 (yeni)
PHP- Kodu:
# ----------------------------------
# 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(MAXRRESULTS) 3
set bing(deny_CHANS) {
#kanal
}
# --------------------
# Konfügürasyon bitti
# --------------------
# ------------------
# Kodu Kurcalamayın!
# -------------------
set bing(VERSION) 1.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- Kodu:
# 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.
php buffer end -->
--IRCForumlari.NET ; Flood Engellendi -->-> Yeni yazılan mesaj 04:38 -->-> Daha önceki mesaj 04:38 --
tcl ye ek olarak ; PHP- Kodu:
# 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.
php buffer end -->
|
