Never been to DZone Snippets before?

Snippets is a public source code repository. Easily build up your personal collection of code snippets, categorize them with tags / keywords, and share them with the world

« Newer Snippets
Older Snippets »
Showing 11-20 of 96 total

Internet Explorer automation using win32::OLE

// Sample code used for one of my client
#!/usr/bin/perl -w

use strict;
use Data::Dumper;
use Win32::OLE qw( EVENTS );

my ($day, $mon, $year, $hour, $min, $sec) = (localtime)[3, 4, 5, 2, 1, 0];
$mon++; # 0-based index
$year = $year + 1900;
my $date = sprintf ("%04i-%02i-%02i %02i\:%02i\:%02i", $year, $mon, $day, $hour, $min, $sec);

my $Disconnect;
my $Menu;
my $TreeView;
my $WatchDog;
my $MenuClicked=0;

my $ScenarioCompleted=0;

my @TreeViewLinks=("Appareillage du B","Branchement Comptage","Branchement individuel");
my $Previouslink=$TreeViewLinks[0];

my $ie = Win32::OLE->new( 'InternetExplorer.Application' ) or die "error starting IE";
$ie->{visible} = 1;

Win32::OLE->Option( Warn => 3 );

$WatchDog=time();
Win32::OLE->WithEvents( $ie, \&Event, 'DWebBrowserEvents2' );
$ie->navigate( 'http://www.xxx.fr' );
Win32::OLE->MessageLoop();
unlink("noemis.err") if -f "noemis.err";
if ( ! $ScenarioCompleted ) {
	open( ERR , ">noemis.err" ); 
	print ERR "Problem executing Noemis scenario, please check www.xxx.fr.\n" ;
	close(ERR);
}
$Disconnect->Click();
Win32::OLE->SpinMessageLoop;

# Maintenance du fichier historique
open ( STATS , "noemis.txt" );
my @lines=<STATS>;
close (STATS);
open( STATS , ">noemis.txt" ); 
for my $line (@lines) {
	my ($datetime) = split ( /;/ , $line );
	my ($h_year,$h_mon) = $datetime =~ /^([0-9]{4})-([0-9]{2})/;
	print STATS $line if ($year*12+$mon) - ($h_year*12+$h_mon) < 2;
}
print STATS join(";",$date,"Noemis Scenario",( time() - $WatchDog ))."\n";
close( STATS );

sleep 2;
Win32::OLE->SpinMessageLoop;
sleep 1;
$ie->Quit();
exit 0;


sub Event {
	my ($Obj,$Event,@Args) = @_;
	my $IEObject = shift @Args;
	print " Event triggered: $Event\n";    

	my ($i,$anchor);
	my $anchors;
    
	# STEP 1 : Find the main menu, login to the web site, find the treeview
	if ($Event eq "DocumentComplete") {    
		print "URL: " . $IEObject->Document->URL . "\n";
		if ( $IEObject->Document->URL eq "http://www.xxx.fr/ident.aspx" ) {
			my $forms = $IEObject->Document->forms;
			my $form = $forms->item(0);
			if ( defined($form->elements("fldNumCli")) ) {
				print "--------------------------------------------\n";
				print "Found the login box, authenticating ...\n";
				print "--------------------------------------------\n";
			    $form->elements("fldNumCli")->{value} = "xxxx";
			    $form->elements("fldUtil")->{value} = "xxx";
			    $form->elements("fldPwd")->{value} = "xxx";
		    	$form->elements("btIdent")->Click();
	    		}
		}
		if ( $IEObject->Document->URL eq "http://www.xxx.fr/menu.aspx" ) {
			print "Found the menu.\n";
			$Menu = $IEObject->Document;
			$anchors = $IEObject->Document->links;
			for (my $i=0; $i < $anchors->length; $i++) {
				$anchor = $anchors->item($i);
				print $anchor->href."\n";
				$Disconnect = $anchor if $anchor->href eq "http://www.xxx.fr/ident.aspx?qs=deconnecter";
			}
	      	}	    
		if ( $IEObject->Document->URL eq "http://www.xxx.fr/client/frameTreeview.aspx" ) {
			print "Found the TreeView.\n";
			$TreeView = $IEObject->Document;
      		}		
	}

	# STEP 2 : Click on the Menu and TreeView links   
	if ($Event eq "DocumentComplete") {    		
	if ( ! $MenuClicked and defined($Menu) ) {
		my $MenuItem = $Menu->getElementById("SM_CLIE_RECH");
		if ( defined($MenuItem) ) { 
			print $MenuItem->ID."\n";
			$MenuItem->Click;
			$MenuClicked = 1;
		}
	}}

	if ( $Event eq "CommandStateChange" or $Event eq "StatusTextChange" ) {
		print Dumper($IEObject);
	}
	if ( @TreeViewLinks != 0 and 
	     defined($TreeView) and 
	     $Event eq "DocumentComplete" 
	) {
		my $link = shift(@TreeViewLinks);
		$anchors = $TreeView->links;
		my $found=0;
		print "Looking for '$link' in the TreeView ... \n";
	        for (my $i=0; $i < $anchors->length; $i++) {
		       	$anchor = $anchors->item($i);
	        	#print $anchor->innerHTML."\n";
		       	if ( $anchor->innerHTML =~ /$link/ ) {
				print "Clicking on '$link' ... \n";
	                	$anchor->Click;
				$found=1;
				$Previouslink=$link;
				last;
			}
	        }
		if ( ! $found ) { 
			# Le TreeView a bugge, on reclique
			sleep 1;
			print "Looking for '$Previouslink' in the TreeView ... \n";
		        for (my $i=0; $i < $anchors->length; $i++) {
			       	$anchor = $anchors->item($i);
	        		#print $anchor->innerHTML."\n";
		       		if ( $anchor->innerHTML =~ /$Previouslink/ ) {
					print "Clicking on '$Previouslink' ... \n";
	              		  	$anchor->Click;
					last;
				}
		        }
			unshift @TreeViewLinks,$link;
		}
	} 
   
	# STEP 3 : Verify the list displayed 
		
	if ($Event eq "DocumentComplete") {    
   		if ( @TreeViewLinks == 0 and $IEObject->Document->URL =~ /listeRefPlof.aspx/ ) {
			print "Scenario completed, exiting ...\n";
			$ScenarioCompleted=1;
	   		Win32::OLE->QuitMessageLoop;
		}
	}
    

	# Exit on errors
	    
	Win32::OLE->QuitMessageLoop() if $Event eq "OnQuit" or time() > $WatchDog + 60;
    
}
to windows perl internet explorer ole by bouffon69 on Sep 28, 2007

Simple output of date in perl

// Simple output of current date in perl

  my @day_name = ("Sun.","Mon.","Tue.","Wed.","Thu.","Fri.","Sat.");
  my ($sec,$min,$hour,$mday,$mon,$year,$wday); 
  ($sec,$min,$hour,$mday,$mon,$year,$wday,undef,undef)=localtime(time()); $year+=1900;$mon++;
  $report_date=sprintf("%s %04d.%02d.%02d %02d:%02d",$day_name[$wday],$year,$mon,$mday,$hour,$min);
to date perl format current by bouffon69 on Sep 07, 2007 1 Comments

unix wizards of the realm:

// SVN ignore based on .cvsignore file:

svn propset svn:ignore -F .cvsignore .


// grep:
  … with line number: -n
  … with file name: -H


// os x housekeeping:


// install perl module:
sudo perl -MCPAN -e 'install Bundle::LWP'



// meta refresh (i have never typed this line start to finish in my life. i have probably copy-pasted it 7,000 times
<meta http-equiv=Refresh content="0; URL=http://blog.jm3.net/" />



// get files off codeswami:
ssh -l cs 208.101.26.91



// SQL tricks:
http://jm3.net/cgi-bin/safe/wiki.pl?MySqlLibrary


		
to sql unix mysql perl grep svn   by jm3 on Aug 19, 2007 
	
	
		

  







	

    
PHP : Comprobar e-mail válido / Check valid e-mail


		
Comprobar e-mail válido / Check valid e-mail
Código fuente / Source code :

function esEmailValido($email)
{
    if (ereg("^[_a-zA-Z0-9-]+(\.[_a-zA-Z0-9-]+)*@([_a-zA-Z0-9-]+\.)*[a-zA-Z0-9-]{2,200}\.[a-zA-Z]{2,6}$", $email ) )
	{
       return true;
    }
	else
	{
       return false;
    }
}



		
to regular php perl email check ereg expresion   by Ricardo on Jul 23, 2007 
	
	
		

  







	

    
Tabs-to-space function


		
This Perl function returns its argument with any tabs it contained converted into the appropriate number of spaces.
sub tabs2space($) {
 my $str = shift;
 1 while $str =~ s/\t+/' ' x (length($&)*8 - length($`)%8)/e;
 return $str;
}


		
to perl text text formatting   by Minimiscience on Jul 06, 2007 
	
	
		

  







	

    
basename & dirname in Perl


		
These two Perl functions implement approximations of the UNIX utilities `basename` and `dirname`, though basename() automatically strips off the last extension no matter what.
sub basename($) {
 my $file = shift;
 $file =~ s!^(?:.*/)?(.+?)(?:\.[^.]*)?$!$1!;
 return $file;
}

sub dirname($) {my $file = shift; $file =~ s!/?[^/]*/*$!!; return $file; }


		
to unix files perl directory filesystem file extension   by Minimiscience on Jul 06, 2007 1 Comments
	
	
		

  







	

    
Dice roller


		
Given a di(c)e roll in standard d20 format on the command line, this script will roll the dice & output the result.
#!/usr/bin/perl -wl
use strict;
$_ = shift or die 'Invalid argument passed';
s/\s+//g;
/^(\d+)[dD](\d+)([+-]\d+)?$/ or die 'Invalid argument passed';
my $sum = 0;
$sum += 1 + int rand $2 for 1..$1;
$sum += $3 if defined $3;
print $sum;



		
to perl games d20 RNG   by Minimiscience on Jul 04, 2007 
	
	
		

  







	

    
Hexadecimal-to-text converter


		
This script converts all 2-digit hexadecimal numbers (without 0x's) in the standard input into text, though there's probably a better way to do this.
#!/usr/bin/perl -wn
use strict;
s/\s//g;
print chr hex $1 while /([[:xdigit:]]{2})/g;
print "\n";



		
to perl text hexadecimal ascii   by Minimiscience on Jul 04, 2007 
	
	
		

  







	

    
File extension counter


		
Produces a count of the frequencies of each file extension in the directories named on the command line
#!/usr/bin/perl -w
use strict;
my %exten;
foreach (@ARGV) {
 /(\.[^.]+)$/ && $exten{$1}++ foreach glob "$_/*.*"
}
print "$_: $exten{$_}\n" foreach sort keys %exten;



		
to files perl filesystem file extension   by Minimiscience on Jul 04, 2007 
	
	
		

  







	

    
Binary-to-text converter


		
Converts all 8-bit binary numbers in the standard input into text, though there's probably a better way to do this
#!/usr/bin/perl -wn
use strict;
s/\s//g;
print chr oct "0b$1" while /([01]{8})/g;
print "\n";



		
to perl text binary ascii   by Minimiscience on Jul 04, 2007 
	
	
		

  




	





    « Newer Snippets
    

    Older Snippets »
Showing 11-20 of 96 total