Я в свое время писал такой скрипт на Перле. Скрипт ниже. Ему нужен файл gibberish.ini (в директории, где thebat.exe лежит), в котором в первой строке указан каталог, куда сохранять письма.
Собственно скрипт:
Код:
# Script that should automate messagebase backup in The Bat!
# (c)2000 Alexander V. Kiselev
open IN, 'gibberish.ini' or $failed=1;
@dirinfo=<IN>;
@dirinfo[0]=~/(.*?)\n/;
$dir=$1;
if ($failed==1)
{$dir="."};
@test=<>;
$kisa=<<EOF;
@test
EOF
# print "$kisa\n\n"; #Just check;-)
$kisa=~/from:\s*"?(.*?)"?\s*\</i;
$from=$1;
if ($from=~/=\?.*?\?[QB]\?/i)
{$kisa=~/from:.*?\<(.*?)\>/i;
$from=$1;
print "8bit characters in From: detected;\n";
print " using e-mail address instead of the name.\n\n"};
if ($from eq "")
{$from="nobody"};
# print "$from\n"; #Just check;-)
$kisa=~/subject:\s*(.*?)\s*\n/i;
if ($1 ne "")
{$subj=$1}
else {$subj="nothing"};
if ($subj=~/=\?.*?\?[QB]\?/i)
{$subj="8bit subject";
print "8bit characters in the Subject: field detected;\n";
print " can do nothing about it;-(\n\n"};
$from=~tr/\:\"\*\\\|\?\/\(\)\[\]/\# _____--==/;
$subj=~tr/\:\"\*\\\|\?\/\(\)\[\]/\# _____--==/;
# print "$subj\n"; #Just check;-)
$temp=join "__","$from","$subj";
$out=join ".",$temp,"msg";
$type='msg';
chdir $dir;
@files=<*.$type>;
$kisa=<<EOFF;
@files
EOFF
$incr=1;
while ($kisa=~/$out/)
{
$out=join ".",$temp,$incr,"msg";
$incr++;
};
print "Attempting write to file $dir/$out …\n";
open OUT, ">$dir/$out" or die "Cannot open $out for write :$!";
print OUT @test;
print "Apparently, success;-))\n\n";
print "Thanx and bye.";
Есть еще одна версия скрипта, в этой второй версии скрипт просто переименовывает всё, что найдет в той директории, которую ему сказано обрабатывать. То бишь эту вторую версию к Бату прикручивать вообще не надо. Скрипт:
Код:
# Renames the NNNN.msg files in the specified directory,
# based on the From: and Subject: message headers.
if (@ARGV[1] ne "")
{
print "More then one directory specified,\n";
print "will work against the first one only.\n\n";
}
if (@ARGV[0] eq "")
{
print "No commandline parameter given:\n";
print "processing current directory.\n";
$dir='.';
}
else {
print "Processing the following directory:\n";
print "@ARGV[0]\n";
$dir=@ARGV[0];
};
chdir $dir;
$type='msg';
opendir DIR, $dir or die "Can't open directory $dir: $!\n";
open LOG, ">>bred.log" or die "cannot open log file $dir/bred.log for write";
print LOG "\n\n-------------------------------\n";
print LOG "Started: ", scalar(localtime), "\n";
print LOG "-------------------------------\n";
while ($file= readdir DIR) {
if ($file=~/^\d*\.msg/i)
{
print LOG "\n ---\n Processing $file…\n\n";
&doit ($file);
};
};
print LOG "\n\n-------------------------------\n";
print LOG "Finished: ", scalar(localtime), "\n";
print LOG "-------------------------------\n";
sub doit {
open AN, @_[0] or die "failed to open @_";
read(AN, $kisa, 2048);
# Block from the old (bad;-)) gibberish.pl
$kisa=~/from:\s*"?(.*?)"?\s*\</i;
$from=$1;
if ($from=~/=\?.*?\?[QB]\?/i)
{$kisa=~/from:.*?\<(.*?)\>/i;
$from=$1;
print LOG "8bit characters in From: detected;\n";
print LOG " using e-mail address instead of the name.\n\n"};
if ($from eq "")
{$from="nobody"};
# print "$from\n"; #Just check;-)
$kisa=~/subject:\s*(.*?)\s*\n/i;
if ($1 ne "")
{$subj=$1}
else {$subj="nothing"};
if ($subj=~/=\?.*?\?[QB]\?/i)
{$subj="8bit subject";
print LOG "8bit characters in the Subject: field detected;\n";
print LOG " can do nothing about it;-(\n\n"};
$from=~tr/\:\"\*\\\|\?\/\(\)\[\]/\# _____--==/;
$subj=~tr/\:\"\*\\\|\?\/\(\)\[\]/\# _____--==/;
# print "$subj\n"; #Just check;-)
$temp=join "__","$from","$subj";
$out=join ".",$temp,"msg";
# print $out;
@files=<*.$type>;
$kisa=<<EOFF;
@files
EOFF
$incr=1;
while ($kisa=~/$out/)
{
$out=join ".",$temp,$incr,"msg";
$incr++;
};
print LOG "Attempting to rename $file to:\n";
print LOG " $out …\n";
$out=join "","\"",$out,"\"";
close AN;
system("ren $file $out");
if ($?==0) {
print LOG "Apparently, success;-)\n";
}
else {
print LOG "Shit happened, rename unsuccessful;-(\n"
};
};
