Windows Management and Scripting

A wealth of tutorials Windows Operating Systems SQL Server and Azure

Archive for the ‘Perl’ Category

Script to list all global and local groups on a given server

Posted by Alin D on August 2, 2011

Used to list all global and local groups on a given server.

Usage: $script /[s]erver /[g]lobal /[l]ocal /[v]erbose

/server Name of server for which to list all groups.
Server can be a domain controller. If no server
is specified, this defaults to localhost.
/global List only global groups.
/local List only local groups.
/verbose Show group comments.
/help Displays this help message.
use Getopt::Long;
use diagnostics;
use strict;
use Win32::Console;
use Win32::Lanman;

##################
# main procedure #
##################
my (%config);

p_parsecmdline(%config, @ARGV);
p_checkargs();

# set console codepage
Win32::Console::OutputCP(1252);

if ($config{global}) {
p_listglobalgroups($config{server});
} elsif ($config{local}) {
p_listlocalgroups($config{server});
} else {
p_listglobalgroups($config{server});
p_listlocalgroups($config{server});
}

exit 0;

##################
# sub-procedures #
##################

# procedure p_help
# displays a help message
sub p_help {
my ($script)=($0=~/([^\/]*?)$/);
my ($header)=$script." v1.1 - Author: alin@keptprivate.com";
my ($line)="-" x length($header);
print < <EOT;

$header
$line
Used to list all global and local groups on a given server.

Usage: $script /[s]erver /[g]lobal /[l]ocal /[v]erbose

/server Name of server for which to list all groups.
Server can be a domain controller. If no server
is specified, this defaults to localhost.
/global List only global groups.
/local List only local groups.
/verbose Show group comments.
/help Displays this help message.
EOT

exit 1;
}
# procedure p_parsecmdline
# parses the command line and retrieves arguments values
sub p_parsecmdline {
my ($config) = @_;
Getopt::Long::Configure("prefix_pattern=(-|/)");
GetOptions($config, qw(
server|s=s
global|g
local|l
verbose|v
help|?|h));
}
# procedure p_checkargs
# checks the arguments which have been used are a valid combination
sub p_checkargs {
p_help() if defined($config{help});
if (!$config{server}) {
$config{server} = Win32::NodeName();
}
}
# procedure p_listglobalgroups
# lists all global groups on a given server
sub p_listglobalgroups {
my $server = shift;
$server =~ s/\//g;
my (@groups,$group);
my ($header)="Global groups on '\\$server':";
my ($line)="-" x length($header);

if (!$config{verbose}) {
print "n$headern$linen";
}
if (Win32::Lanman::NetGroupEnum("\\$server",@groups)) {
foreach $group (sort (@groups)) {
next if (${$group}{name} eq "None");
if ($config{verbose}) {
$~ = 'GLOBAL';
write;
} else {
print "${$group}{name}n";
}
}
} else {
print "ERROR: ".Win32::FormatMessage(Win32::Lanman::GetLastError());
}

format GLOBAL_TOP =
Group Name Comment Type
--------------------------------- ---------------------------------- -------
.
format GLOBAL =
@< <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< global
${$group}{name},${$group}{comment}
~~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
${$group}{comment}
.

}
# procedure p_listlocalgroups
# lists all local groups on a given server
sub p_listlocalgroups {
my $server = shift;
$server =~ s/\//g;
my (@groups,$group);
my ($header)="Local groups on '\\$server':";
my ($line)="-" x length($header);

if (!$config{verbose}) {
print "n$headern$linen";
}
if (Win32::Lanman::NetLocalGroupEnum("\\$server",@groups)) {
foreach $group (sort (@groups)) {
if ($config{verbose}) {
$~ = 'LOCAL';
write;
} else {
print "${$group}{name}n";
}
}
} else {
print "ERROR: ".Win32::FormatMessage(Win32::Lanman::GetLastError());
}

format LOCAL_TOP =
Group Name Comment Type
--------------------------------- ---------------------------------- -------
.
format LOCAL =
@<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< local
${$group}{name},${$group}{comment}
~~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
${$group}{comment}
.

}

About these ads

Posted in Perl | Tagged: , , , , | Leave a Comment »

Script to display local and global groups only in the ACL of a specified share

Posted by Alin D on August 2, 2011

Used to display local and global groups only in the ACL of a specified share, this script has been  designed to facilitate the UAR process. Only groups are shown so that the admin may get an idea
 of what group a user should belong to in order to have specific rights on a share.

 Usage: $script /[s]hare <UNC path> /[v]erbose /[h]elp

        /share      UNC path to the share (exp: \\server1\share1)
        /verbose    Show all groups in NTFS permissions
        /help       Displays this help message

use Getopt::Long;
#use diagnostics;
#use strict;
use Win32::Console;

use Win32;
use Win32::Lanman;
use Array::Compare;
use Win32::NetAdmin;
use Win32::Perms;

##################
# main procedure #
##################
my (%config);

sub_parseCmdLine(%config, @ARGV);
sub_checkArgs();

# set console codepage
Win32::Console::OutputCP(1252);

########################
### INSERT CODE HERE ###

my @array = split(/\+/,$config{share});
my $server = $array[1];
my $share = $array[2];
my $localhost = Win32::NodeName();

# step 1: retrieve share permissions
my %sharePerm = sub_listACL($config{share});
if ($sharePerm{Everyone} ne “Full Control”) {
print “n”;
print “##############################################################n”;
print “WARNING: Everyone group does not have Full Control permission!n”;
print “##############################################################n”;
}

# step 2: retrieve share full path
my $sharePath = sub_getShareInfo($server,$share);
my $savedSharePath = $sharePath;
$sharePath =~ s/:/$/;
$sharePath = “\\”.$server.”\”.$sharePath;

# step 3: retrieve NTFS permissions
my %ntfsPerm = sub_listACL($sharePath);

# print header
print “n”;
print “Hostname: $servern”;
print “Share Name: $sharen”;
print “Share Path: $savedSharePathn”;

my $account;

# print share permissions
print “n”;
print “Share permissions:n”;
print “——————n”;

foreach $account (sort(keys %sharePerm)) {
$permission = $sharePerm{$account};
$~ = ‘Permissions';
write;
}

# delete common user groups from NTFS permission list
# if verbose option has not been specified
my $count = 0;
unless ($config{verbose}) {
foreach my $key (keys %ntfsPerm) {
if ($key =~ /administrators|domain admins|creator owner|system|server operators|backup operators|power users/i) {
delete $ntfsPerm{$key};
++$count;
}
}
}

# print NTFS permissions
print “n”;
print “NTFS permissions:n”;
print “—————–n”;

foreach $account (sort(keys %ntfsPerm)) {

# find out who can determine the account type for us
my $authority = “”;
my @array = split(/\/,$account);
if (@array > 1) {
unless ($array[0] =~ /builtin|$server|nt authority/i) {
# determine who is the PDC of the account’s domain
Win32::NetAdmin::GetDomainController(“\\$localhost”,$array[0],$authority);
$authority =~ s/\//g;
} else {
$authority = $server;
}
} else {
$authority = $server;
}

# determine if $account is a user, a local group, or a global group
my $accountType = “”;
my @members;
if (@array < 2) { $array[1] = $array[0]; } if (Win32::NetAdmin::GroupGetMembers($authority,$array[1],@members)) { $accountType = “global group”; } elsif (Win32::NetAdmin::LocalGroupGetMembersWithDomain($authority,$array[1],@members)) { $accountType = “local group”; } else { $accountType = “user”; ++$count; } # display permission for $account $permission = $ntfsPerm{$account}; if (($config{verbose}) or ($accountType ne “user”)) { $~ = ‘Permissions'; write; } # if $account is a local group, then display members if ($accountType eq “local group”) { foreach my $entry (@members) { # determine account type $authority = “”; @array = split(/\/,$entry); if (@array > 1) {
unless ($array[0] =~ /builtin|$server|nt authority/i) {
# determine who is the PDC of the account’s domain
Win32::NetAdmin::GetDomainController(“\\$localhost”,$array[0],$authority);
$authority =~ s/\//g;
} else {
$authority = $server;
}
} else {
$authority = $server;
}
$accountType = “”;
my @phonyMembers;
if (@array < 2) { $array[1] = $array[0]; } if (Win32::NetAdmin::GroupGetMembers($authority,$array[1],@phonyMembers)) { $accountType = “global group”; } else { $accountType = “user”; } # exclude users if (($config{verbose}) or ($accountType ne “user”)) { print “t$entryn”; } } } } # show if any groups have been excluded if (($count > 0) and (!$config{verbose})) {
print “nNumber of entries excluded from NTFS permissions: $countn”;
print “Use /verbose option to view all users and groups.n”;
}

# FORMATS
format Permissions =
^<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<
$account,$permission
~~ ^<<<<<<<<<<<<<<<<<<<<<<<<<
$account
.

### CODE ENDS HERE ###
########################

exit 0;

##################
# sub-procedures #
##################

# procedure sub_help
# displays a help message
sub sub_help {
my ($script)=($0=~/([^\/]*?)$/);
my ($header)=$script.” v1.1.2 – Author: alin.dumenica@siemens.com – October 2007″;
my ($line)=”-” x length($header);
print <

$header
$line
Used to display local and global groups only in the ACL of a specified share, this script has been
designed to facilitate the UAR process. Only groups are shown so that the admin may get an idea
of what group a user should belong to in order to have specific rights on a share.

Usage: $script /[s]hare/[v]erbose /[h]elp

/share UNC path to the share (exp: \\server1\share1)
/verbose Show all groups in NTFS permissions
/help Displays this help message
EOT

exit 1;
}
# procedure sub_parseCmdLine
# parses the command line and retrieves arguments values
sub sub_parseCmdLine {
my ($config) = @_;
Getopt::Long::Configure(“prefix_pattern=(-|/)”);
GetOptions($config, qw(
share|s=s
verbose|v
help|?|h));
}
# procedure sub_checkArgs
# checks the arguments which have been used are a valid combination
sub sub_checkArgs {
sub_help() if defined($config{help});
sub_help() if !defined($config{share});
unless ($config{share} =~ /z\/) {
$config{share} .= “\”;
}
}
# procedure sub_listACL
# lists an ACL
sub sub_listACL {
no strict ‘refs';

my $targetobject = shift;
my $targetSD;
unless ($targetSD = new Win32::Perms($targetobject)) {
print “ERROR: $^En”;
exit 2;
}
my (@perms,@ACL,%ACLhash);
my $comp = Array::Compare->new;

# define reference arrays for friendly NTFS permissions
my @read = qw(
READ_CONTROL
SYNCHRONIZE
FILE_READ_EA
FILE_EXECUTE
FILE_READ_ATTRIBUTES);
my @readNT4 = qw(
GENERIC_EXECUTE
GENERIC_READ);
my @change = qw (
DELETE
READ_CONTROL
SYNCHRONIZE
FILE_READ_EA
FILE_WRITE_EA
FILE_EXECUTE
FILE_READ_ATTRIBUTES
FILE_WRITE_ATTRIBUTES);
my @changeNT4 = qw (
DELETE
GENERIC_EXECUTE
GENERIC_WRITE
GENERIC_READ);
my @full = qw (
STANDARD_RIGHTS_ALL
FILE_READ_EA
FILE_WRITE_EA
FILE_EXECUTE
FILE_DELETE_CHILD
FILE_READ_ATTRIBUTES
FILE_WRITE_ATTRIBUTES);
my @fullNT4 = qw (
GENERIC_ALL);
my @write = qw (
READ_CONTROL
SYNCHRONIZE
FILE_READ_EA
FILE_WRITE_EA
FILE_EXECUTE
FILE_READ_ATTRIBUTES
FILE_WRITE_ATTRIBUTES);

# define reference arrays for user friendly share permissions
my @shareRead = qw (
FILE_SHARE_READ
READ_CONTROL
SYNCHRONIZE
FILE_READ_EA
FILE_EXECUTE
FILE_READ_ATTRIBUTES);
my @shareChange = qw (
FILE_SHARE_READ
FILE_SHARE_WRITE
FILE_SHARE_DELETE
DELETE
READ_CONTROL
SYNCHRONIZE
FILE_READ_EA
FILE_WRITE_EA
FILE_EXECUTE
FILE_READ_ATTRIBUTES
FILE_WRITE_ATTRIBUTES);
my @shareFullControl = qw (
FILE_SHARE_READ
FILE_SHARE_WRITE
FILE_SHARE_DELETE
STANDARD_RIGHTS_ALL
FILE_READ_EA
FILE_WRITE_EA
FILE_EXECUTE
FILE_DELETE_CHILD
FILE_READ_ATTRIBUTES
FILE_WRITE_ATTRIBUTES);

# retrieve all ACLs (DACL and SACL) for target object
unless ($targetSD->Get(@ACL)) {
print “ERROR: Could not retrieve ACL on $targetobject: $^En”;
exit 2;
}
# process each entry in all ACLs of target object
foreach my $ACE (@ACL) {
# ignore entry if it is not a DACL
next unless (“DACL” eq $ACE->{Entry});
my $account=””;
# format user name in ACE with domain name or if it can’t be resolved, show SID
if (“” eq $ACE->{Account}) {
my $machine;
my $domain;
my @targetobject;
my $SID;
my $binSID;
my $sidtype;
if ($targetobject =~ /\\/) {
#extract machine name
@targetobject = split (/\/,$targetobject);
$machine = $targetobject[2];
} else {
$machine = “”;
}
$SID = $ACE->{SID};
$binSID = Win32::Lanman::StringToSid($SID) or die “ERROR: $^En”;
unless (Win32::LookupAccountSID($machine,$binSID,$account,$domain,$sidtype)) {
$account = $SID;
} else {
my $useraccount = (“” ne $domain)? “$domain\”:””;
$account = $useraccount.$account;
}
} else {
my $useraccount = (“” ne $ACE->{Domain})? “$ACE->{Domain}\”:””;
$account .= $useraccount.$ACE->{Account};
}
Win32::Perms::DecodeMask($ACE,@perms);

# create user name reference if it does not exist yet
if (!defined $ACLhash{$account}) {
# creating unique array based on user name
# this is because @perms will be overwritten next time we go into the loop
@$account = @perms;
$ACLhash{$account} = @$account;
}
# compare current ACE list to reference friendly permissions ACLs
if (($comp->compare(@perms,@read)) or ($comp->compare(@perms,@readNT4)) or ($comp->compare(@perms,@shareRead))) {
$ACLhash{$account} = “Read”;
} elsif (($comp->compare(@perms,@change)) or ($comp->compare(@perms,@changeNT4)) or ($comp->compare(@perms,@shareChange))) {
$ACLhash{$account} = “Change”;
} elsif (($comp->compare(@perms,@full)) or ($comp->compare(@perms,@fullNT4)) or ($comp->compare(@perms,@shareFullControl))) {
$ACLhash{$account} = “Full Control”;
} elsif ($comp->compare(@perms,@write)) {
$ACLhash{$account} = “Write”;
} else {
$ACLhash{$account} = “Special”;
}
}
return %ACLhash;
}
# procedure sub_getShareInfo
# retrieves full path information for a given share
sub sub_getShareInfo {
my ($server,$share) = @_;
my %shareInfo;

unless (Win32::Lanman::NetShareGetInfo(“\\$server”,$share,%shareInfo)) {
my $error = Win32::FormatMessage(Win32::Lanman::GetLastError());
print “ERROR:NetShareGetInfo:$errorn”;
}
return $shareInfo{‘path’};
}

Posted in Perl | Tagged: , , , | Leave a Comment »

Perl Script to move members of a group to a specified organizational unit – ADSI.MoveMembers.pl

Posted by Alin D on August 2, 2011

Used to move members of a group to a specified organizational unit.  Only users are moved.
 RDN names of group and OU are automatically retrieved using an LDAP query.

 Usage: $script /[d]omain <fqdn> /[g]roup <group name> /[o]u <ou name> /help

        /domain     FQDN DNS name of the Active Directory domain where the group
                    resides. Default domain is "ww300.siemens.net"
        /group      Name of group whose members must be moved.
        /ou         Target organizational unit where group members must be moved to.
        /help       Displays this help message.

    Example: $script /d mydomain.local /g "Marketing Group" /o "Marketing OU"

use Getopt::Long;
#use diagnostics;
#use strict;
use Win32::Console;
use Win32::OLE 'in';

##################
# main procedure #
##################
my (%config);

sub_parseCmdLine(%config, @ARGV);
sub_checkArgs();

# set console codepage
Win32::Console::OutputCP(1252);

########################
### INSERT CODE HERE ###

#connect to Active Directory
my $adsPath=”LDAP://$config{domain}”;
my $adsObject = Win32::OLE->GetObject($adsPath);
die “ERROR: binding to Active Directory:n “,Win32::OLE->LastError() if Win32::OLE->LastError( );

unless (eval {my $enobj = Win32::OLE::Enum->new($adsObject)}) {
print “ERROR: $adsPath is not a container objectn”;
exit 1;
}

#search for the group LDAP/ads path
my $groupAdsPath = sub_searchAD(“Group”,$config{group},$adsPath);

#search for the organizational unit LDAP/ads path
my $ouAdsPath = sub_searchAD(“OrganizationalUnit”,$config{ou},$adsPath);

#retrieve group members, move only users to the target OU
my $groupObject = Win32::OLE->GetObject($groupAdsPath);
die “ERROR: binding to group:n “,Win32::OLE->LastError() if Win32::OLE->LastError( );

my $ouObject = Win32::OLE->GetObject($ouAdsPath);
die “ERROR: binding to organizational unit:n “,Win32::OLE->LastError() if Win32::OLE->LastError( );

my $members = $groupObject->Members();
foreach my $member (in $members) {
if ($member->{Class} eq “user”) {
if ($ouObject->MoveHere(“$member->{AdsPath}”,”$member->{Name}”)) {
print ” Moved $member->{Name} to $config{ou}n”;
} else {
print “ERROR: moving $member->{Name}:n “,Win32::OLE->LastError();
}
}
}

### CODE ENDS HERE ###
########################

exit 0;

##################
# sub-procedures #
##################

# procedure sub_help
# displays a help message
sub sub_help {
my ($script)=($0=~/([^\/]*?)$/);
my ($header)=$script.” v1.0 – Author: alin.dumenica@siemens.com – November 2007″;
my ($line)=”-” x length($header);
print <

$header
$line
Used to move members of a group to a specified organizational unit. Only users are moved.
RDN names of group and OU are automatically retrieved using an LDAP query.

Usage: $script /[d]omain/[g]roup/[o]u/help

/domain FQDN DNS name of the Active Directory domain where the group
resides. Default domain is “ww300.siemens.net”
/group Name of group whose members must be moved.
/ou Target organizational unit where group members must be moved to.
/help Displays this help message.

Example: $script /d mydomain.local /g “Marketing Group” /o “Marketing OU”
EOT

exit 1;
}
# procedure sub_parseCmdLine
# parses the command line and retrieves arguments values
sub sub_parseCmdLine {
my ($config) = @_;
Getopt::Long::Configure(“prefix_pattern=(-|/)”);
GetOptions($config, qw(
domain|d=s
group|g=s
ou|o=s
help|?|h));
}
# procedure sub_checkArgs
# checks the arguments which have been used are a valid combination
sub sub_checkArgs {
sub_help() if defined($config{help});
$config{domain} = ‘europe1.ds.honeywell.com’ if !defined($config{domain});
sub_help() if !defined($config{group});
sub_help() if !defined($config{ou});
}
# procedure sub_searchAD
# searches for an AD object and returns the ads path for that object
sub sub_searchAD {
my ($objectClass,$objectName,$adsPathParam) = @_;
my $objectAdsPath;

# get ADO object, set the provider, open the connection
my $adoObject = Win32::OLE->new(“ADODB.Connection”);
$adoObject->{Provider} = “ADsDSOObject”;
$adoObject->Open(“ADSI Provider”);
die Win32::OLE->LastError() if Win32::OLE->LastError( );

# prepare command for query (necessary to set properties)
my $adoCommand = Win32::OLE->new(“ADODB.Command”);
die Win32::OLE->LastError() if Win32::OLE->LastError( );
$adoCommand->{ActiveConnection} = $adoObject;
$adoCommand->{Properties}->{“Page Size”} = 1000;
$adoCommand->{CommandText} = “;(objectClass=$objectClass);Name,AdsPath;SubTree”;

#prepare and then execute the query
my $query = $adoCommand->Execute(“;(objectClass=$objectClass);Name,AdsPath;SubTree”);
die Win32::OLE->LastError() if Win32::OLE->LastError( );

#retrieve the ads path
until ($query->EOF){
if ($query->Fields(0)->{Value} eq $objectName) {
$objectAdsPath = $query->Fields(1)->{Value};
$query->Close;
$adoObject->Close;
return $objectAdsPath;
}
$query->MoveNext;
}

$query->Close;
$adoObject->Close;

return $objectAdsPath;
}

Posted in Perl | Tagged: , , , , , , | Leave a Comment »

view membership of a group – ListGoupMembers.pl

Posted by Alin D on May 12, 2011

Used to view membership of a group.

Usage: $script /s[server] /g[roup]

/server Remote server name. By default, this is the
localhost.
/group Name of group to view.
use Getopt::Long;
#use diagnostics;
#use strict;
use Win32::Lanman;
use Win32::NetAdmin;
use Win32;
use Win32::AdminMisc;
use Win32::Console;

##################
# main procedure #
##################
my (%config);

p_parsecmdline(%config, @ARGV);
p_checkargs();

# set console codepage
Win32::Console::OutputCP(1252);

p_viewgroup($config{server},$config{group});

##################
# sub-procedures #
##################

# procedure p_help
# displays a help message
sub p_help {
my ($script)=($0=~/([^\/]*?)$/);
my ($header)=$script.” v2.1 – Author: alin.dumenica@siemens.com – June 2007″;
my ($line)=”-” x length($header);
print < <EOT;

$header
$line
Used to view membership of a group.

Usage: $script /s[server] /g[roup]

/server Remote server name. By default, this is the
localhost.
/group Name of group to view.
EOT

exit 1;
}
# procedure p_parsecmdline
# parses the command line and retrieves arguments values
sub p_parsecmdline {
my ($config) = @_;
Getopt::Long::Configure(“prefix_pattern=(-|/)”);
GetOptions($config, qw(
server|s=s
group|g=s
global
help|?|h));
}
# procedure p_checkargs
# checks the arguments which have been used are a valid combination
sub p_checkargs {
if ($config{help}) {
p_help();
}
unless ($config{group}) {
p_help();
}
if (!$config{server}) {
$config{server} = Win32::NodeName();
}
}
# procedure p_viewgroup
# adds a local group on target server
sub p_viewgroup {
my ($server,$group) = @_;
my (@members,$user,%info,%attribs);
my $scope = “unknown”;

if (Win32::NetAdmin::GroupGetMembers($server,$group,@members)) {
Win32::Lanman::NetServerGetInfo(“\\$server”, %info, 1);
print “nGroup membership for global group ‘$info{domain}\$group':nn”;
$scope = “global”;
} elsif (Win32::NetAdmin::LocalGroupGetMembersWithDomain($server,$group,@members)) {
print “nGroup membership for local group ‘$server\$group':nn”;
$scope = “local”;
} else {
print “ERROR: “.Win32::FormatMessage(Win32::NetAdmin::GetError());
exit 1;
}

if ($scope eq “global”) {
foreach $user (@members) {
# retrieve user’s full name
Win32::AdminMisc::UserGetMiscAttributes(“\\$server”,$user,%attribs);
$~ = ‘REPORT';
write;
}
} elsif ($scope eq “local”) {
foreach $user (@members) {
# get the user’s domain
my @user = split(/\/,$user);
# if user is not local to the server, then get the domain’s PDC, then retrieve user’s full name
unless ((lc ($user[0]) eq lc ($server)) or ($user[0] eq “BUILTIN”)) {
my $pdc;
if (Win32::NetAdmin::GetDomainController(“\\$server”,$user[0],$pdc)) {
$pdc =~ s/\//g;
Win32::AdminMisc::UserGetMiscAttributes(“\\$pdc”,$user[1],%attribs);
}
$~ = ‘REPORT';
write;
} else {
Win32::AdminMisc::UserGetMiscAttributes(“\\$server”,$user[1],%attribs);
$~ = ‘REPORT';
write;
}
}
}
format REPORT_TOP =
User Name Full Name
——————————— ———————————-
.
format REPORT =
@<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$user,$attribs{USER_FULL_NAME}
.

}

Posted in Perl | Tagged: , , , | Leave a Comment »

Clean Drive Script -CleanDrive.pl

Posted by Alin D on May 12, 2011

use Getopt::Long;
#use diagnostics;
#use strict;
use Win32::Console;
use File::Find;
use Cwd;
use Win32::API::Prototype;

##################
# main procedure #
##################
my (%config);
my ($files,$dirs);
my ($totalsize) = 0;

p_parsecmdline(%config, @ARGV);
p_checkargs();

# set console codepage
Win32::Console::OutputCP(1252);

# check drive is valid
my $drive = $config{drive};
$drive =~ s/W+//;
$drive .= “:\”;
if (! -d $drive) {
die “ERROR: $drive is not a valid drive”;
}
# compute log file name if it hasn’t been specified
unless (defined ($config{log})) {
my $time = time();
$time = localtime($time);
my @time = split(/s+/,$time);
$config{log} = “cleandrive-$time[4]$time[1]$time[2].log”;
}
unless ($config{log} =~ /\/) {
my $cwd = getcwd;
unless ($cwd =~ //$/) {
$cwd .= “/”;
}
$config{log} = “$cwd$config{log}”;
}
# delete temp dirs content and dump files
p_cleantemp($config{drive});
p_cleandumps($config{drive});
# apply ntfs compression
if (defined ($config{compress})) {
p_compressfolders($config{drive},$config{compress});
}
# process files to delete
if (defined ($config{filelist})) {
p_delfiles($config{drive},$config{filelist});
}
# print summary of what was done
if (defined ($files) and defined ($dirs)) {
if (defined ($config{test})) {
print “n$files files and $dirs directories would have been deleted.n”;
} else {
print “n$files files and $dirs directories were deleted.n”;
}

my $TotalSizeUnit = “bytes”;
my $count = 0;
while ($totalsize > 1024) {
$totalsize = $totalsize / 1024;
++$count;
}
if ($count == 1) {
$TotalSizeUnit = “KB”;
} elsif ($count == 2) {
$TotalSizeUnit = “MB”;
} elsif ($count == 3) {
$TotalSizeUnit = “GB”;
} elsif ($count == 4) {
$TotalSizeUnit = “TB”;
} elsif ($count == 5) {
$TotalSizeUnit = “PB”;
}

print “Total space saved: “;
printf (“%.2f”,$totalsize);
print ” $TotalSizeUnit.n”;
my $logpath = $config{log};
$logpath =~ s///\/g;
print “Log file is $logpathn”;
} else {
print “nThere were no files or directories to process.n”;
}

my $LocalHost = Win32::NodeName();
p_getfreespace($LocalHost,$config{drive});

exit (0);

##################
# sub-procedures #
##################

# procedure p_help
# displays a help message
sub p_help {
my ($script)=($0=~/([^\/]*?)$/);
my ($header)=$script.” v1.3.1 – Author: alin.dumenica@gmail.com”;
my ($line)=”-” x length($header);
print < <EOT;

$header
$line
Used to clean a logical drive. This script deletes temporary files,
kernel and user memory dumps as well as internet temporary files.
Optionally, it can also compress log directories and/or delete a
list of specified files and/or directories.

Usage: $script /[d]rive /[l]og
/[c]ompress /[f]ilelist
/[t]est /[v]erbose /[h]elp

/drive Logical drive letter to clean.
/log Name of logfile (default is cleandrive-YYYYmonthDD.log).
/compress Use NTFS compression on specified path (e.g. c:\temp).
A file containing a list of paths can also be specified.
File contains one entry per line.
/filelist Name of a file containing a list of files or
directories to delete (example of entry in file is
c:\temp; file contains one entry per line; wildcard
* can be used to specify that line applies to all drives).
/test Do not delete any files, but only log what would
be done.
/verbose Shows what is being done as it is being done.
/help Shows this help message.
EOT

exit 1;
}
# procedure p_parsecmdline
# parses the command line and retrieves arguments values
sub p_parsecmdline {
my ($config) = @_;
Getopt::Long::Configure(“prefix_pattern=(-|/)”);
GetOptions($config, qw(
drive|d=s
log|l=s
compress|c=s
filelist|f=s
test|t
verbose|v
help|?|h));
}
# procedure p_checkargs
# checks the arguments which have been used are a valid combination
sub p_checkargs {
if ($config{help}) {
p_help();
}
unless (defined ($config{drive})) {
p_help();
}
}
# procedure p_cleantemp
# deletes content of temporary directories
sub p_cleantemp {
my $drive = shift;
# strip drive letter of all non alpha-numeric characters
$drive =~ s/W+//;
my @temp;

# populate array @temp of temporary directories on $drive
if ((-d “$drive:/temp”) and (“$drive:\temp” ne lc($ENV{TEMP})) and (“$drive:\temp” ne lc($ENV{TMP}))) {
push (@temp,”$drive:/temp”);
}
if ((-d “$drive:/tmp”) and (“$drive:\tmp” ne lc($ENV{TEMP})) and (“$drive:\tmp” ne lc($ENV{TMP}))) {
push (@temp,”$drive:/tmp”);
}
# add environment variables that define temporary directories,
# only if they are located on $drive
if ($ENV{TEMP} =~ /^$drive/i) {
my $temp = $ENV{TEMP};
$temp =~ s/\///g;
push (@temp,$temp);
}
if (($ENV{TMP} =~ /^$drive/i) and (lc($ENV{TMP}) ne lc($ENV{TEMP}))) {
my $tmp = $ENV{TMP};
$tmp =~ s/\///g;
push (@temp,$tmp);
}

foreach my $dir (@temp) {
my $FormattedDir = $dir;
$FormattedDir =~ s///\/g;
print “n Processing ‘$FormattedDir’ directory” if defined ($config{verbose});
finddepth (&p_del, “$dir”);
}

# determine if $drive is the system drive, in which case process user profiles temp directories
if (lc($ENV{SYSTEMDRIVE}) eq lc(“$drive:”)) {
my @profiles = (“$ENV{SYSTEMROOT}\Profiles”,”$drive:\Documents and Settings”);
foreach my $dir (@profiles) {
if (-d $dir) {
opendir (PROFILES, $dir) or next;
while (my $folder = readdir(PROFILES)) {
if (($folder eq “.”) or ($folder eq “..”)) {
next;
}
my $path = “$dir\$folder”;
if (-d “$path\Local Settings\temp”) {
print “n Processing ‘$path\Local Settings\temp’ directory” if defined ($config{verbose});
finddepth (&p_del, “$path\Local Settings\temp”);
}
if (-d “$path\Local Settings\Temporary Internet Files”) {
print “n Processing ‘$path\Local Settings\Temporary Internet Files’ directory” if defined ($config{verbose});
finddepth (&p_del, “$path\Local Settings\Temporary Internet Files”);
}
}
closedir (PROFILES);
}
}
# process SYSTEMROOTtemp if it exists
if (-d “$ENV{SYSTEMROOT}\temp”) {
my $path = “$ENV{SYSTEMROOT}\temp”;
print “n Processing ‘$path’ directory” if defined ($config{verbose});
finddepth (&p_del, “$path”);
}
}
}
# procedure p_cleandumps
# deletes kernel and user memory dumps
sub p_cleandumps {
my $drive = shift;
$drive =~ s/W+//;
# search logical drive for memory.dmp and user.dmp files and delete them
if (lc($ENV{SYSTEMDRIVE}) eq lc(“$drive:”)) {
# test for memory.dmp and delete it if it is 5 days or older only
if (-f “$ENV{SYSTEMROOT}\memory.dmp”) {
open (FILE, “$ENV{SYSTEMROOT}\memory.dmp”);
my @filestat = stat(FILE);
my $time = time();
my $seconds = $time – $filestat[9];
if ($seconds > 432000) {
print “n Processing $ENV{SYSTEMROOT}\memory.dmp” if defined ($config{verbose});
if (defined ($config{test})) {
p_log($config{log},”File $ENV{SYSTEMROOT}\memory.dmp would have been deleted.n”);
++$files;
$totalsize += $filestat[7];
} elsif (unlink (“$ENV{SYSTEMROOT}\memory.dmp”)) {
p_log($config{log},”File $ENV{SYSTEMROOT}\memory.dmp was deleted.n”);
++$files;
$totalsize += $filestat[7];
}
}
close (FILE);
}
if (-d “$ENV{SYSTEMROOT}\Minidump”) {
print “n Processing the ‘$ENV{SYSTEMROOT}\Minidump’ directory” if defined ($config{verbose});
opendir (MINIDUMP, “$ENV{SYSTEMROOT}\Minidump”);
while (my $file = readdir(MINIDUMP)) {
# delete mini dumps that are older than 5 days
next if (($file eq “.”) or ($file eq “..”));
my $path = “$ENV{SYSTEMROOT}\Minidump”;
if (-f “$path\$file”) {
my @filestat = stat(FILE);
my $time = time();
my $seconds = $time – $filestat[9];
if ($seconds > 432000) {
if (defined ($config{test})) {
p_log($config{log},”File $path\$file would have been deleted.n”);
++$files;
$totalsize += $filestat[7];
} elsif (unlink (“$path\$file”)) {
p_log($config{log},”File $path\$file was deleted.n”);
++$files;
$totalsize += $filestat[7];
}
}
}
}
closedir (MINIDUMP);
}
}
}
# procedure p_compressfolders
# applies NTFS compression to path(s)
sub p_compressfolders {
my ($drive,$folders) = @_;
my (@folderlist);
$drive =~ s/W+//;
# determine if a filename has been specified, if so, then call sub p_readfile
if (-f $folders) {
@folderlist = p_readfile($folders);
} else {
@folderlist = $folders;
}
print “n Applying NTFS compression” if defined ($config{verbose});
# for each entry in the array, apply NTFS compression after making sure the path is valid
# and that the path is on the drive being cleaned
foreach my $file (@folderlist) {
$file =~ s/^*:/$drive:/i;
if ((-d “$file”) and ($file =~ /^$drive:/i)) {
print “.” if defined ($config{verbose});
if (defined ($config{test})) {
p_log($config{log},”Would have attempted to NTFS compress $filen”);
} else {
`compact /C /S /I $file`;
p_log($config{log},”Attempted to NTFS compress $filen”);
}
}
}
}
# procedure p_readfile
# reads the content of a file into an array
sub p_readfile {
my $file = shift;
my (@list);
# open handle to the file
open (FILE,$file);
my $i = 0;
while (defined (my $entry = )) {
chomp ($entry);
$list[$i] = $entry;
++$i;
}
return (@list);
}
# procedure p_delfiles
# delete specified files
sub p_delfiles {
my ($drive,$files) = @_;
my (@filelist);
$drive =~ s/W+//;
# call sub p_readfile
if (-f $files) {
@filelist = p_readfile($files);
print “n Processing entries in ‘$files'” if defined ($config{verbose});
# for each element in the array, delete the file or directory
foreach my $file (@filelist) {
$file =~ s/^*:/$drive:/i;
if ((-d $file) and ($file =~ /^$drive:/i)) {
finddepth (&p_del, “$file”);
} elsif ((-f $file) and ($file =~ /^$drive:/i)) {
print “.” if defined ($config{verbose});
open (FILE,”$file”);
my @filestat = stat(FILE);
close (FILE);
if (defined ($config{test})) {
p_log($config{log},”File $file would have been deleted.n”);
++$files;
$totalsize += $filestat[7];
} elsif (unlink($file)) {
p_log($config{log},”File $file was deleted.n”);
++$files;
$totalsize += $filestat[7];
}
}
}
}
}
# procedure p_del
# used by File::Find call to delete files or directories
sub p_del {
if (-d $File::Find::name) {
if (defined ($config{test})) {
p_log($config{log},”Directory $File::Find::name would have been removed.n”);
++$dirs;
} elsif (rmdir(“$File::Find::name”)) {
p_log($config{log},”Directory $File::Find::name was removed.n”);
++$dirs;
}
print “.” if defined ($config{verbose});
} elsif (-f $File::Find::name) {
open (FILE,”$File::Find::name”);
my @filestat = stat(FILE);
close (FILE);
if (defined ($config{test})) {
p_log($config{log},”File $File::Find::name would have been deleted.n”);
++$files;
$totalsize += $filestat[7];
} elsif (unlink(“$File::Find::name”)) {
p_log($config{log},”File $File::Find::name was deleted.n”);
++$files;
$totalsize += $filestat[7];
}
print “.” if defined ($config{verbose});
}
}
# procedure p_log
# manages creating log entries
sub p_log {
my ($logfile,$message) = @_;
my $time = time();
$time = localtime($time);
open (LOG, “>>$logfile”) or die “nERROR: could not open $logfile: $^En”;
$message =~ s///\/g;
print LOG “$time: $message”;
close (LOG);
}
# procedure p_getfreespace
# returns the number of free bytes on a remote drive
sub p_getfreespace {
my ($servername,$drive) = @_;
my $Win32Error = 0;
my $pFree = pack(“L2″,0,0);
my $pTotal = pack(“L2″,0,0);
my $pTotalFree = pack(“L2″,0,0);
my $path = “\\”.$servername.”\”.$drive.”$\”;

# import Win32API function
ApiLink(‘kernel32.dll’,’BOOL GetDiskFreeSpaceEx(
LPCTSTR lpDirectoryName,
PVOID lpFreeBytesAvailable,
PVOID lpTotalNumberOfBytes,
PVOID lpTotalNumberOfFreeBytes)’)
or die “nERROR: cannot link to GetDiskFreeSpaceExn”;

# make the function call
if (GetDiskFreeSpaceEx($path,$pFree,$pTotal,$pTotalFree)) {
# compute the number of free bytes
my $freespace = p_MakeLargeInt(unpack(“L2″,$pTotalFree));
my $TotalSpace = p_MakeLargeInt(unpack(“L2″,$pTotal));
my $SpaceUsed = $TotalSpace – $freespace;
my $PercentageUsed = ($SpaceUsed * 100) / $TotalSpace;

my $FreeSpaceUnit = “bytes”;
my $i = 0;
while ($freespace > 1024) {
$freespace = $freespace / 1024;
++$i;
}
if ($i == 1) {
$FreeSpaceUnit = “KB”;
} elsif ($i == 2) {
$FreeSpaceUnit = “MB”;
} elsif ($i == 3) {
$FreeSpaceUnit = “GB”;
} elsif ($i == 4) {
$FreeSpaceUnit = “TB”;
} elsif ($i == 5) {
$FreeSpaceUnit = “PB”;
}

my $TotalSpaceUnit = “bytes”;
$i = 0;
while ($TotalSpace > 1024) {
$TotalSpace = $TotalSpace / 1024;
++$i;
}
if ($i == 1) {
$TotalSpaceUnit = “KB”;
} elsif ($i == 2) {
$TotalSpaceUnit = “MB”;
} elsif ($i == 3) {
$TotalSpaceUnit = “GB”;
} elsif ($i == 4) {
$TotalSpaceUnit = “TB”;
} elsif ($i == 5) {
$TotalSpaceUnit = “PB”;
}

$freespace = p_FormatNumber($freespace);
$TotalSpace = p_FormatNumber($TotalSpace);
print “There now is “;
printf “%.2f”,$freespace;
print ” $FreeSpaceUnit available out of “;
printf “%.2f”,$TotalSpace;
print ” $TotalSpaceUnit (“;
printf “%.2f”,$PercentageUsed;
print “% used) on the $drive: drive.n”;
} else {
$Win32Error = Win32::GetLastError();
my $ErrorMessage = Win32::FormatMessage($Win32Error);
print “\\$servername\$drive$ ERROR $Win32Error: $ErrorMessage”;
}

exit $Win32Error;
}
# procedure p_MakeLargeInt
# convert number into a decimal number
sub p_MakeLargeInt {
my($Low,$High) = @_;
return($High*(1+0xFFFFFFFF)+$Low);
}
# procedure p_FormatNumber
# add comas in number to make it more readable
sub p_FormatNumber {
my($Num) = @_;
{} while ($Num =~ s/^(-?d+)(d{3})/$1,$2/);
return($Num);
}

Posted in Perl | Tagged: , , , , , | Leave a Comment »

Ping Rage of IP – Perl Script

Posted by Alin D on November 12, 2010

Used to ping a given range of IP addresses. This tool used with /report
can help to determine the validity of an excluded range in a DHCP scope.

Used to ping a given range of IP addresses. This tool used with /report can help to determine the validity of an excluded range in a DHCP scope.
use Getopt::Long;
#use diagnostics;
#use strict;
use Win32::Console;

use Win32::PingICMP;

##################
# main procedure #
##################
my (%config);
my (@FirstIP,@LastIP,@Range);

p_parsecmdline(%config, @ARGV);
p_checkargs();

# set console codepage
Win32::Console::OutputCP(1252);

p_computerange();
print "nRange to ping is from '$Range[0]' to '$Range[$#Range]' ($#Range addresses)nn";
p_ping(@Range);

exit 0;

##################
# sub-procedures #
##################

# procedure p_help
# displays a help message
sub p_help {
my ($script)=($0=~/([^\/]*?)$/);
my ($header)=$script." v1.0 - Author: alin.dumenica@siemens.com - July 2007";
my ($line)="-" x length($header);
print <

$header
$line
Used to ping a given range of IP addresses. This tool used with /report
can help to determine the validity of an excluded range in a DHCP scope.

Usage: $script /[f]irst /[l]ast /[r]eport

/first First IP address in the range.
/last Last IP address in the range. If this is not specified,
then default is x.x.x.254 where x.x.x is based on first.
/report Shows only ranges of IP addresses which have not replied.
EOT

exit 1;
}
# procedure p_parsecmdline
# parses the command line and retrieves arguments values
sub p_parsecmdline {
my ($config) = @_;
Getopt::Long::Configure("prefix_pattern=(-|/)");
GetOptions($config, qw(
first|f=s
last|l=s
report|r
help|?|h));
}
# procedure p_checkargs
# checks the arguments which have been used are a valid combination
sub p_checkargs {
p_help() if defined($config{help});

if (!$config{first}) {
p_help();
} else {
# separate each octet of the IP address and store them in an array
@FirstIP = split(/./,$config{first});
# Check the array has the required number of entries
unless ($#FirstIP == 3) {
print "nERROR: The first IP address ($config{first}) is invalid: it must be composed of 4 integersn";
exit 1;
} else {
foreach my $Value (@FirstIP) {
# check it is an integer
if ($Value =~ /D/) {
print "nERROR: The first IP address ($config{first}) is invalid: it must be composed of integers onlyn";
exit 1;
}
# check it is less than 255
if ($Value >= 255) {
print "nERROR: The first IP address ($config{first}) is invalid: a value is equal to or greater than 255n";
exit 1;
}
}
}
}
if (!$config{last}) {
@LastIP = @FirstIP;
$LastIP[$#LastIP] = 254;
foreach my $Value (@LastIP) {
if ($config{last}) {
if ($LastIP[$#LastIP] eq $Value) {
$config{last} .= $Value;
} else {
$config{last} .= "$Value.";
}
} else {
$config{last} = "$Value.";
}
}
} else {
# separate each octet of the IP address and store them in an array
@LastIP = split(/./,$config{last});
# Check the array has the required number of entries
unless ($#LastIP == 3) {
print "nERROR: The first IP address ($config{first}) is invalid: it must be composed of 4 integersn";
exit 1;
} else {
for (my $i=0; $LastIP[$i]; ++$i) {
# check it is an integer
if ($LastIP[$i] =~ /D/) {
print "nERROR: The first IP address ($config{first}) is invalid: it must be composed of integers onlyn";
exit 1;
}
# check it is less than 255
if ($LastIP[$i] >= 255) {
print "nERROR: The first IP address ($config{first}) is invalid: a value is greater than 255n";
exit 1;
}
}
}
}
# do a series of check to make sure the range specified is valid
if (($FirstIP[0] != $LastIP[0]) or ($FirstIP[1] != $LastIP[1])) {
print "nERROR: The range is invalid or too great. The first two octets must be identical.n";
exit 1;
}
if ($config{first} eq $config{last}) {
print "nERROR: The first IP address is the same as the last IP address.n";
exit 1;
}
if ($FirstIP[2] == $LastIP[2]) {
unless ($FirstIP[3] < $LastIP[3]) { print "nERROR: The range is invalid.n"; exit 1; } } elsif ($FirstIP[2] > $LastIP[2]) {
print "nERROR: The range is invalid.n";
exit 1;
}
}
# procedure p_computerange
# computes a range of IP addresses and stores it in an array
sub p_computerange {
if ($FirstIP[2] == $LastIP[2]) {
my $i = 0;
while (($i + $FirstIP[3]) <= $LastIP[3]) {
my $Value = "$FirstIP[0].$FirstIP[1].$FirstIP[2].".($FirstIP[3] + $i);
push (@Range,$Value);
++$i;
}
} else {
my $j=0;
while (($j + $FirstIP[2]) <= $LastIP[2]) {
my $i = 0;
if ($j == 0) {
while (($i + $FirstIP[3]) <= 254) {
my $Value = "$FirstIP[0].$FirstIP[1].".($FirstIP[2] + $j).".".($FirstIP[3] + $i);
push (@Range,$Value);
++$i;
}
} elsif (($j + $FirstIP[2]) < $LastIP[2]) {
while ($i < 254) {
++$i;
my $Value = "$FirstIP[0].$FirstIP[1].".($FirstIP[2] + $j).".".$i;
push (@Range,$Value);
}
} else {
while ($i < $LastIP[3]) { ++$i; my $Value = "$FirstIP[0].$FirstIP[1].".($FirstIP[2] + $j).".".$i; push (@Range,$Value); } } ++$j; } } } # sub p_ping # pings a range of IP addresses sub p_ping { my $Range = shift; my $Ping; unless ($config{report}) { if ($Ping = Win32::PingICMP->new()) {
foreach my $IP (@$Range) {
if ($Ping->ping($IP)) {
print " Pinged $IP: OK (in ".$Ping->details->{roundtriptime}." ms)n";
} else {
print " Pinged $IP: KO (".$Ping->details->{status}.")n";
}
}
}
} else {
my ($FirstKO,$OldIP);
if ($Ping = Win32::PingICMP->new()) {
foreach my $IP (@$Range) {
unless ($Ping->ping($IP)) {
unless ($FirstKO) {
$FirstKO = $IP;
}
$OldIP = $IP;
} else {
if ($FirstKO) {
if ($FirstKO eq $OldIP) {
print " $FirstKO did not pingn";
} else {
print " Range $FirstKO to $OldIP did not pingn";
}
$FirstKO = undef;
}
}
}
if ($FirstKO) {
if ($FirstKO eq $OldIP) {
print " $FirstKO did not pingn";
} else {
print " Range $FirstKO to $OldIP did not pingn";
}
}
}
}
}

Posted in Perl, Scripting | Tagged: , , | Leave a Comment »

Audit Share Perl Script

Posted by Alin D on November 12, 2010

Used to audit usage of a network share on a remote server.
Usage: $script /[m]achine <hostname> /[s]hare <share name> /[d]uration <number of hours>
/[i]nterval <number of minutes> /[l]og <file name> /single /domain <domain name>
/[v]erbose
/machine    Hostname of remote server.  Default is localhost.
/share      Name of share (double quoted if it contains a space).
/duration   Number of days for which you want the audit to run.
/interval   Number of minutes between each enumeration. Default is 5 minutes.
/log        File name where results must be stored. Default is
“Date.Server.Share.AuditShare.log” in the current directory. A new
log file is created every day.
/single     Do not create multiple log files (default is one per day).
/domain     Specify the name of a Windows domain against which you want to check
all user names contained in session information.  If the user is found,
then the script will also display the user full name and the user description.
This option only works with /duration.
/verbose    Display entries as they are created in the log file (valid only with /duration).
/help       Displays this help message.

use Getopt::Long;
#use diagnostics;
#use strict;
use Win32::Console;

use Win32::NetAdmin;
use Win32::Lanman;

##################
# main procedure #
##################
my (%config);

p_parsecmdline(%config, @ARGV);
p_checkargs();

# set console codepage
Win32::Console::OutputCP(1252);

# CODE STARTS HERE
if ($config{duration}) {
my $NumberOfPolls = ($config{duration} * 60) / $config{interval};
my $IntervalInSeconds = $config{interval} * 60;
while ($NumberOfPolls) {
p_EnumConnections($config{machine},$config{share});
--$NumberOfPolls;
sleep $IntervalInSeconds;
}
} else {
p_EnumConnections($config{machine},$config{share});
}
# CODE ENDS HERE

exit 0;

##################
# sub-procedures #
##################

# procedure p_help
# displays a help message
sub p_help {
my ($script)=($0=~/([^\/]*?)$/);
my ($header)=$script." v1.5.1 - Authors: suparatuk@gmail.com - August 2007";
my ($line)="-" x length($header);
print <

$header
$line
Used to audit usage of a network share on a remote server.

Usage: $script /[m]achine /[s]hare /[d]uration
/[i]nterval /[l]og /single /domain
/[v]erbose

/machine Hostname of remote server. Default is localhost.
/share Name of share (double quoted if it contains a space).
/duration Number of days for which you want the audit to run.
/interval Number of minutes between each enumeration. Default is 5 minutes.
/log File name where results must be stored. Default is
"Date.Server.Share.AuditShare.log" in the current directory. A new
log file is created every day.
/single Do not create multiple log files (default is one per day).
/domain Specify the name of a Windows domain against which you want to check
all user names contained in session information. If the user is found,
then the script will also display the user full name and the user description.
This option only works with /duration.
/verbose Display entries as they are created in the log file (valid only with /duration).
/help Displays this help message.
EOT

exit 1;
}
# procedure p_parsecmdline
# parses the command line and retrieves arguments values
sub p_parsecmdline {
my ($config) = @_;
Getopt::Long::Configure("prefix_pattern=(-|/)");
GetOptions($config, qw(
machine|m=s
share|s=s
duration|d=i
interval|i=i
log|l=s
single
domain=s
verbose|v
help|?|h));
}
# procedure p_checkargs
# checks the arguments which have been used are a valid combination
sub p_checkargs {
p_help() if defined($config{help});
unless ($config{share}) {
print "nERROR: You MUST specify a share name!nn";
p_help();
}
unless ($config{machine}) {
$config{machine}=Win32::NodeName();
}
unless ($config{interval}) {
$config{interval} = 5;
}
unless ($config{log}) {
my $time = time();
$time = localtime($time);
my @time = split(/s+/,$time);
$config{log} = "$time[4]$time[1]$time[2].AuditShare.$config{machine}.$config{share}.log";
}
}
# procedure p_EnumConnections
# Enumerates connections made to a given share
sub p_EnumConnections {
my ($Server,$Share) = @_;
my (@Connections,$Connection);
$Server = "\\".$Server;

unless (Win32::Lanman::NetConnectionEnum($Server,$Share,@Connections)) {
print "ERROR: Could not enumerate connections: ".Win32::Lanman::GetLastError();
exit 1;
}

if ($config{duration}) {
foreach $Connection (@Connections) {
if (-f $config{log}) {
open (LOG, "$config{log}") or die "nERROR: could not open $config{log}: $^En";
my $Match = 0;
while (defined(my $LogEntry = )) {
my @LogEntryItems = split(",",$LogEntry);
chomp($LogEntryItems[2]);
unless ($Connection->{username}) {
$Connection->{username} = "Not specified";
if ($LogEntryItems[1] and $Connection->{netname}) {
if ($LogEntryItems[1] eq $Connection->{netname}) {
$Match = 1;
}
}
}
if ($LogEntryItems[2] and $Connection->{username}) {
if ($LogEntryItems[2] eq $Connection->{username}) {
$Match = 1;
}
}
}
close (LOG);
unless ($Match) {
p_log($config{log},"$Connection->{netname},$Connection->{username}");
}
} else {
p_log($config{log},"$Connection->{netname},$Connection->{username}");
}
}
} else {
$~ = 'HEADER';
write;
$~ = 'REPORT';

foreach $Connection (@Connections) {
unless ($Connection->{username}) {
$Connection->{username} = "Not Specified";
}
write;
}
}
format HEADER =
Computer Name Username
------------------ ----------------
.
format REPORT =
@||||||||||||||||| @|||||||||||||||
$Connection->{netname},$Connection->{username}
.
}
# procedure p_log
# manages creating log entries
sub p_log {
my ($logfile,$message) = @_;
my ($pdc,$Server,%attribs);
my $time = time();
$time = localtime($time);
unless ($config{single}) {
my @time = split(/s+/,$time);
my $NewLogFile = "$time[4]$time[1]$time[2].AuditShare.$config{machine}.$config{share}.log";
open (LOG, ">>$NewLogFile") or die "nERROR: could not open $NewLogFile: $^En";
} else {
open (LOG, ">>$logfile") or die "nERROR: could not open $logfile: $^En";
}

if ($config{domain}) {
my @Message = split(",",$message);
unless ($Message[1] eq "Not Specified") {
$Server = Win32::NodeName();
if (Win32::NetAdmin::GetDomainController("\\$Server",$config{domain},$pdc)) {
if (Win32::Lanman::NetUserGetInfo($pdc,$Message[1],%attribs)) {
$attribs{'full_name'} =~ s/,+//g;
$attribs{'comment'} =~ s/,+//g;
if ($config{verbose}) {
print "$time,$message,$attribs{'full_name'},$attribs{'comment'}n";
}
print LOG "$time,$message,$attribs{'full_name'},$attribs{'comment'}n";
} else {
if ($config{verbose}) {
print "$time,$messagen";
}
print LOG "$time,$messagen";
}
} else {
if ($config{verbose}) {
print "$time,$messagen";
}
print LOG "$time,$messagen";
}
}
} else {
if ($config{verbose}) {
print "$time,$messagen";
}
print LOG "$time,$messagen";
}
close (LOG);
}

Posted in Perl, Scripting | Tagged: , , , | Leave a Comment »

Clean Drive – Perl Script

Posted by Alin D on October 15, 2010

Used to clean a logical drive. This script deletes temporary files, kernel and user memory dumps as well as internet temporary files. Optionally, it can also compress log directories and/or delete a list of specified files and/or directories.
Used to clean a logical drive. This script deletes temporary files, kernel and user memory dumps as well as internet temporary files. Optionally, it can also compress log directories and/or delete a list of specified files and/or directories.
Usage: $script /[d]rive <drive letter> /[l]og <filename>
/[c]ompress <path or filename> /[f]ilelist <filename>
/[t]est /[v]erbose /[h]elp

Variables

/drive      Logical drive letter to clean.

/log        Name of logfile (default is cleandrive-YYYYmonthDD.log).

/compress   Use NTFS compression on specified path (e.g. c:\temp).

A file containing a list of paths can also be specified.

File contains one entry per line.

/filelist   Name of a file containing a list of files or

directories to delete (example of entry in file is

c:\temp; file contains one entry per line; wildcard

* can be used to specify that line applies to all drives).

/test       Do not delete any files, but only log what would   be done.

/verbose    Shows what is being done as it is being done.

/help       Shows this help message.

use Getopt::Long;
#use diagnostics;
#use strict;
use Win32::Console;
use File::Find;
use Cwd;
use Win32::API::Prototype;

##################
# main procedure #
##################
my (%config);
my ($files,$dirs);
my ($totalsize) = 0;

p_parsecmdline(%config, @ARGV);
p_checkargs();

# set console codepage
Win32::Console::OutputCP(1252);

# check drive is valid
my $drive = $config{drive};
$drive =~ s/W+//;
$drive .= ":\";
if (! -d $drive) {
die "ERROR: $drive is not a valid drive";
}
# compute log file name if it hasn't been specified
unless (defined ($config{log})) {
my $time = time();
$time = localtime($time);
my @time = split(/s+/,$time);
$config{log} = "cleandrive-$time[4]$time[1]$time[2].log";
}
unless ($config{log} =~ /\/) {
my $cwd = getcwd;
unless ($cwd =~ //$/) {
$cwd .= "/";
}
$config{log} = "$cwd$config{log}";
}
# delete temp dirs content and dump files
p_cleantemp($config{drive});
p_cleandumps($config{drive});
# apply ntfs compression
if (defined ($config{compress})) {
p_compressfolders($config{drive},$config{compress});
}
# process files to delete
if (defined ($config{filelist})) {
p_delfiles($config{drive},$config{filelist});
}
# print summary of what was done
if (defined ($files) and defined ($dirs)) {
if (defined ($config{test})) {
print "n$files files and $dirs directories would have been deleted.n";
} else {
print "n$files files and $dirs directories were deleted.n";
}

my $TotalSizeUnit = "bytes";
my $count = 0;
while ($totalsize > 1024) {
$totalsize = $totalsize / 1024;
++$count;
}
if ($count == 1) {
$TotalSizeUnit = "KB";
} elsif ($count == 2) {
$TotalSizeUnit = "MB";
} elsif ($count == 3) {
$TotalSizeUnit = "GB";
} elsif ($count == 4) {
$TotalSizeUnit = "TB";
} elsif ($count == 5) {
$TotalSizeUnit = "PB";
}

print "Total space saved: ";
printf ("%.2f",$totalsize);
print " $TotalSizeUnit.n";
my $logpath = $config{log};
$logpath =~ s///\/g;
print "Log file is $logpathn";
} else {
print "nThere were no files or directories to process.n";
}

my $LocalHost = Win32::NodeName();
p_getfreespace($LocalHost,$config{drive});

exit (0);

##################
# sub-procedures #
##################

# procedure p_help
# displays a help message
sub p_help {
my ($script)=($0=~/([^\/]*?)$/);
my ($header)=$script."v 3.1 - Author: suparatul@gmail.com - http://windows-scripting.co.cc";
my ($line)="-" x length($header);
print <

$header
$line
Used to clean a logical drive. This script deletes temporary files,
kernel and user memory dumps as well as internet temporary files.
Optionally, it can also compress log directories and/or delete a
list of specified files and/or directories.

Usage: $script /[d]rive /[l]og
/[c]ompress
/[f]ilelist
/[t]est /[v]erbose /[h]elp

/drive Logical drive letter to clean.
/log Name of logfile (default is cleandrive-YYYYmonthDD.log).
/compress Use NTFS compression on specified path (e.g. c:\temp).
A file containing a list of paths can also be specified.
File contains one entry per line.
/filelist Name of a file containing a list of files or
directories to delete (example of entry in file is
c:\temp; file contains one entry per line; wildcard
* can be used to specify that line applies to all drives).
/test Do not delete any files, but only log what would
be done.
/verbose Shows what is being done as it is being done.
/help Shows this help message.
EOT

exit 1;
}
# procedure p_parsecmdline
# parses the command line and retrieves arguments values
sub p_parsecmdline {
my ($config) = @_;
Getopt::Long::Configure("prefix_pattern=(-|/)");
GetOptions($config, qw(
drive|d=s
log|l=s
compress|c=s
filelist|f=s
test|t
verbose|v
help|?|h));
}
# procedure p_checkargs
# checks the arguments which have been used are a valid combination
sub p_checkargs {
if ($config{help}) {
p_help();
}
unless (defined ($config{drive})) {
p_help();
}
}
# procedure p_cleantemp
# deletes content of temporary directories
sub p_cleantemp {
my $drive = shift;
# strip drive letter of all non alpha-numeric characters
$drive =~ s/W+//;
my @temp;

# populate array @temp of temporary directories on $drive
if ((-d "$drive:/temp") and ("$drive:\temp" ne lc($ENV{TEMP})) and ("$drive:\temp" ne lc($ENV{TMP}))) {
push (@temp,"$drive:/temp");
}
if ((-d "$drive:/tmp") and ("$drive:\tmp" ne lc($ENV{TEMP})) and ("$drive:\tmp" ne lc($ENV{TMP}))) {
push (@temp,"$drive:/tmp");
}
# add environment variables that define temporary directories,
# only if they are located on $drive
if ($ENV{TEMP} =~ /^$drive/i) {
my $temp = $ENV{TEMP};
$temp =~ s/\///g;
push (@temp,$temp);
}
if (($ENV{TMP} =~ /^$drive/i) and (lc($ENV{TMP}) ne lc($ENV{TEMP}))) {
my $tmp = $ENV{TMP};
$tmp =~ s/\///g;
push (@temp,$tmp);
}

foreach my $dir (@temp) {
my $FormattedDir = $dir;
$FormattedDir =~ s///\/g;
print "n Processing '$FormattedDir' directory" if defined ($config{verbose});
finddepth (&p_del, "$dir");
}

# determine if $drive is the system drive, in which case process user profiles temp directories
if (lc($ENV{SYSTEMDRIVE}) eq lc("$drive:")) {
my @profiles = ("$ENV{SYSTEMROOT}\Profiles","$drive:\Documents and Settings");
foreach my $dir (@profiles) {
if (-d $dir) {
opendir (PROFILES, $dir) or next;
while (my $folder = readdir(PROFILES)) {
if (($folder eq ".") or ($folder eq "..")) {
next;
}
my $path = "$dir\$folder";
if (-d "$path\Local Settings\temp") {
print "n Processing '$path\Local Settings\temp' directory" if defined ($config{verbose});
finddepth (&p_del, "$path\Local Settings\temp");
}
if (-d "$path\Local Settings\Temporary Internet Files") {
print "n Processing '$path\Local Settings\Temporary Internet Files' directory" if defined ($config{verbose});
finddepth (&p_del, "$path\Local Settings\Temporary Internet Files");
}
}
closedir (PROFILES);
}
}
# process SYSTEMROOTtemp if it exists
if (-d "$ENV{SYSTEMROOT}\temp") {
my $path = "$ENV{SYSTEMROOT}\temp";
print "n Processing '$path' directory" if defined ($config{verbose});
finddepth (&p_del, "$path");
}
}
}
# procedure p_cleandumps
# deletes kernel and user memory dumps
sub p_cleandumps {
my $drive = shift;
$drive =~ s/W+//;
# search logical drive for memory.dmp and user.dmp files and delete them
if (lc($ENV{SYSTEMDRIVE}) eq lc("$drive:")) {
# test for memory.dmp and delete it if it is 5 days or older only
if (-f "$ENV{SYSTEMROOT}\memory.dmp") {
open (FILE, "$ENV{SYSTEMROOT}\memory.dmp");
my @filestat = stat(FILE);
my $time = time();
my $seconds = $time - $filestat[9];
if ($seconds > 432000) {
print "n Processing $ENV{SYSTEMROOT}\memory.dmp" if defined ($config{verbose});
if (defined ($config{test})) {
p_log($config{log},"File $ENV{SYSTEMROOT}\memory.dmp would have been deleted.n");
++$files;
$totalsize += $filestat[7];
} elsif (unlink ("$ENV{SYSTEMROOT}\memory.dmp")) {
p_log($config{log},"File $ENV{SYSTEMROOT}\memory.dmp was deleted.n");
++$files;
$totalsize += $filestat[7];
}
}
close (FILE);
}
if (-d "$ENV{SYSTEMROOT}\Minidump") {
print "n Processing the '$ENV{SYSTEMROOT}\Minidump' directory" if defined ($config{verbose});
opendir (MINIDUMP, "$ENV{SYSTEMROOT}\Minidump");
while (my $file = readdir(MINIDUMP)) {
# delete mini dumps that are older than 5 days
next if (($file eq ".") or ($file eq ".."));
my $path = "$ENV{SYSTEMROOT}\Minidump";
if (-f "$path\$file") {
my @filestat = stat(FILE);
my $time = time();
my $seconds = $time - $filestat[9];
if ($seconds > 432000) {
if (defined ($config{test})) {
p_log($config{log},"File $path\$file would have been deleted.n");
++$files;
$totalsize += $filestat[7];
} elsif (unlink ("$path\$file")) {
p_log($config{log},"File $path\$file was deleted.n");
++$files;
$totalsize += $filestat[7];
}
}
}
}
closedir (MINIDUMP);
}
}
}
# procedure p_compressfolders
# applies NTFS compression to path(s)
sub p_compressfolders {
my ($drive,$folders) = @_;
my (@folderlist);
$drive =~ s/W+//;
# determine if a filename has been specified, if so, then call sub p_readfile
if (-f $folders) {
@folderlist = p_readfile($folders);
} else {
@folderlist = $folders;
}
print "n Applying NTFS compression" if defined ($config{verbose});
# for each entry in the array, apply NTFS compression after making sure the path is valid
# and that the path is on the drive being cleaned
foreach my $file (@folderlist) {
$file =~ s/^*:/$drive:/i;
if ((-d "$file") and ($file =~ /^$drive:/i)) {
print "." if defined ($config{verbose});
if (defined ($config{test})) {
p_log($config{log},"Would have attempted to NTFS compress $filen");
} else {
`compact /C /S /I $file`;
p_log($config{log},"Attempted to NTFS compress $filen");
}
}
}
}
# procedure p_readfile
# reads the content of a file into an array
sub p_readfile {
my $file = shift;
my (@list);
# open handle to the file
open (FILE,$file);
my $i = 0;
while (defined (my $entry = )) {
chomp ($entry);
$list[$i] = $entry;
++$i;
}
return (@list);
}
# procedure p_delfiles
# delete specified files
sub p_delfiles {
my ($drive,$files) = @_;
my (@filelist);
$drive =~ s/W+//;
# call sub p_readfile
if (-f $files) {
@filelist = p_readfile($files);
print "n Processing entries in '$files'" if defined ($config{verbose});
# for each element in the array, delete the file or directory
foreach my $file (@filelist) {
$file =~ s/^*:/$drive:/i;
if ((-d $file) and ($file =~ /^$drive:/i)) {
finddepth (&p_del, "$file");
} elsif ((-f $file) and ($file =~ /^$drive:/i)) {
print "." if defined ($config{verbose});
open (FILE,"$file");
my @filestat = stat(FILE);
close (FILE);
if (defined ($config{test})) {
p_log($config{log},"File $file would have been deleted.n");
++$files;
$totalsize += $filestat[7];
} elsif (unlink($file)) {
p_log($config{log},"File $file was deleted.n");
++$files;
$totalsize += $filestat[7];
}
}
}
}
}
# procedure p_del
# used by File::Find call to delete files or directories
sub p_del {
if (-d $File::Find::name) {
if (defined ($config{test})) {
p_log($config{log},"Directory $File::Find::name would have been removed.n");
++$dirs;
} elsif (rmdir("$File::Find::name")) {
p_log($config{log},"Directory $File::Find::name was removed.n");
++$dirs;
}
print "." if defined ($config{verbose});
} elsif (-f $File::Find::name) {
open (FILE,"$File::Find::name");
my @filestat = stat(FILE);
close (FILE);
if (defined ($config{test})) {
p_log($config{log},"File $File::Find::name would have been deleted.n");
++$files;
$totalsize += $filestat[7];
} elsif (unlink("$File::Find::name")) {
p_log($config{log},"File $File::Find::name was deleted.n");
++$files;
$totalsize += $filestat[7];
}
print "." if defined ($config{verbose});
}
}
# procedure p_log
# manages creating log entries
sub p_log {
my ($logfile,$message) = @_;
my $time = time();
$time = localtime($time);
open (LOG, ">>$logfile") or die "nERROR: could not open $logfile: $^En";
$message =~ s///\/g;
print LOG "$time: $message";
close (LOG);
}
# procedure p_getfreespace
# returns the number of free bytes on a remote drive
sub p_getfreespace {
my ($servername,$drive) = @_;
my $Win32Error = 0;
my $pFree = pack("L2",0,0);
my $pTotal = pack("L2",0,0);
my $pTotalFree = pack("L2",0,0);
my $path = "\\".$servername."\".$drive."$\";

# import Win32API function
ApiLink('kernel32.dll','BOOL GetDiskFreeSpaceEx(
LPCTSTR lpDirectoryName,
PVOID lpFreeBytesAvailable,
PVOID lpTotalNumberOfBytes,
PVOID lpTotalNumberOfFreeBytes)')
or die "nERROR: cannot link to GetDiskFreeSpaceExn";

# make the function call
if (GetDiskFreeSpaceEx($path,$pFree,$pTotal,$pTotalFree)) {
# compute the number of free bytes
my $freespace = p_MakeLargeInt(unpack("L2",$pTotalFree));
my $TotalSpace = p_MakeLargeInt(unpack("L2",$pTotal));
my $SpaceUsed = $TotalSpace - $freespace;
my $PercentageUsed = ($SpaceUsed * 100) / $TotalSpace;

my $FreeSpaceUnit = "bytes";
my $i = 0;
while ($freespace > 1024) {
$freespace = $freespace / 1024;
++$i;
}
if ($i == 1) {
$FreeSpaceUnit = "KB";
} elsif ($i == 2) {
$FreeSpaceUnit = "MB";
} elsif ($i == 3) {
$FreeSpaceUnit = "GB";
} elsif ($i == 4) {
$FreeSpaceUnit = "TB";
} elsif ($i == 5) {
$FreeSpaceUnit = "PB";
}

my $TotalSpaceUnit = "bytes";
$i = 0;
while ($TotalSpace > 1024) {
$TotalSpace = $TotalSpace / 1024;
++$i;
}
if ($i == 1) {
$TotalSpaceUnit = "KB";
} elsif ($i == 2) {
$TotalSpaceUnit = "MB";
} elsif ($i == 3) {
$TotalSpaceUnit = "GB";
} elsif ($i == 4) {
$TotalSpaceUnit = "TB";
} elsif ($i == 5) {
$TotalSpaceUnit = "PB";
}

$freespace = p_FormatNumber($freespace);
$TotalSpace = p_FormatNumber($TotalSpace);
print "There now is ";
printf "%.2f",$freespace;
print " $FreeSpaceUnit available out of ";
printf "%.2f",$TotalSpace;
print " $TotalSpaceUnit (";
printf "%.2f",$PercentageUsed;
print "% used) on the $drive: drive.n";
} else {
$Win32Error = Win32::GetLastError();
my $ErrorMessage = Win32::FormatMessage($Win32Error);
print "\\$servername\$drive$ ERROR $Win32Error: $ErrorMessage";
}

exit $Win32Error;
}
# procedure p_MakeLargeInt
# convert number into a decimal number
sub p_MakeLargeInt {
my($Low,$High) = @_;
return($High*(1+0xFFFFFFFF)+$Low);
}
# procedure p_FormatNumber
# add comas in number to make it more readable
sub p_FormatNumber {
my($Num) = @_;
{} while ($Num =~ s/^(-?d+)(d{3})/$1,$2/);
return($Num);
}

Posted in Perl | Tagged: , , , , , | Leave a Comment »

Reboot check – Perl Script

Posted by Alin D on October 15, 2010

Used to perform post reboot checks. Must be ran once before reboot and once after reboot. Look at all _REPORT files to get a status after the reboot. Only new event IDs will be shown in the _REPORT eventlog files.
The /before and /after must be ran on the same day or the /l switch must be used; otherwise /after will fail.
Usage: RebootCheck /b[efore] /a[fter] /f[ilename] <filename> /s[erver] <hostname> /c[ancel] /reboot /shutdown /l[ogdir] <directory>

Varialbles

/before     Creates pre-reboot reference files
/after      Compares reference files with post-reboot status and generates report
/filename   Name of files with list of servers to check
/server     Name of target server (useless if /f is also used)
/reboot     Reboots server(s) in 5 minutes, then loops on /after, until servers are up again and fully checked. Script will timeout after 15 minutes if a server does not respond.
/shutdown   Shutdowns server(s) in 5 minutes
/cancel     Cancels reboot immediately
/logdir     Log files directory (must already exist). This parameter is optional. If not specified, log files will be stored in a directory named after the current date

use Win32;
use Win32::Lanman;
use Getopt::Long;
use Win32::Service;
use Win32::PerfLib;
use Win32::EventLog;

##################
# main procedure #
##################

# parse the command line for arguments
p_parsecmdline(%config,@ARGV);

# check the combination of arguments is valid
p_checkargs();

# this hash will store the service information for the remote server so that it may be re-used outside
# the p_retservices procedure
my %ServiceList;

# generate a log directory name based on today's date if none have been specified
unless ($logdir) {
$logdir = p_createlogpathdir();
}

# open the _REPORT.error.log filename; if it already exists open it in append mode
if (-f "$logdir\_REPORT.error.log") {
open (ERRORLOG,">>$logdir\_REPORT.error.log")
or die "ERROR: cannot open _REPORT.error.log in append mode!n";
} else {
open (ERRORLOG,">$logdir\_REPORT.error.log")
or die "ERROR: cannot open _REPORT.error.log!n";
}

# if a list of servers has been specified, read the file
if ($filename) {
p_GetServerList();
}

# if /after switch has been set, open the _REPORT files
if (($after == 1) or ($rebootaction eq "reboot")) {
open (SERVREPORT,">$logdir\_REPORT.services.log")
or die "ERROR: cannot open _REPORT.services.log in append mode!n";
open (LOGREPORT,">$logdir\_REPORT.eventlog.log")
or die "ERROR: cannot open _REPORT.eventlog.log!n";
}

# if /reboot switch has been used, open the _REPORT.reboot log file
if ($reboot == 1) {
open (REBOOTLOG,">$logdir\_REPORT.reboot.error.log")
or die "ERROR: cannot open _REPORT.reboot.error.log!n";
}

# process each server
for ($i=0;$serverlist[$i];++$i) {
# reboot or abort the reboot
if ($reboot) {
p_reboot($serverlist[$i],$rebootaction);
next;
}
if ($i == 0) {
if ($before == 1) {
print ERRORLOG "n------ Before ------n";
} elsif ($after == 1) {
print ERRORLOG "n------ After ------n";
}
}
# see how long the server has been up for
unless ($uptime = p_GetSysUptime($serverlist[$i])) {
print "ERROR: Cannot determine system uptime for $serverlist[$i]n";
next;
}
# see what time it is on the server
unless (Win32::Lanman::NetRemoteTOD("\\$serverlist[$i]", %info)) {
print "ERROR: $serverlist[$i]: cannot query time: ".Win32::Lanman::GetLastError()."n";
print "n";
next;
}
# determine what the time offset for reading the logs should be
$time = $info{elapsedt} - $uptime;
if ($before == 1) {
p_retEVTerrors("before",$serverlist[$i],$time,"System");
p_retEVTerrors("before",$serverlist[$i],$time,"Application");
p_retservices("before",$serverlist[$i]);
} elsif ($after == 1) {
p_retEVTerrors("after",$serverlist[$i],$time,"System");
p_retEVTerrors("after",$serverlist[$i],$time,"Application");
p_retservices("after",$serverlist[$i]);
p_compareservices($serverlist[$i]);
p_comparelog($serverlist[$i],"System");
p_comparelog($serverlist[$i],"Application");
#p_checktivoli($serverlist[$i]);
}
print "n";
}

if ($rebootaction eq "reboot") {
print "nWaiting 6 minutes for server(s) to reboot...nn";
sleep 360;
for ($i=0;$serverlist[$i];++$i) {
my $Counter = 0;
while ((! Win32::Lanman::NetRemoteTOD("\\$serverlist[$i]", %info)) and ($Counter < 15)) {
print "INFO: $serverlist[$i] is not responding, trying again in 1 minute...n";
sleep 60;
++$Counter;
}
unless ($Counter <15) {
print ERRORLOG "ERROR: $serverlist[$i] timed out while trying to do post-reboot checks. Please check this server manually.n";
}
print "n";
if ($uptime = p_GetSysUptime($serverlist[$i])) {
$time = $info{elapsedt} - $uptime;
p_retEVTerrors("after",$serverlist[$i],$time,"System");
p_retEVTerrors("after",$serverlist[$i],$time,"Application");
p_retservices("after",$serverlist[$i]);
p_compareservices($serverlist[$i]);
p_comparelog($serverlist[$i],"System");
p_comparelog($serverlist[$i],"Application");
#p_checktivoli($serverlist[$i]);
}
print "n";
}
}

close (ERRORLOG)
or print "ERROR: cannot close _REPORT.error.log!n";

if (($after == 1) or ($rebootaction eq "reboot")) {
close (SERVREPORT)
or print "ERROR: cannot close _REPORT.services.log!n";
close (LOGREPORT)
or print "ERROR: cannot close _REPORT.eventlog.log!n";
}

if ($reboot == 1) {
close (REBOOTLOG)
or print "ERROR: cannot close _REPORT.reboot.error.log!n";
}

##################
# sub-procedures #
##################

# procedure p_help
# displays a help message
sub p_help {
my ($script)=($0=~/([^\/]*?)$/);
my ($header)=$script." v1.1 - Author: suparatul@gmail.com - http://windows-scripting.co.cc";
my ($line)="-" x length($header);
print <

$header
$line
Used to perform post reboot checks. Must be ran once before
reboot and once after reboot. Look at all _REPORT files to
get a status after the reboot. Only new event IDs will be
shown in the _REPORT eventlog files.
The /before and /after must be ran on the same day or the /l switch
must be used; otherwise /after will fail.

Usage: RebootCheck /b[efore] /a[fter] /f[ilename] /s[erver]
/c[ancel] /reboot /shutdown /l[ogdir]

/before Creates pre-reboot reference files
/after Compares reference files with post-reboot
status and generates report
/filename Name of files with list of servers to check
/server Name of target server (useless if /f is also
used)
/reboot Reboots server(s) in 5 minutes, then loops on
/after, until servers are up again and fully checked.
Script will timeout after 15 minutes if a server does not
respond.
/shutdown Shutdowns server(s) in 5 minutes
/cancel Cancels reboot immediately
/logdir Log files directory (must already exist). This
parameter is optional. If not specified, log
files will be stored in a directory named
after the current date
EOT

exit 1;
}
# procedure p_parsecmdline
# parses the command line and retrieves arguments values
sub p_parsecmdline {
my ($config) = @_;
my $result = 0;
Getopt::Long::Configure("prefix_pattern=(-|/)");
$result = GetOptions($config, qw(
before|b
after|a
filename|f=s
server|s=s
reboot
shutdown
logdir|l=s
cancel|c
help|?|h));
}
# procedure p_checkargs
# checks arguments are valid
sub p_checkargs {
if ($config{help} eq 1) {
p_help();
}
if ($config{before} eq 1) {
$before = 1;
} elsif ($config{after} eq 1) {
$after = 1;
}
if ($config{filename}) {
$filename = $config{filename};
} elsif ($config{server}) {
@serverlist = $config{server};
}
if ($config{reboot} eq 1) {
$reboot = 1;
$rebootaction = "reboot";
} elsif ($config{cancel} eq 1) {
$reboot = 1;
$rebootaction = "abort";
} elsif ($config{shutdown} eq 1) {
$reboot = 1;
$rebootaction = "shutdown";
}
if ($config{logdir}) {
$logdir = $config{logdir};
}

unless ($reboot) {
unless ($before or $after) {
p_help();
}
if ($before and $after) {
p_help();
}
}
unless (($filename) or (@serverlist)) {
p_help();
}
}
# procedure p_GetServerList
# creates @serverlist
sub p_GetServerList {
# Process file to retrieve the list of server names to work with
open (SERVERLIST, $filename) || die "ERROR: can't open $filename";
my $i = 0;
while (defined ($servername = )) {
chomp($servername);
#Store each server name in the array @serverlist
$serverlist[$i] = $servername;
$i++;
}
close (SERVERLIST) || die "ERROR: can't close $filename";
}
# procedure p_GetSysUptime
# retrieves a machine's uptime
sub p_GetSysUptime {
my $machine = $_[0];
my $perf;
my $Numerator;
my $Denominator;
my $TimeBase;
my $counter;
my $seconds;
my $hour;
my $minute;
my $days;
if ($perf = new Win32::PerfLib($machine)) {
my $objlist = {};
my $system = 2;
if($perf->GetObjectList("$system", $objlist)) {
$perf->Close();
my $Counters = $objlist->{Objects}->{$system}->{Counters};
unless ($Counters) {
print "ERROR: $machine: System counters could not be retrievedn";
return;
}
foreach $o ( keys %{$Counters}) {
$id = $Counters->{$o}->{CounterNameTitleIndex};
if($id == 674) {
$Numerator = $Counters->{$o}->{Counter};
$Denominator = $objlist->{Objects}->{$system}->{PerfTime};
$TimeBase = $objlist->{Objects}->{$system}->{PerfFreq};
$counter = int(($Denominator - $Numerator) / $TimeBase );
$seconds = $counter;
$days = int($seconds / 86400);
$seconds -= $days * 86400;
$hour = int($seconds / 3600);
$seconds -= $hour * 3600;
$minute = int($seconds / 60);
$seconds -= $minute * 60;
print "INFO: $machine: has been up for $days days $hour hours $minute minutes $seconds secondsn";
if (($after == 1) and ($counter > 1800)) {
print "WARNING: $machine: has been up for more than 30 minutesn";
print ERRORLOG "WARNING: $machine: has been up for more than 30 minutesn";
}
last;
}
}
}
} else {
print "ERROR: $machine: cannot get system uptime: $^En";
print ERRORLOG "ERROR: $machine: cannot get system uptime: $^En";
}
return ($counter);
}
# procedure p_retsyserrors
# retrieves all errors from system event log for the last 48 hours
sub p_retEVTerrors {
my $prefix = $_[0];
my $servername = $_[1];
my $timeoffset = $_[2];
my $log = $_[3];
my $message;
my $time;
my $recs;
my $base;
my $x;
my $EVTdate;
my $EVTsource;
my $EVTid;
my $EVTmessage;
my $syshashRef;
my $syserror = 0;

#$Win32::EventLog::GetMessageText = 1;

unless (open (SYSERRORS,">$logdir\$servername.$prefix.$log.log")) {
print "ERROR: $servername: cannot open $prefix.system.logn";
print ERRORLOG "ERROR: $servername: cannot open $prefix.system.logn";
}
unless ($handle=Win32::EventLog->new($log, $servername)) {
print "ERROR: $servername: cannot open $log eventlog: $^En";
print ERRORLOG "ERROR: $servername: cannot open $log eventlog: $^En";
}
unless ($handle->GetNumber($recs)) {
print "ERROR: $servername: cannot get number of eventlog records: $^En";
print ERRORLOG "ERROR: $servername: cannot get number of eventlog records: $^En";
}
unless ($handle->GetOldest($base)) {
print "ERROR: $servername: cannot get number of oldest eventlog record: $^En";
print ERRORLOG "ERROR: $servername: cannot get number of oldest eventlog record: $^En";
}

my $tempdate = localtime($timeoffset);
print "INFO: $serverlist[$i]: getting $log log errors since $tempdaten";

while ($handle->Read(EVENTLOG_BACKWARDS_READ|EVENTLOG_SEQUENTIAL_READ,0,$syshashRef) && ($syshashRef->{TimeGenerated} > $timeoffset)) {
if ($syshashRef->{EventType} eq 1) {
Win32::EventLog::GetMessageText($syshashRef);
$EVTdate = $syshashRef->{TimeGenerated};
$EVTdate = localtime($EVTdate);
$EVTsource = $syshashRef->{Source};
$EVTid = $syshashRef->{EventID} & 0xffff;
$EVTmessage = $syshashRef->{Message};
# some event messages can't be retrieved, so retrieve strings instead
unless ($EVTmessage) {
$EVTmessage = $syshashRef->{Strings};
}
$EVTmessage = join(' ',split(/n/,$EVTmessage));
$EVTmessage = join('',split(/r/,$EVTmessage));
print SYSERRORS "$EVTdate, $EVTsource, $EVTid, $EVTmessagen";
$syserror = 1;
}
}
unless (defined($syshashRef)) {
print SYSERRORS "ERROR: $servername: could not read event log. Please check server manually.n";
}
if ($syserror == 1) {
print "WARNING: $servername: there are $log log errorsn";
print ERRORLOG "WARNING: $servername: there are $log log errorsn";
}
unless (close (SYSERRORS)) {
print "ERROR: $servername: cannot close $prefix.system.logn";
print ERRORLOG "ERROR: $servername: cannot close $prefix.system.logn";
}
$handle->Close();
}
# procedure p_retservices
# retrieves running services
sub p_retservices {
my %list;
my $prefix = $_[0];
my $machine = $_[1];
unless (open (SERVICES,">$logdir\$machine.$prefix.services.log")) {
print "ERROR: $machine: cannot open $prefix.services.logn";
print ERRORLOG "ERROR: $machine: cannot open $prefix.services.logn";
}
print "INFO: $machine: getting list of running servicesn";
if (Win32::Service::GetServices($machine,%list)) {
# Save the service list information so that it may be used later outside of this procedure
%ServiceList = %list;
foreach $service (sort(keys(%list))) {
if (Win32::Service::GetStatus($machine,$list{$service},%status)) {
$status = $status{CurrentState};
if ($status == 4) {
print SERVICES "$servicen";
}
} else {
print "ERROR: $machine: cannot get service status for $service: $^En";
print ERRORLOG "ERROR: $machine: cannot get service status for $service: $^En";
}
}
} else {
print "ERROR: $machine: cannot get service list: $^En";
print ERRORLOG "ERROR: $machine: cannot get service list: $^En";
print SERVICES "ERROR: $machine: cannot get service list. Please check server manually.n";
}
unless (close (SERVICES)) {
print "ERROR: $machine: cannot close $prefix.services.logn";
print ERRORLOG "ERROR: $machine: cannot close $prefix.services.logn";
}
}
# procedure p_compareservices
# compares before and after files for list of running services
sub p_compareservices {
my $servername = $_[0];
my $entry;
my $match;
my $before_entry;
my $after_entry;
my @before;
my @after;
my $first = 0;
unless (open (BEFORE, "$logdir\$servername.before.services.log")) {
print "ERROR: $servername: cannot open before.services.logn";
print ERRORLOG "ERROR: $servername: cannot open before.services.logn";
}
unless (open (AFTER, "$logdir\$servername.after.services.log")) {
print "ERROR: $servername: cannot open after.services.logn";
print ERRORLOG "ERROR: $servername: cannot open after.services.logn";
}
my $j = 0;
while (defined ($entry = )) {
chomp($entry);
$before[$j] = $entry;
++$j;
}
$j = 0;
while (defined ($entry = )) {
chomp($entry);
$after[$j] = $entry;
++$j;
}
foreach $before_entry (@before) {
foreach $after_entry (@after) {
if ($before_entry eq $after_entry) {
$match = 1;
last;
} else {
$match = 0;
}
}
if ($match == 0) {
if ($first == 0) {
print ERRORLOG "WARNING: $servername: at least one service is not running anymore!n";
++$first;
}
# Insert code here to check service configuration and try to restart it.
my %ServiceConfig;
my $StartType = "Startup Undefined";

if (Win32::Lanman::QueryServiceConfig("\\$servername", "", "$ServiceList{$before_entry}", %ServiceConfig)) {
if ($ServiceConfig{start} == 0) {
$StartType = "Boot";
} elsif ($ServiceConfig{start} == 1) {
$StartType = "System";
} elsif ($ServiceConfig{start} == 2) {
$StartType = "Automatic";
} elsif ($ServiceConfig{start} == 3) {
$StartType = "Manual";
} elsif ($ServiceConfig{start} == 4) {
$StartType = "Disabled";
}
}
print "WARNING: $servername: $before_entry service ($StartType) is not running anymore!n";
if (Win32::Lanman::StartService($servername,"",$ServiceList{$before_entry})) {
print "INFO: $servername: Service "$before_entry" was startedn";
} else {
my $Error = Win32::Lanman::GetLastError();
print "ERROR: $servername: Could not start service '$before_entry':".Win32::FormatMessage($Error)."n";
}
print SERVREPORT "$servername,$before_entryn";
}
}
unless (close (BEFORE)) {
print "ERROR: $servername: cannot close before.services.logn";
print ERRORLOG "ERROR: $servername: cannot close before.services.logn";
}
unless (close (AFTER)) {
print "ERROR: $servername: cannot close after.services.logn";
print ERRORLOG "ERROR: $servername: cannot close after.services.logn";
}
}
# procedure p_comparelog
# compares before and after event log error files
sub p_comparelog {
my $servername = $_[0];
my $logfile = $_[1];
my $entry;
my $match;
my $before_entry;
my $after_entry;
my @before;
my @after;
my @before_split;
my @after_split;
unless (open (BEFORE, "$logdir\$servername.before.$logfile.log")) {
print "ERROR: $servername: cannot open before.$logfile.logn";
print ERRORLOG "ERROR: $servername: cannot open before.$logfile.logn";
}
unless (open (AFTER, "$logdir\$servername.after.$logfile.log")) {
print "ERROR: $servername: cannot open after.$logfile.logn";
print ERRORLOG "ERROR: $servername: cannot open after.$logfile.logn";
}
my $j = 0;
while (defined ($entry = )) {
chomp($entry);
$before[$j] = $entry;
++$j;
}
$j = 0;
while (defined ($entry = )) {
chomp($entry);
$after[$j] = $entry;
++$j;
}
foreach $after_entry (@after) {
foreach $before_entry (@before) {
@before_split = split(/,/,$before_entry);
@after_split = split(/,/,$after_entry);
if ($before_split[1] eq $after_split[1]) {
if ($before_split[2] eq $after_split[2]) {
$match = 1;
last;
}
} else {
$match = 0;
}
}
if ($match == 0) {
print "WARNING: $servername: $logfile log: $after_entryn";
print LOGREPORT "WARNING: $servername: $logfile log: $after_entryn";
}
}
unless (close (BEFORE)) {
print "ERROR: $servername: cannot close before.$logfile.logn";
print ERRORLOG "ERROR: $servername: cannot close before.$logfile.logn";
}
unless (close (AFTER)) {
print "ERROR: $servername: cannot close after.$logfile.logn";
print ERRORLOG "ERROR: $servername: cannot close after.$logfile.logn";
}
}
# procedure p_reboot
# reboots the specified server in 5 minutes or aborts reboot
sub p_reboot {
my $machine = $_[0];
my $action = $_[1];
my $count = 300;
my $force = 1;
if ($action eq "reboot") {
my $message = "This server will reboot in $count seconds";
my $restart = 1;
if (Win32::InitiateSystemShutdown($machine,$message,$count,$force,$restart)) {
print "INFO: $machine: will reboot in $count secondsn";
} else {
print "ERROR: $machine: failed to initiate shutdown: $^En";
print REBOOTLOG "ERROR: $machine: failed to initiate shutdown: $^En";
}
} elsif ($action eq "abort") {
if (Win32::AbortSystemShutdown($machine)) {
print "INFO: $machine: reboot aborted successfullyn";
} else {
print "ERROR: $machine: could not abort reboot: $^En";
print REBOOTLOG "ERROR: $machine: could not reboot: $^En";
}
} elsif ($action eq "shutdown") {
my $message = "This server will shutdown in $count seconds";
my $restart = 0;
if (Win32::InitiateSystemShutdown($machine,$message,$count,$force,$restart)) {
print "INFO: $machine: will shutdown in $count secondsn";
} else {
print "ERROR: $machine: failed to initiate shutdown: $^En";
print REBOOTLOG "ERROR: $machine: failed to initiate shutdown: $^En";
}
}
}
# procedure p_createlogpathdir
# creates a target directory for all log files based on today's date
sub p_createlogpathdir {
my $time = time();
$time = localtime($time);
my @time = split(/s+/,$time);
my $logpath = "$time[4]-$time[1]-$time[2]-$time[0]";
unless (-d $logpath) {
my $rc = `mkdir $logpath`;
unless (-d $logpath) {
die "ERROR: cannot create $logpath directory: $rcn";
}
}
return $logpath;
}
# procedure p_checktivoli
# checks dm_ep_engine.exe process is running on the remote server
#sub p_checktivoli {
# my $machine = $_[0];
# my $process_obj = 230;
# my $process_id = 784;
# my $perflib = new Win32::PerfLib($machine);
# my $proc_ref = {};
# my $keyprocess = "dm_ep_engine";
# my $match = 0;

# print "INFO: $machine: checking dm_ep_engine processn";

# $perflib->GetObjectList($process_obj, $proc_ref);
# $perflib->Close();
# my $instance_ref = $proc_ref->{Objects}->{$process_obj}->{Instances};

# foreach $p (keys %{$instance_ref}) {
# $counter_ref = $instance_ref->{$p}->{Counters};
# foreach $i (keys %{$counter_ref}) {
# next if $instance_ref->{$p}->{Name} eq "_Total";
# if($counter_ref->{$i}->{CounterNameTitleIndex} == $process_id) {
# $process{$counter_ref->{$i}->{Counter}} = $instance_ref->{$p}->{Name};
# }
# }
# }

# foreach $p (sort { $a <=> $b } keys %process) {
# if ($process{$p} =~ /dm_ep_engin/i) {
# $match = 1;
# }
# }

# unless ($match == 1) {
# print "WARNING: $machine: $keyprocess is not runningn";
# print ERRORLOG "WARNING: $machine: $keyprocess is not runningn";
# }
#}

Posted in Perl | Tagged: , , , , | Leave a Comment »

Scripts to Extract Rows and Columns from Many Excel Files

Posted by Alin D on September 25, 2010

I had to aggregate rows and columns from about 100 MS Excel spreadsheet files from different sheets in the spreadsheets, they were reports filed by a hundred different offices, all the same format. Each extract was in a tab delimited format to throw into another spreadsheet. The first script combines all the rows in many Excel files into one file. The second script combines all the columns in many Excel files into one file. Why is this a common problem? Well MSExcel is a cheap and common report and analysis tool, everyone knows Excel and therefore everyone uses it. It is a common solution to have a bunch of people fill out a spread sheet, it is common to need to combine the spreadsheets into one file to analyze them.

The code is quick, dirty and ugly to boot. But it worked like a charm, in a couple hours of scripting I saved some people many many hours of screwing around with the 100 spreadsheets cutting pasting or making errors.

# Get rows from many Excel spreadsheets in a directory
###################################
#! /usr/local/bin/perl -w
    use strict;
    use Spreadsheet::ParseExcel::Simple;

my $excel_directory = 'Budget';
my $out_directory = 'xxxout';
opendir(EXCELDIR, $excel_directory) || die ("no excel directory");
my @excelfiles = readdir(EXCELDIR);
closedir(EXCELDIR);

chdir($excel_directory);
       my $LPHname;    # String to hold Local Public Health Name.
       my @sheetarray; # Array to hold the row.
       my $sheetcount; # Array element in the row.
       my $sheetname; # Name of the Excel spreadsheet.
       my $sheettemp;  # Temporary string to hold row for join.
       my $cellnumber;  # Cell number in the row.
       my $cellwanted;  # Cell number in the row.
       my $rowwanted;  # Row number wanted.
       my $county_namecell;  # Cell for county name.
       my $county_namerow;  # Row for county name.
foreach my $exxfilename (@excelfiles){
   if ($exxfilename =~ /^.+.*/) { next; }
   my $xls = Spreadsheet::ParseExcel::Simple->read($exxfilename);
   foreach my $sheet ($xls->sheets) {
       $sheetname= $sheet->{sheet}->{Name}; # Sheet Name
       if ($sheetname !~ '2007 Budget') { next; }
       $sheetcount=0;
       $county_namecell=11;
       $county_namerow=1;
#      $cellwanted=4;
       $rowwanted=11;

       while ($sheet->has_data) {
            my @data = $sheet->next_row;
            $sheetcount++;
         if ($sheetcount==$county_namerow){
            $cellnumber=0;
            foreach my $ttcell (@data) {
                $cellnumber++;
                if ($cellnumber != $county_namecell ){next;};
                 $sheettemp=$sheetarray[$sheetcount];
#                 $sheetarray[$sheetcount]=join("t",$sheettemp,$ttcell);
                 $LPHname=$ttcell;
            }
         }

#        if (($sheetcount < ($rowwanted-1)) ||
               ($sheetcount > ($rowwanted+7))){next;}
         if ($sheetcount != $rowwanted){next;};
         $cellnumber=0;
         $sheetarray[$sheetcount]=join("t",$sheettemp,$LPHname);
         foreach my $ttcell (@data) {
            $cellnumber++;
#            if ($cellnumber != $cellwanted ){next;};
            $sheettemp=$sheetarray[$sheetcount];
            $sheetarray[$sheetcount]=join("t",$sheettemp,$ttcell);
         }
       }
    }
    foreach my $sheetline (@sheetarray){
        print $sheetline,"n";
    }
}
exit


###############################################################
# Column extract.
# Get columns from many Excel spreadsheets in a directory
###############################################################

#! /usr/local/bin/perl -w
    use strict;
    use Spreadsheet::ParseExcel::Simple;


my $excel_directory = 'TEST';
opendir(EXCELDIR, $excel_directory) || die ("no excel directory");
my @excelfiles = readdir(EXCELDIR);
closedir(EXCELDIR);

chdir($excel_directory);
       my @sheetarray; # Array to hold the row.
       my $sheetcount; # Array element in the row.
       my $sheetname; # Name of the Excel spreadsheet.
       my $sheettemp;  # Temporary string to hold row for join.
       my $cellnumber;  # cell number in the row.
       my $cellwanted;  # cell number in the row.
       my $rowwanted;  # row number wanted.
       my $county_namecell;  # cell for county name.
       my $county_namerow;  # row for county name.
foreach my $exxfilename (@excelfiles){
    if ($exxfilename =~ /^.+.*/) { next; }
    my $xls = Spreadsheet::ParseExcel::Simple->read($exxfilename);
    foreach my $sheet ($xls->sheets) {
       $sheetname= $sheet->{sheet}->{Name};


# Name the sheet to take stuff out of.
       if ($sheetname !~ '2007 Budget') { next; }
       $sheetcount=0;
       $county_namecell=11;
       $county_namerow=1;
       $cellwanted=2;
       $rowwanted=5;

       while ($sheet->has_data) {
            my @data = $sheet->next_row;
            $sheetcount++;
          if ($sheetcount==$county_namerow){
             $cellnumber=0;
             foreach my $ttcell (@data) {
                $cellnumber++;
                if ($cellnumber != $county_namecell ){next;};
                $sheettemp=$sheetarray[$sheetcount];
                $sheetarray[$sheetcount]=join("t",$sheettemp,$ttcell);
             }
          }
          if (($sheetcount < ($rowwanted)) || ($sheetcount > ($rowwanted+5)))
             {next;}
#column boundary starting from rowwanted and getting cellwanted column.
#         if ($sheetcount != $rowwanted){next;};
             $cellnumber=0;
             foreach my $ttcell (@data) {
                $cellnumber++;
                if ($cellnumber != $cellwanted ){next;};
                $sheettemp=$sheetarray[$sheetcount];
                $sheetarray[$sheetcount]=join("t",$sheettemp,$ttcell);
          }
       }
    }
}
foreach my $sheetline (@sheetarray){
    print $sheetline,"n";
}
exit

Posted in Perl, Scripting | Tagged: | Leave a Comment »

 
Follow

Get every new post delivered to your Inbox.

Join 427 other followers

%d bloggers like this: