Chinaunix首页 | 论坛 | 博客
  • 博客访问: 657041
  • 博文数量: 149
  • 博客积分: 3901
  • 博客等级: 中校
  • 技术积分: 1558
  • 用 户 组: 普通用户
  • 注册时间: 2009-02-16 14:33
文章分类

全部博文(149)

文章存档

2014年(2)

2013年(10)

2012年(32)

2011年(21)

2010年(84)

分类:

2010-08-12 18:08:36


#纯真库




  非常想自己写一个程序分析QQWry.dat的格式, 从而使用在我的网站日志分析程序中。由于ieasy.org用的是awstats,支持perl写的插件,我就打算写一个perl脚本。

找到如下信息:

《关于QQwry格式》 http://dev.csdn.net/article/33/33563.shtm

正当我想自己写的时候,碰巧找到了雷傲论坛的代码,里面正好有perl写好的:) 用的时候,把脚本的保存为qqwry.pl,再去下载一份最新的QQWry.Dat,
写一个你得Perl脚本test.pl,如



#!/usr/bin/perl
use strict;
require "qqwry.pl";
print ipwhere("${ARGV[0]}");
print "\n";

$./test.pl ip地址











#####################################################
# LEO SuperCool BBS / LeoBBS X / 雷傲极酷超级论坛
#####################################################
# 基于山鹰(糊)、花无缺制作的 LB5000 XP 2.30 免费版 #
# 新版程序制作 & 版权所有: 雷傲科技 (C)(R)2004 #
#####################################################
# 主页地址: #
# 论坛地址: #
#####################################################


sub ipwhere {
    my $ipbegin,$ipend,$ipData1,$ipData2,$DataSeek,$ipFlag;
    
    my $ip=shift;
    my @ip=split(/\./,$ip);
    my $ipNum = $ip[0]*16777216+$ip[1]*65536+$ip[2]*256+$ip[3];

    my $ipfile="./QQWry.Dat";
    open(FILE,"$ipfile");
    binmode(FILE);
    sysread(FILE,$ipbegin,4);
    sysread(FILE,$ipend,4);
     $ipbegin=unpack("L",$ipbegin);
     $ipend=unpack("L",$ipend);
    my $ipAllNum = ($ipend-$ipbegin)/7+1;

    my $BeginNum=0;
    my $EndNum=$ipAllNum;

    Bgn:
    my $Middle= int(($EndNum+$BeginNum)/2);

    seek(FILE,$ipbegin+7*$Middle,0);
    read(FILE,$ipData1,4);
    my $ip1num=unpack("L",$ipData1);
    if ($ip1num > $ipNum) {
        $EndNum=$Middle;
        goto Bgn;
    }

    read(FILE,$DataSeek,3);
    $DataSeek=unpack("L",$DataSeek."\0");
    seek(FILE,$DataSeek,0);
    read(FILE,$ipData2,4);
    my $ip2num=unpack("L",$ipData2);
    if ($ip2num < $ipNum) {
        goto nd if ($Middle==$BeginNum);
        $BeginNum=$Middle;
        goto Bgn;
    }

    $/="\0";
    read(FILE,$ipFlag,1);
    if ($ipFlag eq "\1") {
        my $ipSeek;
        read(FILE,$ipSeek,3);
        $ipSeek = unpack("L",$ipSeek."\0");
        seek(FILE,$ipSeek,0);
        read(FILE,$ipFlag,1);
    }
    if ($ipFlag eq "\2") {
        my $AddrSeek;
        read(FILE,$AddrSeek,3);
        read(FILE,$ipFlag,1);
        if($ipFlag eq "\2") {
            my $AddrSeek2;
            read(FILE,$AddrSeek2,3);
            $AddrSeek2 = unpack("L",$AddrSeek2."\0");
            seek(FILE,$AddrSeek2,0);
        }
        else {
            seek(FILE,-1,1);
        }
        $ipAddr2=<FILE>;
        $AddrSeek = unpack("L",$AddrSeek."\0");
        seek(FILE,$AddrSeek,0);
        $ipAddr1=<FILE>;
    }
    else {
        seek(FILE,-1,1);
        $ipAddr1=<FILE>;
        read(FILE,$ipFlag,1);
        if($ipFlag eq "\2") {
            my $AddrSeek2;
            read(FILE,$AddrSeek2,3);
            $AddrSeek2 = unpack("L",$AddrSeek2."\0");
            seek(FILE,$AddrSeek2,0);
        }
        else {
            seek(FILE,-1,1);
        }
        $ipAddr2=<FILE>;
    }

    nd:
    chomp($ipAddr1,$ipAddr2);
    $/="\n";
    close(FILE);
    
    $ipAddr2="" if($ipAddr2=~/http/i);
    my $ipaddr="$ipAddr1 $ipAddr2";
    $ipaddr =~ s/CZ88\.NET//isg;
    $ipaddr="未知地区" if ($ipaddr=~/未知|http/i || $ipaddr eq "");
    return $ipaddr;
}

sub osinfo {
   local $os="",$Agent;
   $Agent = $ENV{'HTTP_USER_AGENT'};
   if (($Agent =~ /win/i)&&($Agent =~ /95/i)) {
      $os="Windows 95";
   }
   elsif (($Agent =~ /win 9x/i)&&($Agent =~ /4.90/i)) {
      $os="Windows ME";
   }
   elsif (($Agent =~ /win/i)&&($Agent =~ /98/i)) {
      $os="Windows 98";
   }
   elsif (($Agent =~ /win/i)&&($Agent =~ /nt 5\.0/i)) {
      $os="Windows 2000";
   }
   elsif (($Agent =~ /win/i)&&($Agent =~ /nt 5\.1/i)) {
      $os="Windows XP";
   }
   elsif (($Agent =~ /win/i)&&($Agent =~ /nt 5\.2/i)) {
      $os="Windows 2003";
   }
   elsif (($Agent =~ /win/i)&&($Agent =~ /nt/i)) {
      $os="Windows NT";
   }
   elsif (($Agent =~ /win/i)&&($Agent =~ /32/i)) {
      $os="Windows 32";
   }
   elsif ($Agent =~ /linux/i) {
      $os="Linux";
   }
   elsif ($Agent =~ /unix/i) {
      $os="Unix";
   }
   elsif (($Agent =~ /sun/i)&&($Agent =~ /os/i)) {
      $os="SunOS";
   }
   elsif (($Agent =~ /ibm/isg)&&($Agent =~ /os/isg)) {
      $os="IBM OS/2";
   }
   elsif (($Agent =~ /Mac/i)&&($Agent =~ /PC/i)) {
      $os="Macintosh";
   }
   elsif ($Agent =~ /FreeBSD/i) {
      $os="FreeBSD";
   }
   elsif ($Agent =~ /PowerPC/i) {
      $os="PowerPC";
   }
   elsif ($Agent =~ /AIX/i) {
      $os="AIX";
   }
   elsif ($Agent =~ /HPUX/i) {
      $os="HPUX";
   }
   elsif ($Agent =~ /NetBSD/i) {
      $os="NetBSD";
   }
   elsif ($Agent =~ /BSD/i) {
      $os="BSD";
   }
   elsif ($Agent =~ /OSF1/i) {
      $os="OSF1";
   }
   elsif ($Agent =~ /IRIX/i) {
      $os="IRIX";
   }
   elsif ($Agent =~ /google/i) {
      $os = "GoogleBot";
   }
   elsif ($Agent =~ /Yahoo/i) {
      $os = "YahooBot";
   }
  $os = "Unknown" if ($os eq '');
  $os =~ s/[\a\f\n\e\0\r\t\)\(\*\+\?]//isg;
  $os = substr($os, 0, 15) if (length($os) > 15);
  return $os;
}
sub browseinfo {
       my $browser = "";
       my $browserver = "";
       my ($Agent, $Part, $browseinfo);
       $Agent = $ENV{"HTTP_USER_AGENT"};

       if ($Agent =~ /Lynx/i)
       {
               $browser = "Lynx";
       }
       elsif ($Agent =~ /MOSAIC/i)
       {
               $browser = "MOSAIC";
       }
       elsif ($Agent =~ /AOL/i)
       {
               $browser = "AOL";
       }
       elsif ($Agent =~ /Lynx/i)
       {
               $browser = "Lynx";
       }
       elsif ($Agent =~ /Opera/i)
       {
               $browser = "Opera";
       }
       elsif ($Agent =~ /JAVA/i)
       {
               $browser = "JAVA";
       }
       elsif ($Agent =~ /MacWeb/i)
       {
               $browser = "MacWeb";
       }
       elsif ($Agent =~ /WebExplorer/i)
       {
               $browser = "WebExplorer";
       }
       elsif ($Agent =~ /OmniWeb/i)
       {
               $browser = "OmniWeb";
       }
       elsif ($Agent =~ /Mozilla/i)
       {
               if ($Agent =~ "MSIE")
               {
                       if ($Agent =~ /MyIE(\d*)/)
                       {
                               $browserver = $1;
                               $browser = "MyIE";
                       }
                       else
                       {
                               $Part = (split(/\(/, $Agent))[1];
                               $Part = (split(/\;/,$Part))[1];
                               $browserver = (split(/ /,$Part))[2];
                               $browserver =~ s/([\d\.]+)/$1/isg;
                               $browser = "Internet Explorer";
                       }
               }
               elsif ($Agent =~ "Opera")
               {
                       $Part = (split(/\(/, $Agent))[1];
                       $browserver = (split(/\)/, $Part))[1];
                       $browserver = (split(/ /,$browserver))[2];
                       $browserver =~ s/([\d\.]+)/$1/isg;
                       $browser = "Opera";
               }
               else
               {
                       $Part = (split(/\(/, $Agent))[0];
                       $browserver = (split(/\//, $Part))[1];
                       $browserver = (split(/ /,$browserver))[0];
                       $browserver =~ s/([\d\.]+)/$1/isg;
                       $browser = "Netscape Navigator";
               }
       }
       elsif ($Agent =~ /google/i)
       {
               $browser = "GoogleBot";
       }
       elsif ($Agent =~ /Yahoo/i)
       {
               $browser = "YahooBot";
       }

       if ($browser ne '')
       {
               $browserver =~ s/[^0-9\.b]//isg;
               $browserver = &lbhz($browserver, 4) if (length($browserver) > 10);
               $browseinfo = "$browser $browserver";
       }
       else
       {
               $browseinfo = "Unknown";
       }
       $browseinfo =~ s/[\a\f\n\e\0\r\t\)\(\*\+\?]//isg;
  $browseinfo =~ s/[\a\f\n\e\0\r\t\)\(\*\+\?]//isg;
  $browseinfo = substr($browseinfo, 0, 28) if (length($browseinfo) > 28);
       return $browseinfo;
}
1;


阅读(1867) | 评论(0) | 转发(0) |
给主人留下些什么吧!~~