包含三个文件
QQTOOL.VBS———–主程序
qqstyle.xsl—————-xml式样文件
s_id.txt——————–特殊ID文件
使用
导出群聊天记录为文本文件,文件名与s_id.txt中的|所在群|相同.
把文件拖到程序图标上或命令行执行
QQTOOL.VBS group.txt
程序将生成group.txt.xml文件,和qqstyle.xsl放在同一目录,则可以在浏览器中查看统计信息!
下载地址
ftp://vcgood:www.vcgood.com@ftp.vcgood.com/网友上传/qqtool-0.9.2.vbs.rar
>> 本文固定链接: http://www.vcgood.com/archives/2655
QQTOOL.VBS
[code]
option explicit
' QQ聊天记录统计
' by xstar.wxb
' @2008-08-24
' version: v0.9
' usage: qqtool.vbs grouprecode.txt
' 这里grouprecode.txt文件是群聊天记录文件，文件名和s_id.txt中数据对应
' s_id.txt 特殊成员数据
' 格式: qqnum|qqname|qqgroup|qqremark
' 定数定义
const s_idFile = "s_id.txt" ' 特殊成员数据
const fileRead = 1
const fileWrite = 2
const fileAppend = 8
' 变量定义
' 参数
dim args
' 文件对象，输入文件，输出文件，特殊成员数据文件
dim f_namein, f_nameout, f_nameid
' scripting.filesystemobject 对象
dim o_fso
' 群，从输入的文件名获取，和s_id.txt中的数据对应
dim qqgroup
' 网友个数
dim numcnt
' 网友聊天记录统计结构
dim QQDATACNT
dim QQdata( 5, 1023) ' id, qqnum, qqname, qqdate, qqcount, qqremark
QQDATACNT = 1023
' 获取参数
set args = wscript.arguments
' 检查参数个数
if args.count = 0 then
' 出错则显示使用信息
wscript.echo "usage: qqtool.vbs <filename>"
wscript.quit
end if
' 获取参数，得到输入/输出文件和特殊成员数据文件
f_namein = wscript.arguments(0)
f_nameout = f_namein & ".xml"
' 特殊成员数据文件
f_nameid = left( wscript.scriptfullname, instrrev( wscript.scriptfullname, "\" ) ) & s_idFile
' 根据输入文件得到群号
set o_fso = createobject( "scripting.filesystemobject" )
qqgroup = o_fso.GetBaseName( f_namein )
set o_fso = nothing
' 根据输入文件统计聊天记录
numcnt = readQQdata( f_namein )
' 修正特殊成员数据
numcnt = updateIDInfo( f_nameid, qqgroup, numcnt )
' 输出为xml文件
writexml f_nameout, QQdata, numcnt
' 显示结果信息
wscript.echo "统计信息文件生成成功！" & vbcrlf & "文件名: " & f_nameout & vbcrlf & "数据数: " & numcnt
wscript.quit
' 替换特殊字符
function rplstr( strline )
dim restr
set restr = createobject( "vbscript.regexp" )
restr.pattern = "[\x00-\x1f|\x7f]"
restr.ignorecase = true
restr.global = true
' 过滤特殊字符
strline = restr.replace( strline, "" )
strline = replace( strline, "&", "&" )
strline = replace( strline, "<", "<" )
strline = replace( strline, ">", ">" )
strline = replace( strline, "'", "'" )
strline = replace( strline, """", """ )
set restr = nothing
rplstr = strline
end function
' 根据特殊成员数据文件修正统计的信息
function updateIDInfo( f_name, groupnum, numcnt )
dim o_fso
dim f_in
dim strline
dim reqqline
dim qqnum, qqname, qqdate, qqremark
dim newflg
dim num
set o_fso = createobject( "scripting.filesystemobject" )
set f_in = o_fso.opentextfile( f_name, fileRead )
set reqqline = createobject( "vbscript.regexp" )
'reqqline.pattern = "^(\d+)\|(.*)\|(.*)\|(.*)$"
reqqline.pattern = "^(.*)\|(.*)\|(.*)\|(.*)$"
reqqline.ignorecase = true
reqqline.global = true
do while not f_in.atendofstream
strline = f_in.readline
' 是否是注解行
if left( trim( strline ), 1 ) <> "#" then
if reqqline.test( strline ) then
' 判断是否是所需群号
if reqqline.replace( strline, "$3" ) = groupnum then
' 获取各个部分
qqnum = reqqline.replace( strline, "$1" )
qqname = reqqline.replace( strline, "$2" )
qqremark = reqqline.replace( strline, "$4" )
' msgbox qqnum & qqname & qqremark
qqdate = getdatetime()
newflg = true
' 循环判断QQ是否已经在统计信息里
for num = 0 to numcnt - 1
if QQdata( 1, num ) = qqnum then
QQdata( 2, num ) = qqname
'QQdata( 3, num ) = qqdate
QQdata( 5, num ) = qqremark
newflg = false
exit for
end if
next
' 判断是否需要新增
if newflg then
if numcnt > QQDATACNT then
' 越界，退出循环
msgbox "ERR: Subscript out of range"
exit do
end if
QQdata( 1, numcnt ) = qqnum
QQdata( 2, numcnt ) = qqname
QQdata( 3, numcnt ) = qqdate
QQdata( 4, numcnt ) = 0
QQdata( 5, numcnt ) = qqremark
numcnt = numcnt + 1
end if
end if
end if
end if
loop
f_in.close
set f_in = nothing
set reqqline = nothing
set o_fso = nothing
updateIDInfo = numcnt
end function
' 获取当前时间函数，格式: YYYY-MM-DD HH:MM:SS
function getdatetime()
dim YYYY, yMM, DD, hh, hmm, ss
dim nowtime
' 取得当前时间
nowtime = now()
' 拆分各个部分
YYYY = cstr( year( nowtime ) )
yMM = cstr( month( nowtime ) )
DD = cstr( day( nowtime ) )
hh = cstr( hour( nowtime ) )
hmm = cstr( minute( nowtime ) )
ss = cstr( second( nowtime ) )
' 修正
do while len( YYYY ) < 4
YYYY = "0" & YYYY
loop
if len( yMM ) = 1 then
yMM = "0" & yMM
end if
if len( DD ) = 1 then
DD = "0" & DD
end if
if len( hh ) = 1 then
hh = "0" & hh
end if
if len( hmm ) = 1 then
hmm = "0" & hmm
end if
if len( ss ) = 1 then
ss = "0" & ss
end if
' 返回
getdatetime = YYYY & "-" & yMM & "-" & DD & " " & hh & ":" & hmm & ":" & ss
end function
' 读取并统计聊天记录
function readQQdata( f_name )
dim o_fso
dim f_in
dim strline
' vbscript.regexp
dim reqqline
dim numcnt, num
dim qqnum, qqname, qqdate
dim newflg
set o_fso = createobject( "scripting.filesystemobject" )
set f_in = o_fso.opentextfile( f_name, fileRead )
' 初试化
for numcnt = 0 to ubound( QQdata, 2)
QQdata( 0, numcnt ) = numcnt + 1
QQdata( 1, numcnt ) = 0 'qqnum
QQdata( 2, numcnt ) = 0 'qqname
QQdata( 3, numcnt ) = 0 'qqndate
QQdata( 4, numcnt ) = 0 'qqcount
QQdata( 5, numcnt ) = "普通成员" 'qqremark
next
set reqqline = createobject( "vbscript.regexp" )
'reqqline.pattern = "^(\d{4}-(0[1-9]|1[0-2])-(0[1-9]|[12]\d|3[01])\x20([01]\d|2[0-3]):[0-5]\d:[0-5]\d)\x20(.*)\((\d+)\)$"
reqqline.pattern = "^(\d{4}-(0[1-9]|1[0-2])-(0[1-9]|[12]\d|3[01])\x20([01]\d|2[0-3]):[0-5]\d:[0-5]\d)\x20(.*)\((.*)\)$"
reqqline.ignorecase = true
reqqline.global = true
numcnt = 0
do while not f_in.atendofstream
strline = f_in.readline
if reqqline.test( strline ) then
' 获取各个部分
qqnum = reqqline.replace( strline, "$6" )
qqname = reqqline.replace( strline, "$5" )
qqdate = reqqline.replace( strline, "$1" )
' 初始化需要新增
newflg = true
' 循环判断QQ是否已经在统计信息里
for num = 0 to numcnt - 1
if QQdata( 1, num ) = qqnum then
QQdata( 2, num ) = qqname
QQdata( 3, num ) = qqdate
QQdata( 4, num ) = QQdata( 4, num ) + 1
newflg = false
exit for
end if
next
' 判断是否需要新增
if newflg then
if numcnt > QQDATACNT then
' 越界，退出循环
msgbox "ERR: Subscript out of range"
exit do
end if
QQdata( 1, numcnt ) = qqnum
QQdata( 2, numcnt ) = qqname
QQdata( 3, numcnt ) = qqdate
QQdata( 4, numcnt ) = 1
numcnt = numcnt + 1
end if
end if
loop
f_in.close
set f_in = nothing
set reqqline = nothing
set o_fso = nothing
readQQdata = numcnt
end function
' 将信息写入xml文件
function writexml( f_name, QQdata, numcnt )
dim o_fso
dim f_out
dim num
set o_fso = createobject( "scripting.filesystemobject" )
set f_out = o_fso.createtextfile( f_name, fileWrite )
' 写入各项信息
f_out.writeline "<?xml version=""1.0"" encoding=""GB2312""?>"
f_out.writeline "<?xml-stylesheet type=""text/xsl"" href=""qqstyle.xsl""?>"
f_out.writeline "<catalog>"
for num = 0 to numcnt - 1
f_out.writeline vbtab & "<statsinfo id=""" & QQdata( 0, num ) & """>"
f_out.writeline vbtab & vbtab & "<date>" & QQdata( 3, num ) & "</date>"
f_out.writeline vbtab & vbtab & "<number>" & QQdata( 1, num ) & "</number>"
f_out.writeline vbtab & vbtab & "<name>" & rplstr( QQdata( 2, num ) ) & "</name>" ' 写入xml中的时候替换某些特殊字符
f_out.writeline vbtab & vbtab & "<count>" & QQdata( 4, num ) & "</count>"
f_out.writeline vbtab & vbtab & "<remark>" & rplstr( QQdata( 5, num ) ) & "</remark>" ' 写入xml中的时候替换某些特殊字符
f_out.writeline vbtab & "</statsinfo>"
next
f_out.writeline "</catalog>"
f_out.close
set f_out = nothing
set o_fso = nothing
end function
[/code]
qqstyle.xsl
[code]
<?xml version="1.0" encoding="gb2312"?>
<xsl:stylesheet xmlns:xsl="http://www.w3.org/TR/WD-xsl">
<xsl:template match="/">
<html>
<head>
<title>QQ群聊天记录统计</title>
<style>
.title {
font-size:15pt;
font-weight:bold;
color:blue;
}
.statsinfo {
width: 800px;
border: 1px solid #770000;
}
.date {
width: 170px;
border: 1px solid #770000;
}
.number {
width: 100px;
border: 1px solid #770000;
}
.name {
width: 230px;
border: 1px solid #770000;
}
.count {
width: 100px;
text-align: center;
border: 1px solid #770000;
}
.remark {
border: 1px solid #770000;
}
</style>
</head>
<body>
<strong class="title">统计信息</strong>
<div style="color:blue">
<xsl:apply-templates select="catalog"/>
</div>
</body>
</html>
</xsl:template>
<xsl:template match="catalog">
<table class="statsinfo">
<tr>
<td class="date">最后发言时间</td>
<td class="number">QQ号码</td>
<td class="name">昵称</td>
<td class="count">发言次数</td>
<td class="remark">备注</td>
</tr>
<xsl:for-each select="statsinfo" order-by="-date">
<tr>
<td class="date"><xsl:value-of select="date"/></td>
<td class="number"><xsl:value-of select="number"/></td>
<td class="name"><xsl:value-of select="name"/></td>
<td class="count"><xsl:value-of select="count"/></td>
<td class="remark"><xsl:value-of select="remark"/></td>
</tr>
</xsl:for-each>
</table>
</xsl:template>
</xsl:stylesheet>
[/code]
s_id.txt
[code]
#QQ号码|昵称|所在群|备注
#例: 10000|客服|10000|QQ客服
[/code]
支持原创.试用一下..
VBS写的 那你不错啊
支持支持楼主啊