Category » Programare « @ HWK

PHP XML Blogroll sursa: blogspot.com – Suport cache si MYSQL

Posted on October 18th, 2009 admin No comments

Am scris acest articol si functie cu scopul de a o implementa intr-un site pentru a afisa ultimele posturi de pe un blog gazduit pe blogspot.com (gen: http://carbonenergy.blogspot.com), cu alte cuvinte: Blogroll

Este facut in PHP cu suport MYSQL pentru a stoca cache-ul si foloseste simpleXML pentru luare datelor de pe blog.

Este setat sa actualizeze informatiile la 24 de ore, dar acest interval se poate modifica, regland intervalul de secunde. Prescurteaza textul din titlu si din continut la un numar setat de caractere (acestea pot fi setat in script).

Folosit scriptul returneaza un array cu informatile despre posturi: date (datetime), link, titlu si continut.

Singura sa problema e ca nu curata posturile vechi din baza de date. Poate implementez in urmatoarea versiune.

Exemplu: http://www.carbonenergy.ro/ : vezi partea de stanga a siteului (Blogroll)

Version 0.2

Modificari:

adaugate optiuni de listare (numarul de articole de afisat, pozitia de unde sa afiseaza); vezi variabilele functiei: $num = 3, $start = 0
scoasa optiunea de formatare a datei din functie
modificata structura de stocare a link-urilor (mysql + php)
optimizari a structurii bazei de date
optimzarea procedurii de stocare a informatiilor (reducerea numarului de query-uri)
adaugat tabel de configuratii
continutul stocat are in componenta tag-urile html: <p>, <img> si <br> pentru a nu se pierde formatarea
au fost reparate cateva bug-uri

Cerinte:

PHP5 sau mai nou
MySQL 5.0.3 sau mai nou

Cod configuratie:

$query = mysql_query('SELECT `name`, `value` FROM `cms_config`');
while ($row = mysql_fetch_assoc($query)){
$config[$row['name']] = $row['value'];
}

Functia PHP:

function get_broll ($num = 3, $start = 0) {
global $config;

//$cleanup = do_db_cleanup();

$query = mysql_query("SELECT `id`, `date`, `title`, `path`, `link`, `content` FROM `cms_broll` ORDER by `date` DESC LIMIT ".$start.", ".$num) or print(mysql_error());

$brollq = array();

	$i = 0;
	while ($row = mysql_fetch_assoc($query)) {
		$brollq[$i] = $row;
		$i++;
	}

$update['last'] = strtotime($config['last_broll_update']);

if (!(mysql_num_rows($query) > 0) || ((time() - $update['last']) > $config['broll_update_interval'])) {

	$xml=@simplexml_load_file('http://carbonenergy.blogspot.com/feeds/posts/default');
	if(!$xml){return false;}

	// the update loop, getting all articles and updating db is necessary
	for ($i= 0; isset($xml->entry[$i]->title); $i++) {

		preg_match('/^(.*\/)(.*)$/i', $xml->entry[$i]->link[4]->attributes()->href, $matches);

		$broll[$i]['path'] = $matches[1];
		$broll[$i]['link'] = $matches[2];
		$broll[$i]['date'] = str_replace('T', ' ', substr($xml->entry[$i]->published, 0, 19));
		$broll[$i]['title'] = $xml->entry[$i]->title;
		$broll[$i]['content'] = strip_tags(htmlspecialchars_decode($xml->entry[$i]->content), '


');

		if (!(mysql_num_rows($query) > 0) || (strtotime($brollq[0]['date']) < strtotime($broll[$i]['date']))) {

			if (isset($brollq[$i]['link']) && ($brollq[$i]['link'] == $broll[$i]['link'])) { continue; }

			$up = mysql_query("INSERT IGNORE
						INTO `cms_broll` (`date`, `title`, `path`, `link`, `content`)
						VALUES (
							'".$broll[$i]['date']."',
							'".$broll[$i]['title']."',
							'".$broll[$i]['path']."',
							'".$broll[$i]['link']."',
							'".mysql_real_escape_string($broll[$i]['content'])."')") or print(mysql_error());
		}
	}

	// updating config last blog roll update date
	$upbconf = mysql_query("UPDATE `cms_config` SET `value`='".date_time_format()."' WHERE `name`='last_broll_update'");

} else { return $brollq; }

return array_slice($broll, $start, $num);

}

Structura bazei de date:

-- phpMyAdmin SQL Dump

SET SQL_MODE="NO_AUTO_VALUE_ON_ZERO";

-- --------------------------------------------------------

--
-- Table structure for table `cms_config`
--

CREATE TABLE IF NOT EXISTS `cms_config` (
  `id` tinyint(4) NOT NULL auto_increment,
  `name` varchar(100) NOT NULL,
  `value` varchar(255) NOT NULL,
  `descriere` text NOT NULL,
  `extra` text NOT NULL,
  PRIMARY KEY  (`id`,`name`)
) ENGINE=MyISAM  DEFAULT CHARSET=utf8 AUTO_INCREMENT=6 ;

--
-- Dumping data for table `cms_config`
--

INSERT INTO `cms_config` (`id`, `name`, `value`, `descriere`, `extra`) VALUES
(3, 'last_broll_update', '2010-11-28 16:22:56', 'Ultimul update al blog-ului', '0'),
(4, 'broll_update_interval', '7200', 'Intervalul in care se vor face actualizari la catergoria blog roll direct de pe blog.\r\n\r\nValoare in secunde:\r\nEX: 7200 = 2 ore', '');

--
-- Table structure for table `cms_broll`
--

CREATE TABLE IF NOT EXISTS `cms_broll` (
  `id` int(11) NOT NULL auto_increment,
  `date` datetime NOT NULL,
  `title` text NOT NULL,
  `path` text NOT NULL,
  `link` varchar(500) NOT NULL,
  `content` text NOT NULL,
  UNIQUE KEY `link` (`link`),
  KEY `id` (`id`)
) ENGINE=MyISAM  DEFAULT CHARSET=latin1 AUTO_INCREMENT=2511 ;

--
-- Dumping data for table `cms_broll`
--

INSERT INTO `cms_broll` (`id`, `date`, `title`, `path`, `link`, `content`) VALUES
(2509, '2010-10-27 00:01:00', 'Industria europeana finanteaza senatorii climato-sceptici din SUA', 'http://carbonenergy.blogspot.com/2010/10/', 'industria-europeana-finanteaza.html', 'Nume grele ale industriei europene, precum companiile germane Bayer si BASF sau cele franceze Lafarge si GDF-Suez, au sustinut financiar campaniile electorale ale mai multor senatori americani care neaga efectele negative ale schimbarilor climatice, dezvaluie un raport al retelei de ONG-uri Climate Action Network Europe, citat de "Le Monde".

Documentul arata ca, in 2010, ”cei mai mari poluatori europeni” au varsat peste 306.000 de dolari in conturile alesilor climato-sceptici care se opun vehement adoptarii pachetului legislativ de lupta impotriva schimbarilor climatice.

Studiul se bazeaza pe cifrele publicate luna aceasta de comisia electorala federala americana, cu ocazia alegerilor pentru Senat de pe 2 noiembrie. Acestea detaliaza sumele primite de fiecare senator si numele donatorilor, conform politicilor americane de transparenta privind finantarea campaniilor electorale.

”Un grup format din cei mai mari producatori europeni de dioxid de carbon finanteaza campaniile politice ale unora din cei mai ferventi opozanti ai legislatiei impotriva schimbarilor climatice care se negociaza in Senatul american”, afirma autorii raportului. Ei subliniaza faptul ca aceleasi companii europene fac lobby impotriva reducerii drastice a emisiilor de gaze cu efect de sera in Europa aducand ca argument tocmai faptul ca nu trebuie facut nimic pana cand Statele Unite nu actioneaza ferm in acest sens.

Raportul mai arata ca producatorul francez de ciment Lafarge, responsabil de 15 milioane de tone de emisii in 2009, a varsat 34.500 de dolari, iar GDF-Suez – 21.000 de dolari, catre alesii americani care se opun crearii unei piete a carbonului in SUA. Cel mai generos donator, arata raportul, a fost grupul farmaceutic german Bayer, cu 108.000 de dolari, urmat de compania BASF, cu 61.500 de dolari.');

Version 0.1

Functia PHP:

function get_broll ($num = 3) {

$query = mysql_query(“SELECT `id`, `date`, `title`, `link`, `content`, `tstamp` FROM `cms_broll` ORDER by `date` DESC LIMIT 0, 3″);

$i = 0;
while ($row = mysql_fetch_assoc($query)) {
$brollq[$i] = $row;
$brollq[$i]['date'] = substr($brollq[$i]['date'], 0, 10);
$i++;
}

$tstamp = time();

if ((mysql_num_rows($query) == 0) || !isset($brollq[0]['tstamp']) || (($tstamp – $brollq[0]['tstamp']) > 86400)) {

$xml=@simplexml_load_file(‘http://carbonenergy.blogspot.com/feeds/posts/default’);

if(!$xml){return 0;}

for ($i = 0; $i < $num ; $i++) {

$broll[$i]['link'] = $xml->entry[$i]->link[4]->attributes()->href;
$broll[$i]['date'] = str_replace(‘T’, ‘ ‘, substr($xml->entry[$i]->published, 0, 19));
$broll[$i]['title'] = substr($xml->entry[$i]->title, 0, 33);
if (strlen($xml->entry[$i]->title) > 33) {$broll[$i]['title'] .= ‘…’; }
$broll[$i]['content'] = substr($xml->entry[$i]->content, 0, 137);
if (strlen($xml->entry[$i]->content) > 132) {$broll[$i]['content'] .= ‘…’; }

if ((mysql_num_rows($query) == 0) || ($brollq[$i]['link'] != $broll[$i]['link']) ) {
$up = mysql_query(“INSERT INTO `cms_broll` (`date`, `title`, `link`, `content`, `tstamp`) VALUES(‘”.$broll[$i]['date'].”‘,’”.$broll[$i]['title'].”‘,’”.$broll[$i]['link'].”‘,’”.$broll[$i]['content'].”‘,’”.$tstamp.”‘)”);
}
$broll[$i]['date'] = substr($xml->entry[$i]->published, 0, 10);

}

} else {
return $brollq;}

return $broll;

}

Structura tabel de date MYSQL:
CREATE TABLE IF NOT EXISTS `cms_broll` (
`id` int(11) NOT NULL auto_increment,
`date` datetime NOT NULL,
`title` text NOT NULL,
`link` text NOT NULL,
`content` text NOT NULL,
`tstamp` int(11) NOT NULL,
UNIQUE KEY `id_2` (`id`),
UNIQUE KEY `id_3` (`id`),
KEY `id` (`id`)
) ENGINE=MyISAM DEFAULT CHARSET=latin1 AUTO_INCREMENT=34 ;

–
– Dumping data for table `cms_broll`
–

INSERT INTO `cms_broll` (`id`, `date`, `title`, `link`, `content`, `tstamp`) VALUES
(33, ’2009-10-16 02:34:00′, ‘Doua miliarde euro din emisiile d…’, ‘http://carbonenergy.blogspot.com/2009/10/doua-miliarde-euro-din-emisiile-de-co2.html’, ‘Ca sa mai faca rost de niste bani la buget pe timp de criza, Guvernul spera sa obtina doua miliarde euro din vanzarea surplusului de drep…’, 1255794474),
(32, ’2009-10-16 02:36:00′, ‘Primul proiect de captare a CO2 i…’, ‘http://carbonenergy.blogspot.com/2009/10/primul-proiect-de-captare-co2-in.html’, ‘Producatorul de gaze Romgaz, transportatorul national de gaze Transgaz si producatorul de energie electrica Complexul Energetic Craiova v…’, 1255794474),
(31, ’2009-10-16 02:38:00′, ‘EU: Romania, Bulgaria must cut na…’, ‘http://carbonenergy.blogspot.com/2009/10/eu-romania-bulgaria-must-cut-national.html’, ‘London. The European Commission Friday ruled that Romania and Bulgaria must both reduce their carbon dioxide national allocation plans fo…’, 1255794474);

Astept comentarii si sugestii.

Internet, Programare blog, Blogroll, blogspot, Internet, mysql, online, php, Programare, script, XML

PHP si MYSQL Curs valutar automat EUR/USD – Sursa BNR

Posted on September 22nd, 2009 admin 3 comments

Am scris acest articol deoarece cred ca ar putea fi folositor. “Scriptul” consta intro functie si un tabel care este foarte simplu: ia cursul de schimb de pe http://www.bnr.ro/nbrfxrates.xml numai pentru moneda EURO si USD si le stocheaza intro baza de date.

De ce?

Informaţiile preluate trebuie stocate la nivelul aplicaţiei de preluare pentru a evita generarea de trafic redundant. IP-urile care generează un volum de trafic disproporţionat de mare vor fi restricţionate administrativ. Pentru restabilirea accesului puteţi semnala remedierea situaţiei pe adresa de webmaster.
- evitarea traficului inutil
- timpi de incarcare si raspuns a paginilor mai bun
- mai gasiti si voi.
Uitati si functia:

function get_rate() {

$rate['curdate'] = date(“Y-m-d”);

$query = mysql_query(“SELECT `eur`, `usd` FROM `cms_rate` WHERE `data`=’”.$rate['curdate'].”‘”);

if (mysql_num_rows($query) == 0) {
$xml=@file_get_contents(‘http://www.bnr.ro/nbrfxrates.xml’, FILE_BINARY);

if(!$xml){return 0;}
preg_match(‘/”EUR”>(.*)<\/Rate>/’, $xml, $eur);
preg_match(‘/”USD”>(.*)<\/Rate>/’, $xml, $usd);

$rate['eur'] = $eur[1];
$rate['usd'] = $usd[1];

$up = mysql_query(“INSERT INTO `cms_rate` (`data`, `eur`, `usd`) VALUES(‘”.$rate['curdate'].”‘,’”.$rate['eur'].”‘,’”.$rate['usd'].”‘)”);

return $rate;

} else {

$res = mysql_fetch_assoc($query);
$rate['usd'] = $res['usd'];
$rate['eur'] = $res['eur'];
return $rate;
}

Structura tabelului de date:

SET SQL_MODE=”NO_AUTO_VALUE_ON_ZERO”;

– ——————————————————–

–
– Table structure for table `cms_rate`
–

CREATE TABLE IF NOT EXISTS `cms_rate` (
`id` int(11) NOT NULL auto_increment,
`data` date NOT NULL,
`eur` double NOT NULL,
`usd` double NOT NULL,
PRIMARY KEY (`id`)
) ENGINE=MyISAM DEFAULT CHARSET=latin1 AUTO_INCREMENT=11 ;

–
– Dumping data for table `cms_rate`
–

INSERT INTO `cms_rate` (`id`, `data`, `eur`, `usd`) VALUES
(10, ’2009-09-22′, 4.2665, 2.9123);

Connexiunea la baza de date o las in seama voastra.

Success!

Programare bnr, curs valutare, euro, Internet, mysql, php, Programare, script, usd

Public IP Info v 0.4 – script TCL pentru eggdrop

Posted on March 31st, 2009 admin 10 comments

Acest script il puteti folosi pentru eggdrop pentru a va afisa, pe canalul IRC unde a fost declansata comanda, informatii despre un anumit IP.

Foloseste ca sursa de informatii www.ip2location.com, iar informatiile solicitate le stocheaza intro “baza de date” proprie pentru a reduce solicitarea serverului unde este gazduit botul.

De mentionat este faptul ca informatiile stocate sunt retinute pentru a o anumita perioada de timp (se poate seta in configuratia scriptului). In acest fel datale nu se vor invechi.

Scriptul in actiune:

[13:27] <hwk> !ipinfo 92.81.168.244
[13:27] <Myth`> hwk IP information for 92.81.168.244: Country: ROMANIA, City: BACAU, ISP: ROMTELECOM DATA NETWORK, Domain: PLATINUM-IFN.RO

Versiunea 0.1 a acestui script se poate descarca de pe www.egghelp.org, sectiunea TCL Archive, sub numele: Public IP information checker.

Download latest version

Version 0.4 (21.11.2011):

##########################################################################
#         Public IP Info v0.4 by Hawkee - lowraider1@gmail.com
#-----------------------------------------------------------------------
# This script uses www.ip2location.com to check info for an ip adresses
# It works with and without an ip2location.com account
#
# See the ip2location setting bellow
#
# Changes from version 0.3:
#		-rewriten the code using namespaces
#             -added future support for maxmind.com (will be released in new version)
#		-added suport for trigger command customization (ipinfo_config(command))
#		-added suport for customizing the output message
#
#
# Works on all channels, and it can be used by all users. Requires TCL
# HTTP PACK
#
# USAGE: !ipinfo <ip address>
#
# Email me with suggestions and bug reports at lowraider1@gmail.com
#
#					grtz HWK @ undernet
#########################################################################

set ipinfo_config(provider) 		"ip2location"; 		;# LEAVE AS IT IS!!! Which ip info provider to use. Values: ip2location, maxmind
set ipinfo_config(ip2location_email) 	"your@mail.com"	;# ip2location account email address - leave empty for no account
set ipinfo_config(ip2location_password) 	"yourpass"			;# ip2location account password

set ipinfo_config(command)			"!ipinfo"			;# the command for calling the lookup
set ipinfo_config(cachefile) 		"ipinfo.cache"		;# the cache file
set ipinfo_config(cacherefresh) 		"7"				;# the time (in days) to refresh the info for an IP

set ipinfo_config(message) 			"IP information for \00302%ip%\003: \002Country:\002 \00304%country%\003, \002City:\002 \00304%city%\003, \002ISP\002: \00302%isp%\003, \002Domain:\002 \00302%domain%\003"

# You can use the following strings to build your output message
####
# %ip% - the looked up ip
# %country% - country name
# %city% - city name
# %isp% - the isp name
# %domain% - domain holder

### dont bother editing
### will work in a future version
set ipinfo_config(maxmind_email) "my@mail.com"		;# maxmind account email address - leave empty for no account
set ipinfo_config(maxmind_password) "mypassword"		;# maxmind account password

package require http
namespace eval ipinfo {

	variable config
	array set config [array get ::ipinfo_config]

	variable ip 0
	variable results [list]
	variable cache
	variable uselogin 1 ;#variable to stop hammered invalid logins

	variable version "0.4"

	::http::config -useragent "Mozilla/5.0 ; Gecko"

	namespace eval maxmind {
        ## to be continued 
        proc lookup {} {}
 	 proc fetch_info {ip} { }
	 proc login {} {}
	}

	namespace eval ip2location {
	 variable parent [namespace parent]
	 variable cookies [list]

        proc lookup {} {
		variable parent
		set data [fetch_info [set ${parent}::ip]]

		set rows [regexp -all -line -inline -- {<td>(.*)</td>} $data]
		lappend ${parent}::results [unixtime]

		if {[llength $rows] > 2}  {
			set f 0
			foreach {match content} $rows {
				if {[expr { $f%2 }]} { lappend ${parent}::results [${parent}::strip-html $content]; }
				incr f
    			}

			set ${parent}::cache([set ${parent}::config(provider)],[set ${parent}::ip]) [set ${parent}::results];
		} else {
			${parent}::scream "FAILED - Invalid page response (maybe you ran out of credits)"

		}
	 }

	 proc fetch_info {ip} {

		variable parent
		variable cookies

		set headers [${parent}::make_headers $cookies]
   		set request [::http::geturl "http://www.ip2location.com/$ip" -timeout 3000 -headers $headers]
		set data [::http::data $request]
		::http::cleanup $request

		return $data
	 }

	 proc login {} {

		variable parent
		variable cookies

		set query [::http::formatQuery emailAddress [set ${parent}::config(ip2location_email)] password [set ${parent}::config(ip2location_password)] rememberMe on]
		set submit [::http::geturl "http://ip2location.com/login" -timeout 3000 -query $query]

		if {[regexp {<div class="error">(Invalid(.*))</div>} [::http::data $submit]]} {

			${parent}::scream "LOGIN FAILED - Invalid account credentials (email or password)"
			return 0;
		}

		upvar \#0 $submit state

		set cookies [${parent}::get_cookies $state(meta)]

		::http::cleanup $submit
		${parent}::scream "LOGGED IN"

		return 1;

	 }
	}

	proc cache_lookup {ip} {
		variable cache
		variable config
		variable results

		if {[info exists cache($config(provider),$ip)]} {
			if {[expr {(60*60*24)*$config(cacherefresh)}] < [expr {[unixtime] - [lindex $cache($config(provider),$ip) 0]}]} {
				scream "refreshing cache data for $ip"
				return 0;
			} else { set results $cache($config(provider),$ip); scream "info for $ip found in cache"}
		} else {return 0;}

		return 1;
	}

	proc cache_load {} {
		variable cache
		variable config

		if {[file exists $config(cachefile)]} {
			if {![catch {source $config(cachefile)} cacheerror]} {
				scream "cache file successfully loaded"
			} else {
				scream "cache file failed to load -: $cacheerror"
				scream "trying to fix cache file: reset" ;
				cache_save
			}
		} else {

			cache_save
			scream "cache file written - first time use"
		}

	}

	proc cache_save {} {
		variable config
		variable cache

		set write [open $config(cachefile) w]
		puts $write	[list array set cache [array get cache]]
		close $write

	}

	# creates a list of cookies from metadata
	proc get_cookies {headers} {

		set c [list]
 		foreach {name value} $headers {
			if {$name eq "Set-Cookie"} {lappend c [lindex [split $value {;}] 0];}
 		}

		return $c
	}

	# creates the cookie headers for http requests
	#
	proc make_headers {clist} {

		return [list Cookie [join $clist {; }]]
	}

	proc make_msg {} {
		variable ip
		variable results
		variable config

		set location [split [lindex $results 1] ,]
		set country [string trim [lindex $location 0]]
		set city [string trim [join [lrange $location 1 end] ","]]

		set output [string map [list %ip% $ip %country% $country %city% $city %isp% [lindex $results 3] %domain% [lindex $results 5]] $config(message)]

		return $output;

	}

	proc init {} {

		variable ip
		variable config
		variable uselogin
		variable results

		set results [list]

		if {![login_status] && ([string length $config($config(provider)_email)] > 1) && $uselogin} {
			set uselogin [${config(provider)}::login]
		}
		if {![cache_lookup $ip]} {
			${config(provider)}::lookup;
			cache_save;
		}

	}

	proc get_results {} {

		variable results
		return [array get results]

	}

	# return the login status of the current provider
	# returns: 	0 - not logged in
	#		1 - logged in
	proc login_status {} {
		variable config

		if {[llength [set ${config(provider)}::cookies]] < 2}  { return 0; }
		return 1;
	}

	proc public_call {nick uhost hand chan args} {
		variable ip
		variable config
		variable results

		set input [string trimright [lindex $args 0] "."]

		if {![regexp {^(?:(?:[01]?\d?\d|2[0-4]\d|25[0-5])(\.|$)){4}$} $input]} {
			puthelp "privmsg $chan :$nick NO/Invalid IP pattern. USAGE: $config(command) 193.193.193.193"
			scream "$chan $nick - INVALID IP"
			return 1;
		}

		set ip $input
		init

		if {![llength $results]} {
			puthelp "privmsg $chan :$nick No information found for IP: \00302$ip\003 please redefine your IP"
			scream "$chan $nick - No results - SOMETHING MAY WENT WRONG"
			return 1
		}

		puthelp "privmsg $chan :$nick [make_msg]"
		scream "request: $nick on $chan"
	}

	# http://wiki.tcl.tk/6779
	proc strip-html-ignore {text {ignore {}}} {
          set c 0
          foreach i $ignore {if {[regexp $i $text]} {return $text}}
          return ""
	}

	proc strip-html {html {ignore {}}} {
          regsub -all -- {<[^>]*>} $html "\[strip-html-ignore \[list &\] [list $ignore]\]" html
          set html [subst $html]
          return $html
	}

	proc scream {msg} {putlog "IP INFO: $msg"}

	# init loads and binds
	cache_load
	bind pub -|- $config(command) ::ipinfo::public_call
}

putlog "Public IP Info $::ipinfo::version by HAWKEE Successfuly loaded"

Version 0.3:

##########################################################################
#         Public IP Info v0.3 by Hawkee - lowraider1@gmail.com           #
#----------------------------------------------------------------------- #
# This script uses www.ip2location.com to check info for an ip adresses  #
#  It with both with and without ip2location account	                 #
#
# Using it without a ip2location.com account limits the script
# functionality to 50 lookup's per day.
#
# If don't have a ip2location.com account your can register one for free #
# and get 200 look-up per day.
# 								 	 	   #
# See the ip2location setting bellow 	                               #
#									          #
# Changes from version 0.2:					                 #
#		-fixed some bugs                                           #
#             -code optimizations 					          #
#		-updated the recognition format
#		-more error information
#		-implemented ip2location.com account                       #
#									          #
#								                 #
# Works on all channels, and it can be used by all users. Requires TCL   #
# HTTP PACK								          #
#								                 #
# USAGE: !ipinfo 							   #
# 					HAVE PHUN			          #
# Email me with suggestions and bug reports at lowraider1@gmail.com 	   #
#									          #
#					grtz HWK @ undernet	                 #
#########################################################################

set ipinfo(useaccount) 		1			;#set this to 1 if you have a ip2location.com account and you want to use it
set ipinfo(i2lmail)		"my@email.com"	;#set the login e-mail address from ip2location.com
set ipinfo(i2lpass)		"mypassword"		;#set the account password from ip2location.com

set ipinfo(cachefile) 		"ipinfo.cache"		;#the cache file
set ipinfo(cacherefresh) 	"7"			;#the time (in days) to refresh the info for an IP

set ver "0.3"

#### END OF SETTINGs
#### edit with caution from here on

catch {array unset ipinfocache}
unset -nocomplain COOKIES
unset -nocomplain ::ipinfo(loginfailure)

package require http

set ipinfo(islogged) 0

proc ipinfo:parser {nick uhost hand chan args} {

	set ip [string trimright [lindex $args 0] "."]

	if {![regexp {^(?:(?:[01]?\d?\d|2[0-4]\d|25[0-5])(\.|$)){4}$} $ip]} {
		puthelp "privmsg $chan :$nick NO/Invalid IP pattern. USAGE: !ipinfo 193.193.193.193"
		putlog "IP INFO $chan $nick - INVALID IP PATTERN"
		return

	}

	set infoip [ipinfo:output $ip]

	if {[string equal [lindex $infoip 0] -]} {

		puthelp "privmsg $chan :$nick No information found for IP: \00302$ip\003 please redefine your IP"
		putlog "IP INFO $chan $nick - No results - SOMETHING MAY WENT WRONG"
		return
	}

	set country [lindex $infoip 0]
	set city [lindex $infoip 1]
	set isp [lindex $infoip 2]
	set domain [lindex $infoip 3]

	puthelp "privmsg $chan :$nick IP information for \00302$ip\003: \002Country:\002 \00304$country\003, \002City:\002 \00304$city\003, \002ISP\002: \00302$isp\003, \002Domain:\002 \00302$domain\003"
	putlog "IPinfo request:  $nick on $chan"

}

proc ipinfo:dologin {} {

	## getting login token
	set login [::http::geturl "http://www.ip2location.com/login.aspx" -timeout 3000]
	set logindata [::http::data $login]

	::http::cleanup $login

	## making sure we got the login method right
	if {[regexp {
} $logindata -> logtok]} {

		set logque [::http::formatQuery __VIEWSTATE $logtok btnLogin.x 35 btnLogin.y 17 txtEmailAddress $::ipinfo(i2lmail) txtPassword $::ipinfo(i2lpass) chkRememberMe on]
		set dologin [::http::geturl "http://www.ip2location.com/login.aspx" -timeout 3000 -query $logque]

		if {[regexp {(Invalid(.*))} [::http::data $dologin]]} {
                        ::http::cleanup $dologin
			putlog "IP INFO: FAILED - INVALID ACCOUNT DETAILS (mail or password)"
			return 0;
		}

		upvar \#0 $dologin state
		set cookies [list]

 		foreach {name value} $state(meta) {
    			if {$name eq "Set-Cookie"} {lappend cookies [lindex [split $value {;}] 0];}
 		}

		::http::cleanup $dologin
		putlog "IP INFO: LOGGED IN"
		return $cookies
	} 

	putlog "IP INFO: FAILED - THE AUTH MECHANISM NOT compatible -- please e-mail: lowraider1@gmail.com with this issue"
	return 0;
}

proc ipinfo:cookies {cookielist} {

	return [list Cookie [join $cookielist {; }]]

}

proc ipinfo:getinfo {host} {
global ipinfo ipinfocache

	::http::config -useragent "Mozilla/5.0 ; Gecko"

	set headers {}

if {$::ipinfo(useaccount)} {

	if {!$::ipinfo(islogged)} {

		putlog "IP INFO: NOT LOGGED TRYING TO LOG IN";

		set logstats [ipinfo:dologin]

		if {$logstats != 0} {

			set headers [ipinfo:cookies $logstats]
			set ::COOKIES $headers
			set ::ipinfo(islogged) 1
		} else {
			set ::ipinfo(loginfailure) 1
			putlog "IP INFO: ERROR: LOGIN FAIL -- please check message";
		}

	} elseif {![info exists ::ipinfo(loginfailure)]} {
		set headers $::COOKIES
	}

}

   	set http_req [::http::geturl "http://www.ip2location.com/$host" -timeout 3000 -headers $headers]

	set data [::http::data $http_req]

	::http::cleanup $http_req

	if {[regexp {([^<]+)

} $data -> country]} {
		regexp {([^<]+)

} $data -> city
		regexp {([^<]+)

} $data -> isp
		regexp {([^<]+)

} $data -> domain

		set info [list $country $city $isp $domain [unixtime]]
		set ipinfocache($host) $info

	} else {
		putlog "IP INFO: Lookup FAILURE";

		set info {-}
	}

	return $info
}

proc ipinfo:output {host} {
global ipinfo ipinfocache

if {[info exists ipinfocache($host)]} {
	if {[expr {(60*60*24)*$ipinfo(cacherefresh)}] < [expr {[unixtime] - [lindex $ipinfocache($host) 4]}]} {
		putlog "IPinfo: refreshing cache data for $host"
		set info [ipinfo:getinfo $host]
		ipinfo:save
		return $info
	} else {
	return $ipinfocache($host)
	}
} else {
	set info [ipinfo:getinfo $host]
	ipinfo:save
	return $info
}

}

proc ipinfo:save {} {
global ipinfo ipinfocache

set write [open $ipinfo(cachefile) w]
puts $write	[list array set ipinfocache [array get ipinfocache]]
close $write

}

proc ipinfo:read {} {
global ipinfo ipinfocache

if {[file exists $ipinfo(cachefile)]} {
	if {![catch {source $ipinfo(cachefile)} cacheerror]} {
		putlog "IPinfo: cache file successfully loaded"
	} else {
		putlog "IPinfo: cache file failed to load -: $cacheerror"
		putlog "IPinfo: trying to fix cache file: reset" ; ipinfo:save

	}
} else {

ipinfo:save
putlog "IPinfo: cache file written - first time use"
}

}

ipinfo:read

bind pub -|- !ipinfo ipinfo:parser

putlog "Public IP Info $ver by HAWKEE Successfuly loaded"

Version 0.2:

Diferentele intre cele doua versiuni fiind sistemul de stocare temporara a datelor.

catch {array unset ipinfocache}
#########################################################################
#         Public IP Info v0.2 by Hawkee - lowraider1@gmail.com          #
#-----------------------------------------------------------------------#
# This script uses www.ip2location.com to check info for an ip adresses #
#	You can use it in 2 modes: THE FREE ONE or THE Account one	  #
#										  #
# The free one works for 20 IP lookups per day, because this is the 	  #
# maximum number of lookups, ip2location.com offers for unregistered 	  #
# users - per ip -. Set ip2loc(account) (default) to use this.		  #
#									         #
# Changes from version 0.1:							  #
#		-implemented a cache system to store the info to reduce	  #
#		resource usage                                            #
#             -the cache system refreshes the info at a given period of #
#		time                                                      #
#										  #
#										  #
# Works on all channels, and it can be used by all users. Requires TCL  #
# HTTP PACK									  #
#										  #
# USAGE: !ipinfo <IP>							  #
# 					HAVE PHUN				  #
# Email me with suggestions and bug reports at lowraider1@gmail.com 	  #
#										  #
#							 grtz HWK @ undernet	  #
#########################################################################

set ipinfo(cachefile) 	"ipinfo.cache"		;#the cache file
set ipinfo(cacherefresh) 	"7"					;#the time (in days) to refresh the info for an IP

set ver "0.2 - mod"

package require http

#DO NOT EDIT BELOW FUCKER!#

proc ipinfo:parser {nick uhost hand chan args} {

set ip [string trimright [lindex $args 0] "."]

if {![regexp {^(?:(?:[01]?\d?\d|2[0-4]\d|25[0-5])(\.|$)){4}$} $ip]} {
puthelp "privmsg $chan :$nick NO/Invalid IP pattern. USAGE: !ipinfo 193.193.193.193"
putlog "IP INFO $chan $nick - INVALID IP PATTERN"
return

}

set infoip [ipinfo:output $ip]
set country [lindex $infoip 0]
set city [lindex $infoip 1]
set isp [lindex $infoip 2]
set domain [lindex $infoip 3]

if {![info exists country] || [string equal $country -]} {
puthelp "privmsg $chan :$nick No information found for IP: \00302$ip\003 please redefine your IP"
putlog "IP INFO $chan $nick - No results"
return
}

puthelp "privmsg $chan :$nick IP information for \00302$ip\003: \002Country:\002 \00304$country\003, \002City:\002 \00304$city\003, \002ISP\002: \00302$isp\003, \002Domain:\002 \00302$domain\003"
putlog "IPinfo request:  $nick on $chan"

}

proc ipinfo:getinfo {host} {
global ipinfo ipinfocache

	::http::config -useragent "Mozilla/5.0 ; Gecko"

	set que [::http::formatQuery ipaddresses $host]
   	set http_req [::http::geturl "http://www.ip2location.com/demo.aspx" -timeout 2000 -query $que]

	set data [::http::data $http_req]
	::http::cleanup $http_req

	regexp {<span id="dgLookup__ctl2_lblICountry">([^<]+)</span></TD>} $data -> country
	regexp {<span id="dgLookup__ctl2_lblICity">([^<]+)</span></TD>} $data -> city
	regexp {<span id="dgLookup__ctl2_lblIISP">([^<]+)</span></TD>} $data -> isp
	regexp {<span id="dgLookup__ctl2_lblIDomain">([^<]+)</span></TD>} $data -> domain

	set info[list $country $city $isp $domain [unixtime]]

	set ipinfocache($host) $info

	return $info

}

proc ipinfo:output {host} {
global ipinfo ipinfocache

if {[info exists ipinfocache($host)]} {
	if {[expr {(60*60*24)*$ipinfo(cacherefresh)}] < [expr {[unixtime] - [lindex $ipinfocache($host) 4]}]} {
		putlog "IPinfo: refreshing cache data for $host"
		set info [ipinfo:getinfo $host]
		ipinfo:save
		return $info
	} else {
	return $ipinfocache($host)
	}
} else {
	set info [ipinfo:getinfo $host]
	ipinfo:save
	return $info
}

}

proc ipinfo:save {} {
global ipinfo ipinfocache

set write [open $ipinfo(cachefile) w]
puts $write	[list array set ipinfocache [array get ipinfocache]]
close $write

}

proc ipinfo:read {} {
global ipinfo ipinfocache

if {[file exists $ipinfo(cachefile)]} {
	if {![catch {source $ipinfo(cachefile)} cacheerror]} {
		putlog "IPinfo: cache file successfully loaded"
	} else {
		putlog "IPinfo: cache file failed to load -: $cacheerror"
		putlog "IPinfo: trying to fix cache file: reset" ; ipinfo:save

	}
} else {

ipinfo:save
putlog "IPinfo: cache file written - first time use"
}

}

ipinfo:read

bind pub -|- !ipinfo ipinfo:parser

putlog "Public IP Info $ver by HAWKEE Successfuly loaded"

Programare chat, eggdrop, info, Internet, ip, irc, Programare, tcl

Teoria aplicata pe intelesul tuturor!

PHP XML Blogroll sursa: blogspot.com – Suport cache si MYSQL

Version 0.2

Version 0.1

PHP si MYSQL Curs valutar automat EUR/USD – Sursa BNR

Public IP Info v 0.4 – script TCL pentru eggdrop

Version 0.4 (21.11.2011):

Version 0.3:

Version 0.2:

Calendar

Archives

Recent Articles

Links

Categories

Meta

February 2012
M	T	W	T	F	S	S
« Jan
		1	2	3	4	5
6	7	8	9	10	11	12
13	14	15	16	17	18	19
20	21	22	23	24	25	26
27	28	29