Perl 程式发布专区
tag:easun.org,2008-09-20:/perl//37
2008-09-26T07:29:36Z
发表个人编写的完整的Perl 程式,包括常见BBS的插件。
Movable Type Pro 4.38
[注意]本区文章归档区
tag:easun.org,2006:/perl/forum//5.1086
2006-10-15T21:24:47Z
2008-09-26T07:29:36Z
路杨
http://easun.org/cgi-bin/mymt/mt-cp.cgi?__mode=view&blog_id=5&id=1
本区文章的静态归档页面在此: http://easun.org/archives/program/perl/ 速度比论坛快一点。 ]]>
呵呵,Perl脚本打包成EXE工具PltoEXE。
tag:easun.org,2006:/perl/forum//5.1082
2006-04-24T22:21:09Z
2011-09-08T16:03:09Z
呵呵,因为写REFile需要打包程序,PDK和perl2exe太贵付不起,perlcc功能有限无法打包,PAR打包后尺寸太大,所以打算自己用Perl写一个打包的软件,上次跟恒恒说起,也写了个0.0.0.1版,只能打包不含模块的以及不显示DOS窗口,今天休息,又尝试了一下,应该是比REFile要简单些吧,可以打包包含模块的,但是现在还有许多问题没去尝试,比如尺寸问题,需要将注释去掉并有好的压缩算法,依赖Perl58.dll问题,这个打算等以后用OCaml实现,现在还不管它,无法指定程序图标,不知道如何实现,以后用OCaml我想就可以解决,Perl并不知道如果实现,还没进行更多测试。等休息时有空整理一下再发上来吧。...
y6cmE
http://easun.org/cgi-bin/mymt/mt-cp.cgi?__mode=view&blog_id=5&id=183
呵呵,因为写REFile需要打包程序,PDK和perl2exe太贵付不起,perlcc功能有限无法打包,PAR打包后尺寸太大,所以打算自己用Perl写一个打包的软件,上次跟恒恒说起,也写了个0.0.0.1版,只能打包不含模块的以及不显示DOS窗口,今天休息,又尝试了一下,应该是比REFile要简单些吧,可以打包包含模块的,但是现在还有许多问题没去尝试,比如尺寸问题,需要将注释去掉并有好的压缩算法,依赖Perl58.dll问题,这个打算等以后用OCaml实现,现在还不管它,无法指定程序图标,不知道如何实现,以后用OCaml我想就可以解决,Perl并不知道如果实现,还没进行更多测试。等休息时有空整理一下再发上来吧。]]>
REFile -正则批量改文件名
tag:easun.org,2005:/perl/forum//5.1089
2005-09-06T09:59:55Z
2012-02-06T08:56:03Z
呵呵,自己写的共享软件,现版本0.1.0.0,下载地址(含源代码):http://www.perlsoft.org/download/REFile.ziphttp://www.perlsoft.org/download/REFile.rar可以自己写正则表达式改文件名可以保存日志可以反向取消所改的文件名可以选择是否包含子目录可以根据Office(如Word,Excel)的标题自命名文件12号考试完以后会再加入HTML、MP3等之类的自命名以及线程控制。谢谢路扬兄让我广告了一下,我的计划是1.0.0.0推出英文版,就做海外市场,所以现在需要更多测试,基本上是我一写完就放上来,自己都没怎么经过测试,自己都是用Perl REFile.pl来运行,有时在Win 2000用得好好的,打包后在Win 98就死掉了。希望大家能从代码中学到点什么:)...
y6cmE
http://easun.org/cgi-bin/mymt/mt-cp.cgi?__mode=view&blog_id=5&id=183
呵呵,自己写的共享软件,现版本0.1.0.0,下载地址(含源代码):http://www.perlsoft.org/download/REFile.zip http://www.perlsoft.org/download/REFile.rar 可以自己写正则表达式改文件名 可以保存日志 可以反向取消所改的文件名 可以选择是否包含子目录 可以根据Office(如Word,Excel)的标题自命名文件 12号考试完以后会再加入HTML、MP3等之类的自命名以及线程控制。 谢谢路扬兄让我广告了一下,我的计划是1.0.0.0推出英文版,就做海外市场,所以现在需要更多测试,基本上是我一写完就放上来,自己都没怎么经过测试,自己都是用Perl REFile.pl来运行,有时在Win 2000用得好好的,打包后在Win 98就死掉了。 希望大家能从代码中学到点什么:)]]>
[LB整理]根据会员在线时间自动奖励会员金钱的小功能
tag:easun.org,2005:/perl/forum//5.1087
2005-04-12T00:33:58Z
2006-03-28T14:58:05Z
路杨
http://easun.org/cgi-bin/mymt/mt-cp.cgi?__mode=view&blog_id=5&id=1
说明: 1。根据 http://www.leohacks.com/cgi-bin/topic.cgi?forum=14&topic=552 整理。详细机制皆在这个帖子里面,可以回去看看。 2。原来是为每10 分钟加多少论坛货币。整理时候为了大家方便变成每1 分钟。。 3。后台添加设置。 4。如果用户在150s内重复登陆不计算在线时间。即不奖励。修改: 1。setstyles.cgi: 找到 <tr> <td bgcolor=#FFFFFF colspan=2> <font color=#333333>默认用户在线时间是多少分钟?<BR>如果用户超过这个时间还没有动作则默认用户已经离开了论坛。</font></td> <td bgcolor=#FFFFFF> <input type=text name="membergone" value="$membergone" size=3 maxlength=3> 一般为 5 -- 15</td> </tr> 在其下面添加: <tr> <td bgcolor=#FFFFFF colspan=2> <font color=#333333>用户在线时间1分钟奖励多少论坛货币?<BR>如果用户在150s内重复登陆不计算在线时间。<br>该数据会在退出登陆界面显示。</font></td> <td bgcolor=#FFFFFF> <input type=text name="onlineaddmoney" value="$onlineaddmoney" size=3 maxlength=3> 一般为 5 -- 15</td> </tr> 保存文件后进后台“默认风格设置”设置一次这个时间,保存。 2。 bbs.lib.pl 找到。 if ($visit eq "T") { $visitno++ if (($nowtimetemp - $lastgone) > 300); } else { $onlinetime = 0 if ($onlinetime =~ /[^0-9]/); $onlinetime = $onlinetime + $savedtime-$savedcometime if (($nowtimetemp - $lastgone) > 150); unlink ("${lbdir}cache/id/$nametocheck.cgi"); unlink ("${lbdir}cache/myinfo/$nametocheck.pl"); unlink ("${lbdir}cache/online/$nametocheck.cgi"); }替换成 if ($visit eq "T") { $visitno++ if (($nowtimetemp - $lastgone) > 300); } else { $onlinetime = 0 if ($onlinetime =~ /[^0-9]/); my $time_s = $savedtime-$savedcometime; $onlinetime = $onlinetime + $time_s if (($nowtimetemp - $lastgone) >150); if (($nowtimetemp - $lastgone) >150) { $mymoney = $mymoney + ( int( $time_s /60) ) * $onlineaddmoney; if (($thisprog eq "loginout.cgi")&& (lc($membername) eq lc($inmembername)) ) #处理显示 { my $time_m = int( $time_s /60); my $added_m = (int( $time_s /60) ) * $onlineaddmoney; require "data/cityinfo.cgi" if ($moneyname eq ''); $showit="<li>您在论坛停留了 ".$time_m." 分钟,得到 ".$added_m." $moneyname的津贴奖励。"; } #end } else { require "data/cityinfo.cgi" if ($moneyname eq ''); $showit="<li>您在论坛停留时 ".$time_s." 秒,得到 0 $moneyname的津贴奖励。" if (($thisprog eq "loginout.cgi")&& (lc($membername) eq lc($inmembername)) ); } unlink ("${lbdir}cache/id/$nametocheck.cgi"); unlink ("${lbdir}cache/myinfo/$nametocheck.pl"); unlink ("${lbdir}cache/online/$nametocheck.cgi"); } 3。打开loginout.cgi 找到 elsif ($action eq "logout") { &cleanolddata1; if ($inmembername ne "" && $inmembername ne "客人") {替换成 elsif ($action eq "logout") { &cleanolddata1; undef $showit; if ($inmembername ne "" && $inmembername ne "客人") { $showit=qq~<li>系统忙,您在论坛上得到的津贴奖励暂时不显示。~; 找到 $output .= qq~<tr><td bgcolor=$titlecolor $catbackpic valign=middle align=center><font face="$font" color=$fontcolormisc><b>您现在已经退出论坛</b></font></td></tr> <tr><td bgcolor=$miscbackone valign=middle><font face="$font" color=$fontcolormisc> 具体选项:<ul><li><a href="leobbs.cgi">返回论坛</a><li><a href=javascript:close();>关闭您的浏览器</a></ul></tr></td></table></td></tr></table> <SCRIPT>valignend()</SCRIPT> ~;替换成 $output .= qq~<tr><td bgcolor=$titlecolor $catbackpic valign=middle align=center><font face="$font" color=$fontcolormisc><b>您现在已经退出论坛</b></font></td></tr> <tr><td bgcolor=$miscbackone valign=middle><font face="$font" color=$fontcolormisc> 具体选项:<ul>$showit<li><a href="leobbs.cgi">返回论坛</a><li><a href=javascript:close();>关闭您的浏览器</a></ul></tr></td></table></td></tr></table> <SCRIPT>valignend()</SCRIPT>其他: 本Hack采用了LB本身更新机制。。不管是否正常退出,皆按照时间添加货币的。。:) 其他关于用户自动升级等。。都可以用相似的办法Hack之。]]>
[小修改]leobbsx官方rss系统的小修改:)
tag:easun.org,2005:/perl/forum//5.1083
2005-03-24T15:37:50Z
2005-03-24T15:37:50Z
路杨
http://easun.org/cgi-bin/mymt/mt-cp.cgi?__mode=view&blog_id=5&id=1
不关痛痒的修改。只是为了更好的兼容一些RSS阅读器,和正规的xml语法。 现在的Leobbs的rss连接是好多RSS阅览器所不能自动识别的。原因部分阅览器比较呆版,只认识xml扩展名。解决办法就是加上虚假的xml扩展名。 1。leobbs.cgi 找到$rsshtml = qq~<td align=center width=34><a href="rss.cgi" target="_blank"><img src="$imagesurl/images/xml.gif" border="0" align="absmiddle" alt="RSS 订阅全部论坛"></a></td>~; 小小的修改为$rsshtml = qq~<td align=center width=34><a href="rss.cgi/[color=red]easun.xml[/color]" target="_blank"><img src="$imagesurl/images/xml.gif" border="0" align="absmiddle" alt="RSS 订阅全部论坛"></a></td>~; 3。forums.cgi 找到$rsshtml = qq~ <a href="rss.cgi?forum=$inforum" target="_blank"><img src="$imagesurl/images/xml.gif" border="0" align="absmiddle" alt="RSS 订阅本论坛"></a>~; 小小的修改为$rsshtml = qq~ <a href="rss.cgi/[color=red]easun.xml[/color]?forum=$inforum" target="_blank"><img src="$imagesurl/images/xml.gif" border="0" align="absmiddle" alt="RSS 订阅本论坛"></a>~; 2。 bbs.lib.pl 找到$coolmeta = qq~<META http-equiv="Page-Enter" content="revealTrans(Transition=$cinoption,Duration=1)"> <META http-equiv="Page-Exit" content="revealTrans(Transition=$cinoption,Duration=1)">~ if ($pagechange eq "yes"); 在这个下面加上 $coolmeta [color=red].=[/color] qq~<link title="$title" type="application/rss+xml" rel="alternate" href="rss.cgi/easun.xml"></link> ~ ;本帖子无技术含量,发到发布区只是为了让更多人看到而已 。。 PS:如果你按照这个修改了。你会发现如果你用FireFox1.0以上版本(不用装插件),访问Leobbs的RSS根本不需要什么RSS阅读器的:)]]>
[旧文]解决从动网6.0转雷傲后,用户密码问题
tag:easun.org,2005:/perl/forum//5.1084
2005-01-05T07:27:38Z
2005-01-05T07:28:20Z
路杨
http://easun.org/cgi-bin/mymt/mt-cp.cgi?__mode=view&blog_id=5&id=1
原来的改法是针对LB5000的,已经失效。 新的改法应该是 然后:打开loginout.cgi, 找到 if ($inpassword ne "") { eval {$inpassword = md5_hex($inpassword);}; if ($@) {eval('use Digest::MD5 qw(md5_hex);$inpassword = md5_hex($inpassword);');} unless ($@) {$inpassword = "lEO$inpassword";} } 改成 if ($inpassword ne "") { eval {$inpassword = md5_hex($inpassword);}; if ($@) {eval('use Digest::MD5 qw(md5_hex);$inpassword = md5_hex($inpassword);');} unless ($@) { $DVpassword = substr ($inpassword,8,16); $DVpassword = md5_hex($DVpassword); $inpassword = "lEO$inpassword"; $DVpassword="lEO$DVpassword"; } } 找到 if ($action eq "login") { &cleanolddata; if (($userregistered ne "no") && ($inpassword eq $password)) { &whosonline("$inmembername\t论坛登录\tnone\t登录论坛\t"); 改成 if ($action eq "login") { &cleanolddata; if (($userregistered ne "no") && (($inpassword eq $password) || ($DVpassword eq $password))) { if ($DVpassword eq $password) { require "plugin.lib.pl"; &upinfodata( name => "$inmembername", password =>"$inpassword"); } &whosonline("$inmembername\t论坛登录\tnone\t登录论坛\t"); 原因 :DV的加密不是单纯的Md5加密。而是加密了以后采用加密数字的8-16位做密码。而leo是加密了以后全部数字+上LEO前缀。]]>
[Hack]重归CGI.pm怀抱的LBCGI.pm
tag:easun.org,2005:/perl/forum//5.1085
2005-01-05T07:24:25Z
2005-06-10T00:11:55Z
路杨
http://easun.org/cgi-bin/mymt/mt-cp.cgi?__mode=view&blog_id=5&id=1
即LBCGI不再是CGI.pm的mini,而是继承于CGI.pm的模块。 目的 : 1。解决在部分主机上的兼容问题。 2。稳定性加强,尤其是在上传的时候。 3。资源问题在3台不同类型主机上测试,在FreeBSD下cpu时间提升了10ms左右,WIndows基本不变 相关信息 : http://www.leohacks.com/cgi-bin/topic.cgi?forum=3&topic=3420 成品 :http://easun.org/upload/early/_1118419837.rar 相关修改。 1。已知cookieDate问题修正。 就是选用这个LBCGI.pm后选择不保存密码登陆将会登陆失败。可以搜索所有的leobbsx文件,把 -1d 替换成 0,即可。 原因,CGI.pm和原来LBCGI.pm定义不同。 2。 upfile.cgi。 由于弃用几个很古老的函数,所以上传做了变动。 具体修改sub doupfile前面部分为 代码: sub doupfile #上传 { # $addme=$query->upload('addme'); #如果CGI.pm版本>2.47,推荐使用 $addme=$query->param('addme'); #如果CGI.pm版本<2.47,用他替换上句 $forum=$query->param('forum'); $topic=$query->param('topic'); $inforum = $forum; $intopic = $topic; &moderator($inforum); #获得权限 my $thispath=&getusrdir; #临时目录 &thisout("<b>目前您未被发布的附件临时文件已经有$filesno个,达到了论坛设置的最大数目($ maxaddnum),<BR>请不要一次上传太多附件,谢谢配合与合作!</b>$gourl") if ($thispath eq 'ERR'); if (($addme)&&(($arrowupload ne 'off')||($membercode eq 'ad')||($membercode eq 'smo')||($inmembmod eq 'yes'))) { $uploadreqire = 0 if ($uploadreqire < 0); if (($membercode ne 'ad')&&($membercode ne 'smo')&&($membercode ne 'amo')&&($membercode ne 'cmo')&&($membercode ne 'mo')&&($membercode !~ /^rz/)&&($inmembmod ne 'yes')&&(($numberofposts+$numberofreplys) < $uploadreqire)) { &thisout("上传出错,你必须发帖总数达到 <B>$uploadreqire</B> 才能在本区上传!$gourl"); } my ($tmpfilename) = $addme =~ m|([^/:\\]+)$|; #注意,获取文件名字的形式变化 # $tmpfilename =~s/([^\w.-])/_/g; # $tmpfilename =~s/(^[-.]+)//; my @filename = split(/\./,$tmpfilename); #注意 $up_name = $filenameΎ]; $up_ext = $filename[-1]; $up_ext = lc($up_ext); my $checkadd=0; for (split(/\,\s*/,$addtype)){ $checkadd=1,last if ($up_ext eq lc($_)); } &thisout("上传出错,为了安全,不支持你所上传的附件,请重新选择!$gourl") if ($up_ext eq "exe"||$up_ext eq "com"||$up_ext eq "pl"||$up_ext eq "cgi"||$up_ext eq "asp"||$up_ext eq "php"||$up_ext eq "php3"||$up_ext eq "phtml"||$up_ext eq "jsp"||$up_ext eq "cfml"||$up_ext eq "dll"); &thisout("上传出错,不支持你所上传的附件或者图片,请重新选择!$gourl") if ($checkadd==0); my $filesize=0; my $bufferall; my $tmpfilename=&gettmpname(${up_name}); #注意 open (FILE,">$thispath/$tmpfilename.$up_ext"); binmode ($addme); #注意 binmode (FILE); while (((read($addme,$buffer,4096)))&&!(($filesize>$maxupload)&&($membercode ne "ad"))) { if ($up_ext eq "txt"||$up_ext eq "cgi"||$up_ext eq "pl"||$up_ext eq "php3"||$up_ext eq "phtm"||$up_ext eq "phtml"||$up_ext eq "htm"||$up_ext eq "html"||$up_ext eq "asp"||$up_ext eq "php"||$up_ext eq "shtml"||$up_ext eq "phtml"||$up_ext eq "jsp"){ $buffer=~s/\.cookie/\&\#46\;cookie/isg; $buffer =~ s/on(mouse|exit|error|click|key)/\&\#111\;n$1/isg; $buffer=~s/script/scri\&\#112\;t/isg; $buffer =~ s/style/\&\#115\;tyle/isg; } print FILE $buffer; $bufferall .= $buffer if ($up_ext eq 'torrent'); $filesize=$filesize+4; } close (FILE); close ($addme); #注意 #############torrent分析################ 3。 dosavemodify.pl 也是修改上传部分。 修改 if ($addme) { unlink ("${imagesdir}usravatars/$memberfiletitle.gif"); unlink ("${imagesdir}usravatars/$memberfiletitle.png"); unlink ("${imagesdir}usravatars/$memberfiletitle.jpg"); unlink ("${imagesdir}usravatars/$memberfiletitle.swf"); unlink ("${imagesdir}usravatars/$memberfiletitle.bmp"); unlink ("${imagesdir}usravatars/$memberfiletitletemp.gif"); unlink ("${imagesdir}usravatars/$memberfiletitletemp.png"); unlink ("${imagesdir}usravatars/$memberfiletitletemp.jpg"); unlink ("${imagesdir}usravatars/$memberfiletitletemp.swf"); unlink ("${imagesdir}usravatars/$memberfiletitletemp.bmp"); my $filename =$query->uploadInfo($addme); my $fileexp; $fileexp = ($filename =~ /\.jpe?g\s*$/i) ? 'jpg' :($filename =~ /\.gif\s*$/i) ? 'gif' :($filename =~ /\.png\s*$/i) ? 'png' :($filename =~ /\.swf\s*$/i) ? 'swf' :($filename =~ /\.bmp\s*$/i) ? 'bmp' :undef; $maxuploadava = 200 if (($maxuploadava eq "")||($maxuploadava < 1)); if (($fileexp eq "swf")&&($flashavatar ne "yes")) { &error("不支持你所上传的图片,请重新选择!&仅支持 GIF,JPG,PNG,BMP 类型!"); } if (!defined $fileexp) { &error("不支持你所上传的图片,请重新选择!&仅支持 GIF,JPG,PNG,BMP,SWF 类型!"); } my $filesize=0; my $buffer; open (FILE,">${imagesdir}usravatars/$memberfiletitletemp.$fileexp"); binmode (FILE); while ((($buffer=$query->readUploadFile($addme,4096)))&&!($filesize>$maxuploadava)) { print FILE $buffer; $filesize=$filesize+4; } close (FILE); 为 if ($addme) { unlink ("${imagesdir}usravatars/$memberfiletitle.gif"); unlink ("${imagesdir}usravatars/$memberfiletitle.png"); unlink ("${imagesdir}usravatars/$memberfiletitle.jpg"); unlink ("${imagesdir}usravatars/$memberfiletitle.swf"); unlink ("${imagesdir}usravatars/$memberfiletitle.bmp"); unlink ("${imagesdir}usravatars/$memberfiletitletemp.gif"); unlink ("${imagesdir}usravatars/$memberfiletitletemp.png"); unlink ("${imagesdir}usravatars/$memberfiletitletemp.jpg"); unlink ("${imagesdir}usravatars/$memberfiletitletemp.swf"); unlink ("${imagesdir}usravatars/$memberfiletitletemp.bmp"); my ($filename) = $addme =~ m|([^/:\\]+)$|; #注意,获取文件名字的形式变化 my @filename = split(/\./,$filename); #注意 my $up_name = $filenameΎ]; $fileexp = $filename[-1]; $fileexp = lc($fileexp); $fileexp = ($fileexp =~ /jpe?g$/i) ? 'jpg' :($fileexp =~ /gif$/i) ? 'gif' :($fileexp =~ /png$/i) ? 'png' :($fileexp =~ /swf$/i) ? 'swf' :($fileexp =~ /bmp$/i) ? 'bmp' :undef; $maxuploadava = 200 if (($maxuploadava eq "")||($maxuploadava < 1)); if (($fileexp eq "swf")&&($flashavatar ne "yes")) { &error("不支持你所上传的图片,请重新选择!&仅支持 GIF,JPG,PNG,BMP 类型!"); } if (!defined $fileexp) { &error("不支持你所上传的图片,请重新选择!&仅支持 GIF,JPG,PNG,BMP,SWF 类型!"); } my $filesize=0; my $buffer; open (FILE,">${imagesdir}usravatars/$memberfiletitletemp.$fileexp"); binmode (FILE); while (((read($addme,$buffer,4096)))&&!(($filesize>$maxupload)&&($membercode ne "ad"))) { print FILE $buffer; $filesize=$filesize+4; } close (FILE); close ($addme); #注意 4。setforums.cgi 也是修改上传。 找到 $addme=$query->param('addme'); if ($addme ne ""){ my $up_filename =$query->uploadInfo($addme); my ($up_name,$up_ext) = split(/\./,$up_filename); $up_ext = lc($up_ext); &errorout("上传出错!不支持您所上传的图片类型,请重新选择!") if (($up_ext ne "gif") && ($up_ext ne "jpg") && ($up_ext ne "bmp")&&($up_ext ne "swf")&&($up_ext ne "png")); my $buffer; open (FILE,">$imagesdir/myimages/$up_name.$up_ext"); binmode (FILE); while ($buffer=$query->readUploadFile($addme,4096)) { print FILE $buffer; } close (FILE); if ($up_ext eq "gif"||$up_ext eq "jpg"||$up_ext eq "bmp"||$up_ext eq "jpeg"||$up_ext eq "png"||$up_ext eq "ppm"||$up_ext eq "svg"||$up_ext eq "xbm"||$up_ext eq "xpm") { my $info = image_info("${imagesdir}myimages/$up_name.$up_ext"); if ($info->{error} eq "Unrecognized file format"){ unlink ("${imagesdir}myimages/$up_name.$up_ext"); &errorout("上传出错&上传文件不是图片文件,请上传标准的图片文件!"); } undef $info; } } 共三处,全部替换成 &douppics(); 在 setforums.cgi 结尾处加上 #处理后台上传logo,By Easunlee sub douppics { #1 # $addme=$query->upload('addme'); #如果CGI.pm版本>2.47,推荐使用 $addme=$query->param('addme'); #如果CGI.pm版本<2.47,用他替换上句 return unless ($addme); my ($tmpfilename) = $addme =~ m|([^/:\\]+)$|; #注意,获取文件名字的形式变化 my @filename = split(/\./,$tmpfilename); #注意 my $up_name = $filenameΎ]; my $up_ext = $filename[-1]; $up_ext = lc($up_ext); &errorout("上传出错!不支持您所上传的图片类型,请重新选择!") if (($up_ext ne "gif") && ($up_ext ne "jpg") && ($up_ext ne "bmp")&&($up_ext ne "swf")&&($up_ext ne "png")); my $buffer; open (FILE,">$imagesdir/myimages/$up_name.$up_ext"); binmode (FILE); binmode ($addme); #注意 while (read($addme,$buffer,4096) ) {#2 print FILE $buffer; $filesize=$filesize+4; } #2 close (FILE); close ($addme); #注意 if ($up_ext eq "gif"||$up_ext eq "jpg"||$up_ext eq "bmp"||$up_ext eq "jpeg"||$up_ext eq "png"||$up_ext eq "ppm"||$up_ext eq "svg"||$up_ext eq "xbm"||$up_ext eq "xpm") { #3 my $info = image_info("${imagesdir}myimages/$up_name.$up_ext"); if ($info->{error} eq "Unrecognized file format") { unlink ("${imagesdir}myimages/$up_name.$up_ext"); &errorout("上传出错&上传文件不是图片文件,请上传标准的图片文件!"); } undef $info; } #3 } #1 5. messanger.cgi 也是上传修改 找到 $addme = $query->param("addme"); my $attach = ''; if ($addme && $allowmsgattachment ne 'no') { my $up_filename = $query->uploadInfo($addme); $up_filename =~ s/\\/\//sg; $up_filename = (split(/\//, $up_filename))[-1]; my @up_names = split(/\./, $up_filename); $up_ext = lc(pop(@up_names)); my $checkadd = 0; foreach (split(/\,\s*/, $addtype)) { $checkadd = 1, last if ($up_ext eq lc($_)); } &error("上传出错&不支持你所上传的附件类型($up_ext),请重新选择!&msg") if ($checkadd == 0); my $filesize = 0; my $bufferall = ''; while ((my $buffer = $query->readUploadFile($addme, 4096)) && $filesize < 60) { if ($up_ext eq "txt" || $up_ext eq "htm" || $up_ext eq "html" || $up_ext eq "shtml") { $buffer =~ s/\.cookie/\&\#46\;cookie/isg; $buffer =~ s/on(mouse|exit|error|click|key)/\&\#111\;n$1/isg; $buffer =~ s/script/scri\&\#112\;t/isg; $buffer =~ s/style/\&\#115\;tyle/isg; } $bufferall .= $buffer; $filesize += 4; } &error("上传出错&上传附件大小超过 60 KB,请重新选择!&msg") if (length($bufferall) > 60 * 1024); if ($up_ext eq "gif" || $up_ext eq "jpg" || $up_ext eq "bmp" || $up_ext eq "jpeg" || $up_ext eq "png" || $up_ext eq "ppm" || $up_ext eq "svg" || $up_ext eq "xbm" || $up_ext eq "xpm") { eval("use Image::Info qw(image_info);"); if ($@ eq "") { my $info = image_info(\$bufferall); &error("上传出错&上传附件不是图片文件,请上传标准的图片文件!&msg") if ($info->{error} eq "Unrecognized file format"); } } $attach = "$up_filename*#!&*" . &Base64encode($bufferall); } 改成 # $addme=$query->upload('addme'); #如果CGI.pm版本>2.47,推荐使用 $addme=$query->param('addme'); #如果CGI.pm版本<2.47,用他替换上句 my $attach = ''; if ($addme && $allowmsgattachment ne 'no') { my ($up_filename) = $addme =~ m|([^/:\\]+)$|; #注意,获取文件名字的形式变化 my @up_names = split(/\./,$up_filename); #注意 my $up_name = $up_namesΎ]; my $up_ext = $up_names[-1]; $up_ext = lc($up_ext); my $checkadd = 0; foreach (split(/\,\s*/, $addtype)) { $checkadd = 1, last if ($up_ext eq lc($_)); } &error("上传出错&不支持你所上传的附件类型($up_ext),请重新选择!&msg") if ($checkadd == 0); my $filesize = 0; my $bufferall = ''; binmode ($addme); #注意 while (read($addme,$buffer,4096) ) {#2 if ($up_ext eq "txt" || $up_ext eq "htm" || $up_ext eq "html" || $up_ext eq "shtml") { $buffer =~ s/\.cookie/\&\#46\;cookie/isg; $buffer =~ s/on(mouse|exit|error|click|key)/\&\#111\;n$1/isg; $buffer =~ s/script/scri\&\#112\;t/isg; $buffer =~ s/style/\&\#115\;tyle/isg; } $bufferall .= $buffer; $filesize += 4; } #2 close ($addme); #注意 &error("上传出错&上传附件大小超过 60 KB,请重新选择!&msg") if (length($bufferall) > 60 * 1024); if ($up_ext eq "gif" || $up_ext eq "jpg" || $up_ext eq "bmp" || $up_ext eq "jpeg" || $up_ext eq "png" || $up_ext eq "ppm" || $up_ext eq "svg" || $up_ext eq "xbm" || $up_ext eq "xpm") { eval("use Image::Info qw(image_info);"); if ($@ eq "") { my $info = image_info(\$bufferall); &error("上传出错&上传附件不是图片文件,请上传标准的图片文件!&msg") if ($info->{error} eq "Unrecognized file format"); } } $attach = "$up_filename*#!&*" . &Base64encode($bufferall); } 其他已知问题。 1。Q:为什么用了这个后网站出现500 err? A:你的网站CGI.pm太低,下载最新的CGI模块包,解压到你的LB目录就可以了(当然,如果你有服务器管理权限,可以直接升级整个服务器的CGI模块) 建议: 如果你能保证你的网站CGI.pm版本>2.47,推荐使用 $addme=$query->upload('addme'); 代替 $addme=$query->param('addme'); 来获取对use strict; 的支持。这里包括profile.cgi的一处修改:)说明 :1.仅供Hacks研究使用,免责版本:) 请先备份旧文件。 -_-bbb ]]>
[原创+发布]会员精华集 For LeoBBSx(Fixed)
tag:easun.org,2004:/perl/forum//5.1088
2004-11-22T16:05:22Z
2006-02-16T21:04:46Z
路杨
http://easun.org/cgi-bin/mymt/mt-cp.cgi?__mode=view&blog_id=5&id=1
[原创+发布]会员精华集 For LeoBBSx / By 路杨 ############################################################# # # [原创+发布]会员精华集 V.1.0 for LeoBBSx # 性质 : LeoBBSx插件 # 本插件用于显示该会员的所有精华帖子 # 程序作者:路杨(EasunLee) http://perl.easunstudio.com # http://www.leohacks.com # 版权所有,欢迎转载。但 敬请保留版权+出处 。 # #############################################################详细介绍: 1。本插件用于显示该会员的所有精华帖子 2。亦采用Leobbsx目前的cache机制,可以最大程度的降低资源占用。 3。单独程序设置,只对原jinghua.cgi做少量修改。(状态显示代码除外) 4。支持随机数据目录,安全性能有较好提升。 5。和系统cache机制精密结合,不会担心操作后的显示问题。 系统文件: 1。jhshow.cgi :会员精华集主程序,放在程序目录下。非Win32要求 755。 2。目录 jinghua (可以改成 jinghuaXXXXX目录,即加随机数。):数据目录,存放jinghua数据,在程序目录下,非Win32要求 777. 其下文件要求666 (该目录如果不存在,程序会自动建立。)安装说明: 1。上传jhshow.cgi到程序目录下,建立jinghua目录,按照上面 系统文件 说明设置属性。 2。修改 jinghua.cgi。方法如下: 打开jinghua.cgi,在其最后加上sub upjhshow { #add by Easunlee(路杨) my ($nametocheck,$thisjh,$act) = @_; # 用户名、帖子(结构f_t),加减? $nametocheck =~ s/ /\_/g; $nametocheck =~ tr/A-Z/a-z/; $nametocheck =~ s/[\a\f\n\e\0\r\t\`\~\!\@\#\$\%\^\&\*\(\)\+\=\\\{\}\;\'\:\"\,\.\/\<\>\?]//isg; &getjhshowdir() unless $jhshowdir; #if (-e ) my $file ="${lbdir}$jhshowdir/$nametocheck.cgi"; my $size= (-s $file); my $filedata =""; if ($size) { sysopen(FILE,"$file",O_RDONLY,0666) or return 0; sysseek(FILE, 0, 0); #定位 sysread(FILE, $filedata,$size); close(FILE); #$filedata=~s/[\r\n]/\n/g; $filedata=~s/\r//g; $filedata =~ s/\n{2,}/\n/isg; ##空行删除 $filedata =~ s/\n$//s; ##删除后面的\n } $filedata =$thisjh."\n".$filedata if($act eq "+"); $filedata =~ s/(^|\n)$thisjh(\n|$)/$1$3/s if($act eq "-"); &winlock($file) if ($OS_USED eq "Nt"); open(JHSHOW, ">$file"); flock(JHSHOW, 2) if ($OS_USED eq "Unix"); print JHSHOW "$filedata\n"; flock(JHSHOW, 8 ) if ($OS_USED eq "Unix"); close(JHSHOW); &winunlock("$file") if ($OS_USED eq "Nt"); unlink ("${lbdir}$jhshowdir/$nametocheck.pl"); } sub getjhshowdir { opendir (DIRS, "$lbdir"); my @files = readdir(DIRS); closedir (DIRS); my @needdir = grep(/^jinghua/i, @files); $jhshowdir = $needdirΎ]; } 找到 &sendtoposter("$inmembername","$mn","","jinghua","$fid","$tid", "$topictitle","") if (($sendmanageinfo eq "yes")&&(lc($inmembername) ne lc($mn))&&($act eq "+")); 在其后面 加上&upjhshow ($mn,"$fid\_$tid",$act); 其他程序连接修改: 可以按照喜好,自己任意在 /帖子界面 /分论坛界面 /控制面版菜单/个人资料/ 中加入连接。连接地址为 jhshow.cgi?member=XXXX (XXXX为要查看的会员名字),如果调用自己的精华集可以直接调用jhshow.cgi 比如在控制面版菜单加入,即可在打开bbs.lib.pl,找到 <div class=menuitems> <a href=delmycache.cgi title=清除我的缓存,确保个人所有资料都是最新的><font color=#000000>更新我的缓存</font></a> </div> 在这句前面 加上 <div class=menuitems> <a href=jhshow.cgi title=查看我自己的所有精华帖子><font color=#000000>我的所有精华</font></a> </div> 注意,在这句里面不要有任何换行,因为这个是js数组的要求:)其他添加办法类似,为纯粹的HTML代码。这里不做讨论。 :P 其他: 已经在某个万人级别BBS测试一周,请放心使用,有Bug及时汇报。注意。目前仅能显示安装插件以后加入的精华,以前的精华需要统计程序统计才可以。统计程序会在明天发布:) 请下载附件:)http://easun.org/upload/early/jhshow_1101290520.rar 注意。2004/11/24 17:38 fix a bug,请重新下载。 ]]>
[原创+整理]LeoBBSx多附件添加整理日志
tag:easun.org,2004:/perl/forum//5.1093
2004-10-31T18:42:47Z
2004-10-31T18:47:48Z
草草整理一下思路,如果现在再不整理,估计就遥遥无期了。第一:Hack思路。1。本Hack彻底改变原LB的附件方式,所有的附件都在帖子里面以[ uploadfile=***]方式存在。2。上传机制是在$usrfile目录下面建立tmp目录,在此目录下面以用户name分目录存临时上传的文件,可以限制每个人一次上传的个数。(目录程序自动处理)3,在帖子提交时候,[b]选择插入[/b]的附件被处理。Copy到$usr/$foumid/XX目录下面,并且在帖子里面更新文件名字。4。改革了附件都放在$usr/$foumid/根目录下面的习惯,在这个目录下面参考用户库再次分目录,使贴图区不在慢如蜗牛。(来自bbser老大的建议)5。由于存储方式改变,所以和原来上传的旧格式完全兼容(牺牲了点速度)6。全部转化中文,不建议出现中文目录和中文文件。7。js实现插入。8。没有插入帖子的存在与tmp目录下面的临时文件会在15分钟后自动删除。第二:新建文件简单介绍upfile.cgi 上传主界面,会被post.cgi等文件自动用iframe方式调用的。其中函数:sub uppic #界面函数sub doupfile #处理上传函数sub delup #删除已经上传的文件。dopost.pl 函数模块,处理获取文件/copy数据/处理帖子cache/删除帖子/移动帖子等等的文件附件处理。其中函数:sub upfileonpost #提交的时候处理临时文件到合适的地方:)更新帖子sub delupfiles #删除当前帖子全部附件(遍历帖子方式)---删除回复时候用sub delallupfiles #删除当前主贴全部附件,全部删除的时候调用(cache方式)sub moveallupfiles #移动/copy当前主贴全部附件,移动/copy的时候调用(cache方式)sub getusrdir #获取临时文件夹,基本函数,上面的函数多调用他,获取$usr/tmp/等等。也负责创建目录,删除超时临时文件。加文件上传数目限制等等,中文处理等等sub gettmpname #获取临时文件名字,也是基本函数,亦有中文处理等等第三:修改办法(废话那么多,终于正题了)...
路杨
http://easun.org/cgi-bin/mymt/mt-cp.cgi?__mode=view&blog_id=5&id=1
草草整理一下思路,如果现在再不整理,估计就遥遥无期了。 第一:Hack思路。 1。本Hack彻底改变原LB的附件方式,所有的附件都在帖子里面以[ uploadfile=***]方式存在。 2。上传机制是在$usrfile目录下面建立tmp目录,在此目录下面以用户name分目录存临时上传的文件,可以限制每个人一次上传的个数。(目录程序自动处理) 3,在帖子提交时候,[b]选择插入[/b]的附件被处理。Copy到$usr/$foumid/XX目录下面,并且在帖子里面更新文件名字。 4。改革了附件都放在$usr/$foumid/根目录下面的习惯,在这个目录下面参考用户库再次分目录,使贴图区不在慢如蜗牛。(来自bbser老大的建议) 5。由于存储方式改变,所以和原来上传的旧格式完全兼容(牺牲了点速度) 6。全部转化中文,不建议出现中文目录和中文文件。 7。js实现插入。 8。没有插入帖子的存在与tmp目录下面的临时文件会在15分钟后自动删除。 第二:新建文件简单介绍 upfile.cgi 上传主界面,会被post.cgi等文件自动用iframe方式调用的。 其中函数: sub uppic #界面函数 sub doupfile #处理上传函数 sub delup #删除已经上传的文件。 dopost.pl 函数模块,处理获取文件/copy数据/处理帖子cache/删除帖子/移动帖子等等的文件附件处理。 其中函数: sub upfileonpost #提交的时候处理临时文件到合适的地方:)更新帖子 sub delupfiles #删除当前帖子全部附件(遍历帖子方式)---删除回复时候用 sub delallupfiles #删除当前主贴全部附件,全部删除的时候调用(cache方式) sub moveallupfiles #移动/copy当前主贴全部附件,移动/copy的时候调用(cache方式) sub getusrdir #获取临时文件夹,基本函数,上面的函数多调用他,获取$usr/tmp/等等。也负责创建目录,删除超时临时文件。加文件上传数目限制等等,中文处理等等 sub gettmpname #获取临时文件名字,也是基本函数,亦有中文处理等等 第三:修改办法(废话那么多,终于正题了) ]]>
[工具+发布]LeoBBSx单附件格式升级程序第2版本。
tag:easun.org,2004:/perl/forum//5.1090
2004-10-29T14:27:37Z
2011-09-08T13:09:23Z
路杨
http://easun.org/cgi-bin/mymt/mt-cp.cgi?__mode=view&blog_id=5&id=1
############################################################# # # 附件格式升级程式 V.2.0 for LeoBBSx # 本工具用于将LEOBBS X 040702以前版本论坛附件转换为 # 多附件版本相同的格式 # 程序制作:第一版:亚 http://www.dopc.org # 第二版:路杨 http://perl.easunstudio.com ############################################################# 说明 : 本工具用于将LEOBBS X 040702以前版本论坛附件转换为多附件版本相同的格式 ,这样旧附件的兼容性问题就全部不存在了:) 使用 : 放在程序目录下。非Win32要求 755。 转化完请删除本程序或者下载。。 在2个万人bbs测试通过。没有发现BUG,但是不意味就没有BUG:)http://easun.org/upload/early/upattach_1099489827.rar ]]>
[分享]fayland原创,简单CGI留言本:)
tag:easun.org,2004:/perl/forum//5.1091
2004-10-28T22:40:19Z
2005-01-13T22:01:54Z
下面引用由fayland在 Oct 17, 2004, 8:40 PM 发表的内容:只有发帖子和删除功能。没用数据库,而是直接生成html文件。 各位有空看看,给俺点意见。演示在 http://www.1313s.com/guestbook.html 征求同意后发了过来:)原始地址 : http://www.perlchina.org/cgi-bin/gforum/gforum.cgi?post=14275 http://easun.org/upload/early/guestbook_1099060794.rar...
路杨
http://easun.org/cgi-bin/mymt/mt-cp.cgi?__mode=view&blog_id=5&id=1
下面引用由fayland 在 Oct 17, 2004, 8:40 PM 发表的内容: 只有发帖子和删除功能。 没用数据库,而是直接生成html文件。 各位有空看看,给俺点意见。 演示在 http://www.1313s.com/guestbook.html 征求同意后发了过来:) 原始地址 : http://www.perlchina.org/cgi-bin/gforum/gforum.cgi?post=14275 http://easun.org/upload/early/guestbook_1099060794.rar ]]>
[发布+工具] LeoHacks精华帖子统计程式 For LeoBBSx
tag:easun.org,2004:/perl/forum//5.1092
2004-10-22T02:26:26Z
2004-12-09T12:01:07Z
路杨
http://easun.org/cgi-bin/mymt/mt-cp.cgi?__mode=view&blog_id=5&id=1
[发布+工具] LeoHacks精华帖子统计程式 For LeoBBSx。 ############################################################# #Prime Topic Counter for LeoBBSx # #Writed by RoyRoy http://www.LeoHacks.com #Version Beta 2.17 ES Build 040606(Hacked 2004.06.07 by EasunLee) # # LeoHacks 精华帖子数目统计程式(路杨Hacked 2004.06.07) # # 原始版权 RoyRoy 修改版权 路杨(EasunLee) # 网站地址: http://www.LeoHacks.com #############################################################近来忙死了,如果这个半成品不发布,估计永无宁日。。。 没有什么说的,应朋友之要求,添加老精华帖子统计的功能,就是上次发表之LB精华帖子Hack程式中的附加工具之统计程式。 简单修改了一下,变成了LeoBBSx系列的了。 PS: 全部利用通用接口编写程序,应该比较安全。无太多之兼容问题。 老版本连接: http://www.leohacks.com/cgi-bin/leohacks/topic.cgi?forum=2&topic=485&show=25 统计方法: 关闭论坛,运行jhnocount.cgi进行统计精华数目就可以了。然后开放论坛,OK了。注意事项 : 1。请先进后台排名。这样才能保证第一步清空$jhcount之正常完成。 2。本工具只适合LeoBBSx,LB5000的请自己下载偶以前发布的版本。 3。虽然本程序会自动锁定,但是为了安全,还是请用过后删除(改名)。 4。免责任版本 ,请自己备份,无服务 :) 5。忽忽,虽然程序快完全重写了。但版权归原作RoyRoy所有 :) 6。欢迎转载,但请保留版权说明。谢谢。http://easun.org/upload/early/95_4_1098469646.rar ]]>