http://www.perlmonks.org?node_id=358795

--- old Wed Jan 21 20:25:54 2004 +++ new Wed Jan 21 20:26:45 2004 @@ -1,3 +1,5 @@ +#!/usr/bin/perl + use Getopt::Long; use Win32; use Win32::OLE qw( in ); @@ -13,125 +15,54 @@ my( $fMachine, $Name ) = ( $Domain =~ /(\\\\)?(.*)$/ ); my $Class = ( "" eq $fMachine )? "domain" : "computer"; - print "WinNT://$Name,$Class"; if ( my $AD = Win32::OLE->GetObject( "WinNT://$Name,$Class" ) ) { # user accounts only $AD->{Filter} = [ "User" ]; - print "Crap\n"; foreach my $User ( in($AD) ) { - if( $User->{AccountDisabled} == $Config{disable} ) { if ($User->{Name} =~ /^[a-zA-Z]{8}?$/) { - $dn = SearchAD( "$User->{Name}" );#cw0831 adamwol +f + my $PropertyList = GetProperties( $User ); - sub SearchAD - { - ($Account) = @_; - undef $AdsPath; - $Root = Win32::OLE->GetObject("LDAP://Roo +tDSE"); - $DefaultDomainNC = $Root->Get("DefaultNam +ingContext"); - undef $Root; - if ("" eq $DefaultDomainNC) - { - Win32::MsgBox("Error. Did not get + the Default Naming Context", - MB_ICONSTOP + , "Source User Error"); - return; - } - $ADOConn = Win32::OLE->new("ADODB.Connect +ion"); - $ADOConn->{Provider} = ("ADsDSOObject"); - $ADOConn->{ConnectionString} = ($DefaultD +omainNC); - $ADOConn->Open("Active Directory Provider +"); - - $ADOCommand = Win32::OLE->new("ADODB.Comm +and"); - $ADOCommand->{ActiveConnection} = $ADOCon +n; - - $ADSQuery = "SELECT AdsPath FROM \'LDAP:/ +/$DefaultDomainNC\' WHERE samAccountName = \'$Account\' "; - $ADOCommand->{CommandText} = $ADSQuery; - $ResultSet = Win32::OLE->new("ADODB.Recor +dset"); - $ResultSet = $ADOConn->Execute($ADSQuery) +; - $AdsPath = $ResultSet->Fields(0)->{Value} +; - $ResultSet->Close; - $ADOConn->Close; - return($AdsPath); - } - - $ADSIObj = Win32::OLE ->GetObject( "$dn" ); - #$ADSIObj->MoveHere("$dn", "cn=jdoe"); - #Set usr = ou.CreateObject ("user", "cn=jsmith") - #usr.Put "samAccountName", "jsmith" - #usr.Put "userPrincipalName", jsmith@wrox.com - #usr.setInfo - my $PropertyList = GetProperties( $ADSIObj ); - - # ASP example of add user to AD - #Set ou = GetObject(".") - #Set usr = ou.CreateObject ("user", "cn=jsmith") - #usr.Put "samAccountName", "jsmith" - #usr.Put "userPrincipalName", jsmith@wrox.com - #usr.setInfo - - # ASP example of rename an object in the Active d +i - #ou = GetObject(".cn=johnd") - #ou.MoveHere (usr.ADsPath, "cn=jdoe") - -# print "\ndisplayName = $ADSIObj->{displayName}\n +"; -# my $userPrincipalName = $ADSIObj->{Name}; -# @user_name = split /=/, $userPrincipalName; - #$userPrincipalName .= "\@lbcrsed.net"; - #print "userPrincipalName = $userPrincipalName\n" +; -# $ADSIObj->{userPrincipalName} = "$user_name[1]"; - -# $givenName = $ADSIObj->{displayName}; -# $givenName =~ s/^(\w+)(.*)/$1/; - #print "givenName = $givenName\n"; -# $ADSIObj->{givenName} = "$givenName"; - - #$ADSIObj->{cn} = $ADSIObj->{displayName}; - -# $sn = $ADSIObj->{displayName}; -# $sn =~ s/^(.*)(\s)(\w+)/$3/; - #print "sn = $sn\n"; -# $ADSIObj->{sn} = "$sn"; - - #print "CN=$ADSIObj->{displayName}\n"; - #$ADSIObj->{name} = "CN=$ADSIObj->{displayName}"; - #$ADSIObj->{cn} = "$ADSIObj->{displayName}"; - #die; - - $ADSIObj->{profilePath} = ""; - $ADSIObj->SetInfo; # Don't forget to set the valu +es - -# print "\n\n$ADSIObj->{Name}\n\n"; -# my $PropertyList = GetProperties( $ADSIObj ); -# foreach ( sort( @{$PropertyList} ) ) -# { -# next if( " " eq $_ ); -# print "\t $_: $ADSIObj->{$_}\n"; -# } - die; - sub GetProperties - { - my( $Obj ) = @_; - my @Properties; - - if ( my $Schema = Win32::OLE->GetObject( $Obj +->{Schema} ) ) - { - foreach ( $Schema->{MandatoryProperties}, - $Schema->{OptionalProperties} ) - { - push( @Properties, @{$_} ) if( define +d $_ ); - } - } - return ( \@Properties ); - } + print " $Domain\\$User->{Name}\n"; + print " $User->{Profile}\n"; + $User->{Profile} = ""; + $User->SetInfo; # Don't forget to set the values + + #print "\n\n$ADSIObj->{Name}\n\n"; + #foreach ( sort( @{$PropertyList} ) ) + #{ + # next if( " " eq $_ ); + # print "\t $_: $User->{$_}\n"; + #} + print " $User->{Profile}\n\n"; + #$User->{profilePath} = "value"; + #$ADSIObj->SetInfo; # Don't forget to set the val +u ++es } + } } } +} + +sub GetProperties +{ + my( $Obj ) = @_; + my @Properties; + + if ( my $Schema = Win32::OLE->GetObject( $Obj->{Schema} ) ) + { + foreach ( $Schema->{MandatoryProperties}, + $Schema->{OptionalProperties} ) + { + push( @Properties, @{$_} ) if( defined $_ ); + } + } + return ( \@Properties ); } sub Configure

Working CGI file upload script
#!/usr/bin/perl use warnings; use strict; use CGI; use CGI::Carp qw(fatalsToBrowser); use Fcntl qw( :DEFAULT :flock ); use File::Basename; use constant UPLOAD_DIR => '/var/www/htdocs/incoming/'; use constant TYPES => qw( .txt .jpg ); use constant BUFFER_SIZE => 16_384; use constant MAX_FILE_SIZE => 1_048_576; use constant MAX_DIR_SIZE => 100 * 1_048_576; use constant MAX_OPEN_TRIES => 100; $|++; $CGI::POST_MAX = MAX_FILE_SIZE; my $q = new CGI; print STDERR $CGI::POST_MAX; sub dir_size { my $dir = shift; my $dir_size = 0; # Loop through files and sum the sizes; doesn't descend down subdi +rs. opendir DIR, $dir or error( $q, "Unable to open $dir: $!" ); my $fred; while ( $fred = readdir DIR ) { $dir_size += -s "$dir/$fred"; } return $dir_size; } { my $os = $q->param('os'); my $file = $q->param('file'); my $title = $q->param('title'); my $fh = $q->upload('file'); my $buffer = ''; if ( dir_size(UPLOAD_DIR) + $ENV{CONTENT_LENGTH} > MAX_DIR_SIZE ) +{ error( $q, 'Upload directory is full.' ); } elsif ( $file ne '' ) { fileparse_set_fstype($os); my ( $base, $path, $ext ) = fileparse( $file, qr/\..*/ ); my $num_types = scalar TYPES; my $maybe = 0; foreach my $type (TYPES) { $maybe++ if $type !~ /$ext/i; } error( $q, 'Invalid file type. Please upload only ' . join ( ' ', TYPES ) . ' files.' ) unless $maybe < $num_types; my $filename = $base . $ext; $filename =~ s/[^\w.-]/_/g; if ( $filename =~ /^(\w[\w.-]*)/ ) { $filename = $1; } else { error( $q, 'Invalid file name. Files must start with a letter or +number.' ); } # Open output file, making sure the name is unique. until ( sysopen OUTPUT, UPLOAD_DIR . "/$filename", O_RDWR | O_EXCL | O_CREAT ) { $filename =~ s/(\d*)($ext)$/($1||0) + 1 . $2/e; # $1 >= MAX_OPEN_TRIES and error( $q, 'Unable to save your +file.' ); } # This is necessary for non-Unix systems; does nothing on Unix +. binmode OUTPUT; my $bytes = 0; while ( $bytes = read( $file, $buffer, BUFFER_SIZE ) ) { print OUTPUT $buffer or croak $!; } close OUTPUT or croak ($!); print $q->header, $q->start_html( -title => 'Successful Upload +!', ), $q->h1('Your file was successfully uploaded!'), $q->end_html +; } else { error( $q, 'You must specify a file to upload.' ); } } sub error { my $q = shift; my $error = shift; croak($error); }

Getting started programming perl on Win32

Most tutorials on the internet make the assumption that you use perl installed on a *nix based operating system like Redhat Linux, not on a "Win32" system like Windows 95, 98 or NT. They are the most part similar since perl is perl but there are differences.

Getting Perl

Perl is packaged and maintained by our friends at Active State and is called ActivePerl. To start the download process you go to here. You can choose either the active package or the windows installer (MSI) version. To install the MSI version you will need to have windows installer on your computer. If you have Windows XP you will most likely already have it. Otherwise you can download it from Microsoft here for 95,98, or Me or here for NT and 2000

Your first perl program

A perl program is a text file that contain instructions for the computer to perform written in the perl language. Hence you need to enter these instructions using a text editor such as Notepad. You can buy other editors such as Ultraedit and Komodo. One of the advantages of these editors is that they can highlight words using different colours with special meanings for the perl language aiding you learning.

The first program to type in would be a simple one that prints "Hello, World!" on the screen. Start your editor and type in the following

print 'Hello, World\n";

Save it to the hard disk with an extension of .pl. This will tell windows that it is a perl script.

NOTE: If you use notepad make sure to change the file type in the save as dialog to any file. If you leave it as Text File (*.txt) Notepad will sometimes save the file as filename.pl.txt. Since the last extension is .txt double clicking on the file will open it in Notepad and not run the script.

To run perl scripts you normally just have to double click on them. Since this prints to the command prompt window double clicking on this will bring up a black box that will diassappear before you see anything. Instead to run this program click start then run and type in the name of the command interpreter. For Windows 95, 98 and Me it is command. For Windows NT 2000 and XP it is cmd. Once the black command prompt window change to the directory where the script is and type in the name of the script with .pl. I saved mine as hello.pl in the root directory of my c drive so I did

c: cd\ hello.pl

You should see the following

c:\> hello.pl Hello, World c:\>

Things to note when reading code written for *nix platforms.

When you see

#!/usr/bin/perl

This is what tells the *nix command interpreter(shell) or similar you can translate it to

#!c:\perl\bin\perl

But on the Windows platform this is indicated by the .pl extension.


isn't unless ! $c the same than if $c ?
Lessons learned from getting to 100% with Devel::Cover
Contribute a hack to the new "Perl Hacks" book
Orcish Maneuver