#!/usr/bin/perl

use Tk;
use Tk::ROText;
use strict;
use Tk::TextUndo;
use Tk::Checkbutton;
use Tk::Entry;
use Tk::Label;
use Tk::Menu;
use Tk::Scrollbar;
use Tk::DummyEncode;
use Tk::Widget;
use Tk::Optionmenu;
use Tk::Bitmap;
use Tk::Canvas;
# <winbase.h>
#define SP_STOPBITS       ((DWORD)0x0008)
#define STOPBITS_10       ((WORD)0x0001)
#define STOPBITS_15       ((WORD)0x0002)
#define STOPBITS_20       ((WORD)0x0004)
#define ONESTOPBIT          0
#define ONE5STOPBITS        1
#define TWOSTOPBITS         2

#use Tk::ItemStyle;

#perl2exe_include "Tk/arrowdownwin.xbm"
#perl2exe_include "utf8.pm"
#perl2exe_include "unicore/lib/gc_sc/Word.pl";
#perl2exe_include "unicore/lib/gc_sc/Digit.pl";
#perl2exe_include "unicore/lib/gc_sc/SpacePer.pl";
#perl2exe_include "unicore/To/Lower.pl";
#perl2exe_include "unicore/lib/gc_sc/Cntrl.pl";
#perl2exe_include "unicore/lib/gc_sc/ASCII.pl";
#perl2exe_include "unicore/To/Fold.pl";


my $handler = undef;
my $pollDo = 0;
my $mtrTimeout = 3;
my $oldCom = 0;
my $debugPort = 0;
my $autoDetect = 1;
my $RS232 = ($^O eq 'MSWin32') ? "COM1":"/dev/ttyS0";
my $pollDelay = 100;
my $mtrPort = $RS232;
my $textOutput = undef;
my $SB = 0;
my $GB = 0;
my $from = 1;
my $to = 2048;
my $info;
my $doemptybuffer=0;
my $dofetchempty=1;
my $readMode = 1;
my $lastEC;

my $try = 1;
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time());
$sec = sprintf("%02d",$sec);
$min = sprintf("%02d",$min);
$hour = sprintf("%02d",$hour);
$mday = sprintf("%02d",$mday);
$mon = sprintf("%02d",$mon+1);
$year = sprintf("%02d",$year%100);

my $labelInfo = undef;
my $statusInfo = "";

# Win32
my $_CreateFile;
my $_CloseHandle;
my $_GetCommState;
my $_SetCommState;
my $_SetCommTimeouts;
my $_GetCommProperties;
my $_ReadFile;
my $_WriteFile;
my $DCBformat="LLLSSSCCCCCCCCS";
my $TIMEOUTformat="LLLLL";
my $RS232format="SSLLLLLLLLLSSLLLLSA*";
my $CP_format0="SA50LA244";				 # pre-read
my $CommPropBlank = " ";
my $filename = "";
my $doSave = 0;
my @stopBitsText = ( "1", "1.5", "2");
my @parityText = ( "none","odd","wven","mark","space" );
sub CreateFile {return $_CreateFile->Call( @_ );}
sub CloseHandle {return unless (1 == @_); return $_CloseHandle->Call( shift );}
sub GetCommState {return $_GetCommState->Call( @_ );}
sub SetCommState {return $_SetCommState->Call( @_ );}
sub SetCommTimeouts {return $_SetCommTimeouts->Call( @_ );}
sub ReadFile {return $_ReadFile->Call( @_ );}
sub WriteFile { return $_WriteFile->Call( @_ );}
sub GetCommProperties { return $_GetCommProperties->Call( @_ );}
sub COMMPROP_INITIALIZED { 0xe73cf52e }
sub PST_RS232 { 0x1 }
sub SP_SERIALCOMM	{ 0x1 }
sub FM_fDummy2			{ 0xffff8000 }



eval ' require Win32::API; ';
if(!$@){
    require Win32::API;                                                                    #
    Win32::API->import();		 					               #
    
    no strict;
    $_CreateFile = new Win32::API("kernel32", "CreateFile", [P, N, N, N, N, N, N], N);     #
    $_CloseHandle = new Win32::API("kernel32", "CloseHandle", [N], N);		       #
    $_GetCommState = new Win32::API("kernel32", "GetCommState", [N, P], I);	               #
    $_SetCommState = new Win32::API("kernel32", "SetCommState", [N, P], I);	               #
    $_SetCommTimeouts = new Win32::API("kernel32", "SetCommTimeouts", [N, P], I);          # 
    $_GetCommProperties = new Win32::API("kernel32", "GetCommProperties", [N, P], I);      #
    $_ReadFile = new Win32::API("kernel32", "ReadFile", [N, P, N, P, P], I);               #
    $_WriteFile = new Win32::API("kernel32", "WriteFile", [N, P, N, P, P], I);             #
    use strict;
}


# Top Window
my $top = MainWindow->new();
$top->title("MTR Debug Tool © 2005-2006 by Thierry Matthey");
$top->iconname("MTR Tool");
$top->geometry("+32+32");

$top->Label(-text => "MTR Configuration", 
	    -relief => 'groove', 
	    -borderwidth => 4, 
	    -background => 'white'
	    )->pack(-side => "top", 
		    -fill => 'x');
my $frameConfig = $top->Frame()->pack(-side => "top", 
				      -fill => 'x');
$frameConfig->Button(-text => "Get Ports", 
		     -command => sub {
			 my @ports = getPorts();
			 for(my $i=0;$i<=$#ports;$i+=2){
			     printing("$ports[$i] : $ports[$i+1]\n");

			 }
		     }
		     )->pack(-side => "left", 
			     -fill => 'x');
my $mtr250;
$mtr250 = $frameConfig->Button(-text => "MTR", 
				  -width => 4, 
				  -command => sub { 
              return if ($pollDo);
              $readMode = ($readMode == 1 ? 2 : 1);
              if($readMode == 1){
                  $mtr250->configure(-text       => 'MTR');
              }
              else
              {
                  $mtr250->configure(-text       => '250');
              }



				  }
				  )->pack(-side => "left", 
					  -fill => 'x');

 $frameConfig->Button(-text => "Peek", 
				  -command => sub { 
              if ($pollDo){
                  printing("can't peek while polling!\n");
              }
              else {    
                  my $peek = peekPort($mtrPort);
                  if($peek ne ""){
                      printing("actual RS232 settings: $peek\n");
                  }
                  else {
                      printing("peeking failed!\n");                      
                  }
              }
				  }
				  )->pack(-side => "left", 
					  -fill => 'x');

my $openClose;
$openClose = $frameConfig->Button(-text => "Open", 
				  -width => 5, 
				  -command => sub { 
				      $lastEC = "";
				      if($pollDo){
					  printing("stop\n");
					  $pollDo = 0;
					  $openClose->configure(-text       => 'Open');
				      }
				      else {
					  printing("open & listen to port, ".($readMode == 1 ? "MTR" :"250")." mode.\n");
					  if(!($handler=openPort($mtrPort))){
					      $pollDo = 0;
					      $handler= undef;
					      printing("Can't open $mtrPort for polling.\n");
					  }
					  else {
					      printing("Open $mtrPort for polling.\n");
                printing("Using ".isMTROr250($handler)." protocol.\n");
					      $pollDo = 1;
					      $top->after($pollDelay,\&pollMtr);
					  }
					  if($pollDo){
					      $openClose->configure(-text       => 'Stop');
					  }
				      }
				  }
				  )->pack(-side => "left", 
					  -fill => 'x');

$frameConfig->Label(-text => 'Port:')->pack(-side => "left", 
					    -fill => 'x');

$frameConfig->Entry(-width => 10,
		    -textvariable => \$mtrPort
		    )->pack(-side => "left", 
			    -fill => 'x');

$frameConfig->Checkbutton(-text => "Auto detect",
			  -variable    => \$autoDetect, 
			  -onvalue =>  1, 
			  -offvalue => 0
			  )->pack(-side => "left", 
				  -fill => 'x');

$frameConfig->Checkbutton(-text => "OldCom",
			  -variable    => \$oldCom, 
			  -onvalue =>  1, 
			  -offvalue => 0
			  )->pack(-side => "left", 
				  -fill => 'x');

$frameConfig->Checkbutton(-text => "Debug Calls",
			  -variable    => \$debugPort, 
			  -onvalue =>  1, 
			  -offvalue => 0
			  )->pack(-side => "left", 
				  -fill => 'x');
$frameConfig->Checkbutton(-text => "Busy wait polling",
			  -variable    => \$try, 
			  -onvalue =>  0, 
			  -offvalue => 1
			  )->pack(-side => "left", 
				  -fill => 'x');


$frameConfig->Label(-text => 'Timeout [s]:')->pack(-side => "left", 
					       -fill => 'x');
$frameConfig->Entry(-width => 2,
		    -textvariable => \$mtrTimeout, 
		    -validate => 'all', 
		    -validatecommand => sub {
			return ((($_[1] =~/[0-9]/ || $_[1] eq '')  && $_[4] > 0 && $_[3] <2) || $_[4] <= 0);
		    }
		    )->pack(-side => "left", 
			    -fill => 'x');

$frameConfig->Label(-text => ' Polling delay [ms]:')->pack(-side => "left", 
					       -fill => 'x');

$frameConfig->Entry(-width => 5,
		    -textvariable => \$pollDelay, 
		    -validate => 'all', 
		    -validatecommand => sub {
			return ((($_[1] =~/[0-9]/ || $_[1] eq '')  && $_[4] > 0 && $_[3] <5) || $_[4] <= 0);
		    }
		    )->pack(-side => "left", 
			    -fill => 'x');

$frameConfig->Button(-text => "Quit", 
		     -command => sub { 	closePort($handler);
					$handler = undef;
					exit 0;}
		     )->pack(-side => "right", 
                 -fill => 'x', 
                 -expand => 'yes');


$top->Label(-text => "Commands", 
	    -relief => 'groove', 
	    -borderwidth => 4, 
	    -background => 'white'
	    )->pack(-side => "top", 
		    -fill => 'x');
my $frameCmd = $top->Frame()->pack(-side => "top", 
				   -fill => 'x');

$frameCmd->Button(-text => "Status", 
		  -command => sub {
		      printing("Status\n");
		      if(!writePort($handler,"/ST")){
			  printing("Can't write!\n");
		      }
		      printing("Status done\n");
		  }
		  )->pack(-side => "left", 
			     -fill => 'x');

$frameCmd->Button(-text => "Clear", 
		  -command => sub {
		      printing("Clear\n");
		      if(!writePort($handler,"/CL")){
			  printing("Can't write!\n");
		      }
		      printing("Clear done\n");
		  }
		  )->pack(-side => "left", 
			  -fill => 'x');
$frameCmd->Button(-text => "Spool all", 
		  -command => sub {
		      printing("Spool all\n");
		      if(!writePort($handler,"/SA")){
			  printing("Can't write!\n");
		      }
		      printing("Spool all done\n");
		  }
		  )->pack(-side => "left", 
			  -fill => 'x');

$frameCmd->Button(-text => "Spool from", 
		  -command => sub {
		      printing("Spool from $SB\n");
		      if(!writePort($handler,"/SB".pack("V",$SB))){
			  printing("Can't write!\n");
		      }
		      printing("Spool from $SB done\n");
		  }
		  )->pack(-side => "left", 
			  -fill => 'x');
$frameCmd->Entry(-width => 6,
		 -textvariable => \$SB, 
		 -validate => 'all', 
		 -validatecommand => sub {
		     return ((($_[1] =~/[0-9]/ || $_[1] eq '')  && $_[4] > 0 && $_[3] <6) || $_[4] <= 0);
		 }
		 )->pack(-side => "left", 
			 -fill => 'x');
my $frameCmdGet;
$frameCmdGet =
    $frameCmd->Button(-text => "Get", 
		      -command => sub {
			  printing("Get $GB\n");
			  if(!writePort($handler,"/GB".pack("V",$GB))){
			      printing("Can't write!\n");
			  }
			  printing("Get $GB done\n");
		      }
		      )->pack(-side => "left", 
			      -fill => 'x');
$frameCmd->Entry(-width => 6,
		 -textvariable => \$GB, 
		 -validate => 'all', 
		 -validatecommand => sub {
		     return ((($_[1] =~/[0-9]/ || $_[1] eq '')  && $_[4] > 0 && $_[3] <6) || $_[4] <= 0);
		 }
		 )->pack(-side => "left", 
			 -fill => 'x')->bind('<Key-Return>' => sub{ $frameCmdGet->invoke();});
$frameCmd->Button(-text => "Clock", 
		  -command => sub {
		      printing("Set clock\n");
		      if(!writePort($handler,"/SC".pack("CCCCCC",$year,$mon,$mday,$hour,$min,$sec))){
			  printing("Can't write!\n");
		      }
		      printing("Set clock done\n");
		  }
		  )->pack(-side => "left", 
			  -fill => 'x');
$frameCmd->Entry(-width => 2,
		 -textvariable => \$year,
		 -validate => 'all', 
		 -validatecommand => sub {
		     return ((($_[1] =~/[0-9]/ || $_[1] eq '')  && $_[4] > 0 && $_[3] <2) || $_[4] <= 0);
		 }
		 )->pack(-side => "left", 
			 -fill => 'x');
$frameCmd->Label(-justify => 'left', -text => '/')->pack(-side   => "left", -fill => 'x');
$frameCmd->Entry(-width => 2,
		 -textvariable => \$mon,
		 -validate => 'all', 
		 -validatecommand => sub {
		     return ((($_[1] =~/[0-9]/ || $_[1] eq '')  && $_[4] > 0 && $_[3] <2) || $_[4] <= 0);
		 }
		 )->pack(-side => "left", 
			 -fill => 'x');
$frameCmd->Label(-justify => 'left', -text => '/')->pack(-side   => "left", -fill => 'x');
$frameCmd->Entry(-width => 2,
		 -textvariable => \$mday,
		 -validate => 'all', 
		 -validatecommand => sub {
		     return ((($_[1] =~/[0-9]/ || $_[1] eq '')  && $_[4] > 0 && $_[3] <2) || $_[4] <= 0);
		 }
		 )->pack(-side => "left", 
			 -fill => 'x');
$frameCmd->Label(-justify => 'left', -text => '-')->pack(-side   => "left", -fill => 'x');
$frameCmd->Entry(-width => 2,
		 -textvariable => \$hour,
		 -validate => 'all', 
		 -validatecommand => sub {
		     return ((($_[1] =~/[0-9]/ || $_[1] eq '')  && $_[4] > 0 && $_[3] <2) || $_[4] <= 0);
		 }
		 )->pack(-side => "left", 
			 -fill => 'x');
$frameCmd->Label(-justify => 'left', -text => ':')->pack(-side   => "left", -fill => 'x');
$frameCmd->Entry(-width => 2,
		 -textvariable => \$min,
		 -validate => 'all', 
		 -validatecommand => sub {
		     return ((($_[1] =~/[0-9]/ || $_[1] eq '')  && $_[4] > 0 && $_[3] <2) || $_[4] <= 0);
		 }
		 )->pack(-side => "left", 
			 -fill => 'x');
$frameCmd->Label(-justify => 'left', -text => ':')->pack(-side   => "left", -fill => 'x');
$frameCmd->Entry(-width => 2,
		 -textvariable => \$sec,
		 -validate => 'all', 
		 -validatecommand => sub {
		     return ((($_[1] =~/[0-9]/ || $_[1] eq '')  && $_[4] > 0 && $_[3] <2) || $_[4] <= 0);
		 }
		 )->pack(-side => "left", 
			 -fill => 'x');
$frameCmd->Button(-text => "Get range", 
		  -command => sub {
		      if(!writePort($handler,"/ST")){
			  printing("Can't write!\n");
			  return
		      }
		      my ($ok,$type,$count,$size,$mtrid,$line,$tmp,$maxr,$all,@rec) = readRecord($handler,$mtrTimeout,0);
		      if(!$ok){
			  printing("Can't read status!\n");
			  return;
		      }
		      $from = 1;
		      $to = 1;
		      $tmp =$line;
		      
		      $tmp =~ s/[=a-zA-Z]//g;
		      $tmp =~ s/\./\,/g;
		      @rec = split(/\,/,$tmp);
		      shift @rec;
		      shift @rec;
		      shift @rec;
		      printing("@rec\n");
		      for my $i (0 .. $#rec){
			  $to = $rec[$i] if($rec[$i] > $to);
		      }
		      printing("Range: $from,$to\n");
		  }
		  )->pack(-side => "left", 
			  -fill => 'x');

$frameCmd->Button(-text => "Spool range", 
		  -command => sub {
		      printing("Fetch from $from to $to\n");
		      if($doSave && !open(outputFile,">>$filename")){
			  $doSave = 0;
			  printing("Can't save to '$filename'\n");
		      }
		      for(my $i=$from;$i<=$to;$i++){
			  if(!writePort($handler,"/GB".pack("V",$i))){
			      printing("Can't write!\n");
			      return;
			  }
			  my ($ok,$type,$count,$size,$line,$status,$pollRec,$all,@rec) = readRecord($handler,$mtrTimeout,0);
			  if($ok && ($type eq "M" || $type eq "X") && $doSave){
			      print outputFile $line,"\n" if($ok && ($type eq "M" || $type eq "X"));
			  }
			  printing ("$line\n") if($ok && ($type eq "M" || $type eq "X"));
			  $statusInfo = "$i : $type";
			  if(!$ok && $doemptybuffer){
			      $statusInfo = $statusInfo .". ".emptyBuffer($handler,$mtrTimeout);
			  }
			  $labelInfo->update;  
			  if($dofetchempty && $ok && $type eq "M" && $i == $to){
			      $to++;
			  }
		      }
		      close(outputFile) if($doSave);
		      printing("Fetch from $from to $to done\n");
		  }
		  )->pack(-side => "left", 
			  -fill => 'x');
$frameCmd->Entry(-width => 6,
		 -textvariable => \$from, 
		 -validate => 'all', 
		 -validatecommand => sub {
		     return ((($_[1] =~/[0-9]/ || $_[1] eq '')  && $_[4] > 0 && $_[3] <6) || $_[4] <= 0);
		 }
		 )->pack(-side => "left", 
			 -fill => 'x');
$frameCmd->Entry(-width => 6,
		 -textvariable => \$to, 
		 -validate => 'all', 
		 -validatecommand => sub {
		     return ((($_[1] =~/[0-9]/ || $_[1] eq '')  && $_[4] > 0 && $_[3] <6) || $_[4] <= 0);
		 }
		 )->pack(-side => "left", 
			 -fill => 'x');
$frameCmd->Checkbutton(-text => "Empty buffer errors",
			  -variable    => \$doemptybuffer, 
			  -onvalue =>  1, 
			  -offvalue => 0
			  )->pack(-side => "left", 
				  -fill => 'x');
$frameCmd->Checkbutton(-text => "Read until non-empty",
			  -variable    => \$dofetchempty, 
			  -onvalue =>  1, 
			  -offvalue => 0
			  )->pack(-side => "left", 
				  -fill => 'x');
my $frameInfo = $top->Frame()->pack(-side => "top", 
				    -fill => 'x');
$labelInfo = $frameInfo->Label(-justify => 'left', 
			       -textvariable => \$statusInfo)->pack(-side => "left",
								    -fill => 'x');

$top->Label(-text => "I/O", 
	    -relief => 'groove', 
	    -borderwidth => 4, 
	    -background => 'white'
	    )->pack(-side => "top", 
		    -fill => 'x');
my $frameIO = $top->Frame()->pack(-side => "top", 
				  -fill => 'x');

$frameIO->Button(-text => "Get machine time", 
		  -command => sub {
		      ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time());
		      $sec = sprintf("%02d",$sec);
		      $min = sprintf("%02d",$min);
		      $hour = sprintf("%02d",$hour);
		      $mday = sprintf("%02d",$mday);
		      $mon = sprintf("%02d",$mon+1);
		      $year = sprintf("%02d",$year%100);
		  })->pack(-side   => "left", 
			   -fill => 'x');
$frameIO->Button(-text => "Clear window", 
		 -command => sub { $textOutput->delete("1.0", "end");}
		 )->pack(-side => "left", 
			 -fill => 'x');
$frameIO->Checkbutton(-text => "Save & append to:",
		      -variable    => \$doSave, 
		      -onvalue =>  1, 
		      -offvalue => 0
		      )->pack(-side => "left", 
			      -fill => 'x');
$frameIO->Entry(-width => 30,
		-textvariable => \$filename, 
		)->pack(-side => "left", -expand => 'yes', -fill => 'x');
$frameIO->Button(-text => "Browse ...", 
		 -command => sub {
		     my $fn = $top->getSaveFile(-parent => $top,
						-initialfile => removeDirPath($filename), 
						-title => 'Filename MTR logfile', 
						-filetypes=>[['MTR Logiles',       ['.log','.txt','.text','.LOG','.TXT','.TEXT'], 'TEXT'],
							     ['All Files',        '*',             ],]);
		     return unless (defined($fn) && length($fn));
		     $filename= $fn;
		     $doSave = 1;
		 })->pack(-side   => "left", -fill => 'x');
$frameIO->Button(-text => "Clear file", 
		 -command => sub {
		     if(open(outputFile,">$filename")){
			 close(outputFile);
			 printing("Cleared '$filename'\n");
		     }
		     else {
			 printing("Can't clear '$filename'\n");
		     }
		 }
		 )->pack(-side   => "left", -fill => 'x');

$textOutput = $top->Scrolled('ROText', -scrollbars => 'se')->pack(-expand => 'yes', -fill => 'both',  -side => 'top');
$textOutput->configure(-wrap => 'none');
$textOutput->configure(-state => "normal");


$top->protocol('WM_DELETE_WINDOW' => sub { closePort($handler);
					   $handler = undef;
					   exit 0;});

# bind wheel
if ($^O eq 'MSWin32') {
    $top->bind('<MouseWheel>' =>
	       [ sub { $textOutput->yview('scroll', -($_[1] / 120) * 3, 'units') },
		 Ev('D') ]
	       );
}
else {
    
    # Support for mousewheels on Linux commonly comes through
    # mapping the wheel to buttons 4 and 5.  If you have a
    # mousewheel ensure that the mouse protocol is set to
    # "IMPS/2" in your /etc/X11/XF86Config (or XF86Config-4)
    # file:
    #
    # Section "InputDevice"
    #     Identifier  "Mouse0"
    #     Driver      "mouse"
    #     Option      "Device" "/dev/mouse"
    #     Option      "Protocol" "IMPS/2"
    #     Option      "Emulate3Buttons" "off"
    #     Option      "ZAxisMapping" "4 5"
    # EndSection	
    $top->bind('<4>' => sub {
	$textOutput->yview('scroll', -3, 'units') unless $Tk::strictMotif;
    });
    
    $top->bind('<5>' => sub {
	$textOutput->yview('scroll', +3, 'units') unless $Tk::strictMotif;
    });
}

MainLoop;

exit;


##################################################################
sub printing {
##################################################################
    my $str = shift;
    $textOutput->insert("end", $str);
    $textOutput->yview('end');
    $textOutput->update;
}

##################################################################
sub pollMtr {
##################################################################
    return unless defined($handler);
    if(!$pollDo){	
	printing("Closing poll port.\n");
	closePort($handler);
	$handler = undef;
	return;
    }
    my ($ok,$type,$count,$size,$line,$status,$pollRec,$all,@rec) = readRecord($handler,$mtrTimeout,$try);
    if($count > 0){
	$statusInfo = "$pollRec : $type";
	$labelInfo->update;
    }  
    printing("$ok,$type,$count,$size,$line,$status,$pollRec\n") if($count > 0);
    printing("$all\n") if(length($all)> 0);
    my $tmp = $line;
    $tmp =~ s/^.*\"//g;
    
    if($lastEC ne $tmp && $ok && ($type eq "M" || $type eq "X") && open(outputFile,">>$filename") && $doSave){
	print outputFile $line."\n";
	close(outputFile);
	$lastEC = $tmp;
    }
    $top->after($pollDelay,\&pollMtr);

}

##################################################################
sub testPort {
##################################################################
    my ($port) = @_;
    if($oldCom && $^O eq 'MSWin32'){
	printing("Test old port : $port\n") if($debugPort);
	my $handle = CreateFile("\\\\.\\$port",
				0xc0000000,
				0,	
				0,
				3,
				0x40000000,
				0);
	return 0 unless ($handle >= 1);
	
	my $CommProperties		= " "x300; # extra buffer for modems
	my $CP_Length		= 300;
	my $CP_Version		= 0;
	my $CP_ServiceMask		= 0;
	my $CP_Reserved1		= 0;
	my $CP_MaxBaud		= 0;
	my $CP_ProvCapabilities	= 0;
	my $CP_SettableParams	= 0;
	my $CP_SettableBaud		= 0;
	my $CP_SettableData		= 0;
	my $CP_SettableStopParity	= 0;
	my $CP_ProvSpec1            = COMMPROP_INITIALIZED;
	my $CP_ProvSpec2		= 0;
	my $CP_ProvChar_start	= 0;
	my $CP_Filler		= 0;
	
	my $CP_MaxTxQueue;
	my $CP_MaxRxQueue;
#	my $CP_MaxBaud;
	my $CP_TYPE;
	my $CP_READBUF;
	my $CP_WRITEBUF;
	
	$CommProperties = pack($CP_format0,
			       $CP_Length,
			       $CommPropBlank,
			       $CP_ProvSpec1,
			       $CommPropBlank);
	
	unless ( GetCommProperties($handle, $CommProperties) ) {
	    CloseHandle($handle);
	    printing("GetCommProperties fail.\n") if($debugPort);
	    return 0;
	}
	
	($CP_Length,
	 $CP_Version,
	 $CP_ServiceMask,
	 $CP_Reserved1,
	 $CP_MaxTxQueue,
	 $CP_MaxRxQueue,
	 $CP_MaxBaud,
	 $CP_TYPE,
	 $CP_ProvCapabilities,
	 $CP_SettableParams,
	 $CP_SettableBaud,
	 $CP_SettableData,
	 $CP_SettableStopParity,
	 $CP_WRITEBUF,
	 $CP_READBUF,
	 $CP_ProvSpec1,
	 $CP_ProvSpec2,
	 $CP_ProvChar_start,
	 $CP_Filler)= unpack($RS232format, $CommProperties);
	
	if (($CP_Length > 64 && $CP_Length != 300) and ($CP_TYPE == PST_RS232)) {
	    printing("CommProperties length (".$CP_Length.") fail.\n") if($debugPort);
	    CloseHandle($handle);
	    return 0;
	}
	if ($CP_ServiceMask != SP_SERIALCOMM) {
	    printing("CommProperties mask fail.\n") if($debugPort);
	    CloseHandle($handle);
	    return 0;
	}
	
	printing("$port : ".($CP_TYPE == PST_RS232)."\n") if($debugPort);
	if($CP_TYPE != PST_RS232){
	    printing("Type fail ".$CP_TYPE.",".PST_RS232.".\n") if($debugPort);
	    CloseHandle($handle);
	    return 0;
	}
	
	my $dcb = " "x32;
	if(!GetCommState($handle, $dcb)){
	    printing("Open port : GetCommState fail\n") if($debugPort);
	    CloseHandle($handle);
	    return 0;
	}
	
	my  ($DCBLength,
	     $BAUD,
	     $BitMask,
	     $ResvWORD,
	     $XONLIM,
	     $XOFFLIM,
	     $DATA,
	     $Parity,
	     $StopBits,
	     $XONCHAR,
	     $XOFFCHAR,
	     $ERRCHAR,
	     $EOFCHAR,
	     $EVTCHAR,
	     $PackWORD)= unpack($DCBformat, $dcb);
	
	printing("DCB : $DCBLength,($BAUD),($BitMask),$ResvWORD,$XONLIM,$XOFFLIM,($DATA),$Parity,($StopBits),$XONCHAR,$XOFFCHAR,$ERRCHAR,$EOFCHAR,$EVTCHAR,$PackWORD\n") if($debugPort);
	
	if($BitMask & FM_fDummy2){
	    printing("Unknown DCDB Flow Mask Bit\n") if($debugPort);
	    CloseHandle($handle);
	    return 0;
	}
	
	my $MTRBAUD = 9600;
	my $MTRBitMask = 17;
	my $MTRDATA = 8;
	my $MTRStopBits = ($readMode == 1 ? 0 : 2);
	
	$BAUD = $MTRBAUD;
	$BitMask = $MTRBitMask;
	$DATA = $MTRDATA;
	$StopBits = $MTRStopBits;
	
	$dcb = pack($DCBformat,
		    $DCBLength,
		    $BAUD,
		    $BitMask,
		    $ResvWORD,
		    $XONLIM,
		    $XOFFLIM,
		    $DATA,
		    $Parity,
		    $StopBits,
		    $XONCHAR,
		    $XOFFCHAR,
		    $ERRCHAR,
		    $EOFCHAR,
		    $EVTCHAR,
		    $PackWORD);
	
	if(!SetCommState($handle, $dcb)){
	    printing("Open port : SetCommState fail\n") if($debugPort);
	    CloseHandle($handle);
	    return 0;
	}
	
	$dcb = " "x32;
	if(!GetCommState($handle, $dcb)){
	    printing("Open port : GetCommState fail\n") if($debugPort);
	    CloseHandle($handle);
	    return 0;
	}
	CloseHandle($handle);
	
	
	($DCBLength,
	 $BAUD,
	 $BitMask,
	 $ResvWORD,
	 $XONLIM,
	 $XOFFLIM,
	 $DATA,
	 $Parity,
	 $StopBits,
	 $XONCHAR,
	 $XOFFCHAR,
	 $ERRCHAR,
	 $EOFCHAR,
	 $EVTCHAR,
	 $PackWORD)= unpack($DCBformat, $dcb);
	
	printing("DCB : $DCBLength,($BAUD),($BitMask),$ResvWORD,$XONLIM,$XOFFLIM,($DATA),$Parity,($StopBits),$XONCHAR,$XOFFCHAR,$ERRCHAR,$EOFCHAR,$EVTCHAR,$PackWORD\n") if($debugPort);
	
	if($BAUD != $MTRBAUD || $BitMask != $MTRBitMask || $DATA != $MTRDATA || $StopBits != $MTRStopBits){
	    return 0;
	}		
	return 1;

    }
    else {
	my $ob;
	printing("Test new port : $port\n") if($debugPort);
	if($ob = openPort($port)){
	    closePort($ob);
	    return 1;
	}
	return 0;
    }
}

##################################################################
sub peekPort {
##################################################################
    my ($port) = @_;
    if($oldCom && $^O eq 'MSWin32'){
        my $handle = CreateFile("\\\\.\\$port",
                                0xc0000000,
                                0,	
                                0,
                                3,
                                0x00000080,
                                0);
        printing("Open port : port=$port, handle=$handle\n") if($debugPort);
        printing("Open port : fail\n") if($debugPort && $handle < 1);
        return "" unless ($handle >= 1);

        my $dcb = " "x32;
        if(!GetCommState($handle, $dcb)){
            printing("Open port : GetCommState fail\n") if($debugPort);
            CloseHandle($handle);
            return "";
        }
        CloseHandle($handle);
	
        my  ($DCBLength,
             $BAUD,
             $BitMask,
             $ResvWORD,
             $XONLIM,
             $XOFFLIM,
             $DATA,
             $Parity,
             $StopBits,
             $XONCHAR,
             $XOFFCHAR,
             $ERRCHAR,
             $EOFCHAR,
             $EVTCHAR,
             $PackWORD)= unpack($DCBformat, $dcb);
        
        printing("Open port : $DCBLength,($BAUD),($BitMask),$ResvWORD,$XONLIM,$XOFFLIM,($DATA),$Parity,($StopBits),$XONCHAR,$XOFFCHAR,$ERRCHAR,$EOFCHAR,$EVTCHAR,$PackWORD\n") if($debugPort);

        return "baudrate: $BAUD, parity: ".$parityText[$Parity].", databits: $DATA, stopbits: ".$stopBitsText[$StopBits];
    }
    else {
        my $ob = undef;
        my $quiet;
        if ($^O eq 'MSWin32'){
            eval ' 	require Win32::SerialPort;  ';
            if(!$@){
                require Win32::SerialPort;
                Win32::SerialPort->import();
                $ob = Win32::SerialPort->new ("\\\\.\\$port",$quiet);	
            }
        }
        else {
            eval ' require Device::SerialPort; ';
            if(!$@){
                require Device::SerialPort;  
                Device::SerialPort->import();
                $ob = Device::SerialPort->new ("$port",$quiet);	
            }
        }
        if($ob){
            my $res = "baudrate: ".$ob->baudrate().", parity: ".$ob->parity().", databits: ".$ob->databits().", stopbits: ".$ob->stopbits()."";
            $ob->close;
            return $res;

        }
    }
    return "";
}

##################################################################
sub isMTROr250 {
##################################################################
    my ($ob) = @_;   
    return "" unless ($ob);

    if($oldCom && $^O eq 'MSWin32'){
        my $dcb = " "x32;
        if(!GetCommState($ob, $dcb)){
            printing("Open port : GetCommState fail\n") if($debugPort);
            return "";
        }
	
        my  ($DCBLength,
             $BAUD,
             $BitMask,
             $ResvWORD,
             $XONLIM,
             $XOFFLIM,
             $DATA,
             $Parity,
             $StopBits,
             $XONCHAR,
             $XOFFCHAR,
             $ERRCHAR,
             $EOFCHAR,
             $EVTCHAR,
             $PackWORD)= unpack($DCBformat, $dcb);
        if ($StopBits == 0){
            return "MTR";
        }
        elsif ($StopBits == 2){
            return "250";
        }
    }
    else
    {
        if ($ob->stopbits == 1){
            return "MTR";
        }
        elsif ($ob->stopbits == 2){
            return "250";
        }
    }
    return "";
}

##################################################################
sub openPort {
##################################################################
    my ($port) = @_;

    my $quiet;
    my $ob = undef;
    if($oldCom && $^O eq 'MSWin32'){
	my $handle = CreateFile("\\\\.\\$port",
				0xc0000000,
				0,	
				0,
				3,
				0x00000080,
				0);
	printing("Open port : port=$port, handle=$handle\n") if($debugPort);
	printing("Open port : fail\n") if($debugPort && $handle < 1);
	return 0 unless ($handle >= 1);
#    print $handle."\n";
	
	my $dcb = " "x32;
	if(!GetCommState($handle, $dcb)){
	    printing("Open port : GetCommState fail\n") if($debugPort);
	    CloseHandle($handle);
	    return 0;
	}
	
	my  ($DCBLength,
	     $BAUD,
	     $BitMask,
	     $ResvWORD,
	     $XONLIM,
	     $XOFFLIM,
	     $DATA,
	     $Parity,
	     $StopBits,
	     $XONCHAR,
	     $XOFFCHAR,
	     $ERRCHAR,
	     $EOFCHAR,
	     $EVTCHAR,
	     $PackWORD)= unpack($DCBformat, $dcb);
	
	printing("Open port : $DCBLength,($BAUD),($BitMask),$ResvWORD,$XONLIM,$XOFFLIM,($DATA),$Parity,($StopBits),$XONCHAR,$XOFFCHAR,$ERRCHAR,$EOFCHAR,$EVTCHAR,$PackWORD\n") if($debugPort);
	
	$BAUD = 9600;
	$BitMask = 17;
	$DATA = 8;
	$StopBits = ($readMode == 1 ? 0 : 2);
	
	$dcb = pack($DCBformat,
		    $DCBLength,
		    $BAUD,
		    $BitMask,
		    $ResvWORD,
		    $XONLIM,
		    $XOFFLIM,
		    $DATA,
		    $Parity,
		    $StopBits,
		    $XONCHAR,
		    $XOFFCHAR,
		    $ERRCHAR,
		    $EOFCHAR,
		    $EVTCHAR,
		    $PackWORD);
	
	if(!SetCommState($handle, $dcb)){
	    printing("Open port : SetCommState fail\n") if($debugPort);
	    CloseHandle($handle);
	    return 0;
	}
	
	my $ct =  pack($TIMEOUTformat,
		       0xFFFFFFFF,
		       0xFFFFFFFF,
		       int($mtrTimeout),
		       0,
		       0);
	
	if(!SetCommTimeouts($handle, $ct)){
	    printing("Open port : SetCommTimeouts fail\n") if($debugPort);
	    CloseHandle($handle);
	    return 0;
	}
	return $handle;
	

    }
    else {
	if ($^O eq 'MSWin32'){
	    eval ' 	require Win32::SerialPort;  ';
	    if(!$@){
		require Win32::SerialPort;
		Win32::SerialPort->import();
		$ob = Win32::SerialPort->new ("\\\\.\\$port",$quiet);	
	    }
	}
	else {
	    eval ' require Device::SerialPort; ';
	    if(!$@){
		require Device::SerialPort;  
		Device::SerialPort->import();
		$ob = Device::SerialPort->new ("$port",$quiet);	
	    }
	}
	my $ok = 0;
	
	if($ob){
#	$ob->debug(0);
	    my @baud_opt = $ob->baudrate;
	    my @parity_opt = $ob->parity;
	    my @data_opt = $ob->databits;
	    my @stop_opt = $ob->stopbits;
	    my @hshake_opt = $ob->handshake;
	    
	    foreach $a (@baud_opt) {
		if($a == 9600){
		    $ok++;
		    last;
		}
	    }
	    foreach $a (@parity_opt) {
		if($a eq 'none' ){
		    $ok++;
		    last;
		}
	    }
	    foreach $a (@data_opt) {
		if($a == 8){
		    $ok++;
		    last;
		}
	    }
	    foreach $a (@stop_opt) {
		if($a == $readMode){
		    $ok++;
		    last;
	    }
	    }
	    foreach $a (@hshake_opt) {
		if($a eq 'none'){
		    $ok++;
		    last;
		}
	    }
	    $ok++ if($ob->is_rs232);
	    
	    $ob->baudrate(9600);
	    $ob->parity('none');
	    $ob->databits(8);
	    $ob->stopbits($readMode);
	    $ob->handshake('none');
	    $ob->buffers(4096,4096);
	    $ob->read_interval(100) if ($^O eq 'MSWin32');
	    $ob->read_char_time(5);
	    $ob->read_const_time(100);
	    $ob->write_char_time(5) if ($^O eq 'MSWin32');
	    $ob->write_const_time(100) if ($^O eq 'MSWin32');
	    $ok++ if($ob->write_settings);
	    
	    $ob->close if($ok < 6);
	}
	printing("Stopbits: $readMode\n") if($debugPort);
	undef $ob if($ok < 6);
	return $ob;
    }
}

##################################################################
sub closePort {
##################################################################
    my ($ob) = @_;
    printing("Clos port : handle=$ob\n") if($debugPort);    
    if($ob){
	if($oldCom && $^O eq 'MSWin32'){
	    CloseHandle($ob) if($ob >= 1);
	}
	else {
	    $ob->close;
	    undef $ob;
	}
    }
}

##################################################################
sub readPort {
##################################################################
    my ($ob) = @_;
    if($oldCom && $^O eq 'MSWin32'){
	printing("Read port : handle=$ob\n") if($debugPort && $ob < 1);
	return -1  unless ($ob >= 1);
	my $got_p = " "x4;
	my $got = 0;
	my $byte;
	my $ok=ReadFile($ob,
			$byte,
			1,
			$got_p,
			0);
	
	printing("Read port : ok=$ok, $got\n") if($debugPort && $got != 1);
	return -1 unless ($ok);
	$got = unpack("L", $got_p);
	return ord($byte) if($got == 1);
	return -1;	
    }
    else {
	return -1 unless($ob);
	my ($count_in, $string_in) = $ob->read(1);
	return ($count_in > 0 ? ord($string_in) : -1);
    }
}
##################################################################
sub writePort {
##################################################################
    my ($ob,$wbuf) = @_;
    if($oldCom && $^O eq 'MSWin32'){
	return -1  unless ($ob >= 1);
	return 0 unless (length($wbuf)>0);
	
	my $got_p = " "x4;
	my $lbuf = length ($wbuf);
	my $written = 0;
	printing("Writ port : data=\'$wbuf\'\n") if($debugPort);
	my $ok=WriteFile($ob,
			 $wbuf,
			 $lbuf,
			 $got_p,
			 0);
	printing("Writ port : ok=$ok\n") if($debugPort);
	return 0 unless($ok);
	return unpack("L", $got_p);
	
	
    }
    else {
	return 0 unless($ob);
	
	my $n = $ob->write("$wbuf");
	printing("W: $n of ".length($wbuf).", \'$wbuf\'\n") if($debugPort);
	return ($n == length($wbuf));
    }
}

##################################################################
sub emptyBuffer {
##################################################################
    my ($ob,$timeout) = @_;
    my $n = 0;
    my $tis = time();
    do {
	my $byte = readPort($ob);
	if($byte>=0){
	    $tis = time();
	    $n++;
	}
	return ("") if($n == 0 && $byte < 0);
    }
    while($tis+$mtrTimeout > time());
    if($n > 0){
	return ("Read first ".$n." bytes.");
    }
    return("");
}
##################################################################
sub readRecord {
##################################################################
    my ($ob,$timeout,$poll) = @_;

    my $ok = 0;
    my $type = "";
    my $count = 0;
    my $line = "";
    my $status = "";
    my $n0 = undef
    my @rec = ();
    my $size = 0;
    my $all = "";
    my $t = time();
    my $first = 1;
    my $sum1 = 255*4;
    my $sum2 = 255*2;
    my $size1 = -1;
    my $size2 = 215;
    my $count1 = 0;
    my $count2 = 0;
    my $read1 = 0;
    my $read2 = 0;
    my $readmore = 1;
    my $mtr250 = -1;
    my $protocolMode = isMTROr250($ob);
    do {
        my $byte = readPort($ob);
        if($byte>=0){
            $t = time();
            $count++;
            $ok = 1;
            if ($protocolMode eq "MTR"){
                if ($count1 > 4 || $byte != 255 || $read1 > 0){
                    $read1++;
                    $sum1 += $byte;
                    if($count1 >= 0){
                        $size1 = $byte ;
                        $count1 = -$count1;
			$all = join(",",@rec);
			@rec = ();
                    }
                    if ($read1 == $size1 && (($sum1-$rec[$#rec]) % 256) == $rec[$#rec] && $byte == 0){
                        $readmore = 0 ;
                        $mtr250 = 0;
                    }
                }
                else {
                    $count1++;
                }
            }
            if ($protocolMode eq "250"){
		$byte = $byte ^ (255-32);
                if ($count2 < 0 || $count2 > 1){
                    $read2++;
                    $sum2 += $byte;
                    if($count2 >= 0){
                        $count2 = -$count2;
			$all = join(",",@rec);
			@rec = ();
                    }
                    if ($read2 == $size2) {
                        $readmore =  0;
                        $mtr250 = ($sum2 % 256 == 0 ? 1 : -1);
                    }
                }
                elsif ($byte == 255) {
                    $count2++;
                }
		else {
		    $count2 = 0;
		}
            }
            push(@rec,$byte);
        }
        elsif($poll && $first){
            return ($ok,$type,$count,$size,$line,$status,$n0,$all,@rec);
        }
        $first = 0;
    }
    while($readmore && $t+$timeout > time());
    $all .= "," if (length($all));
    $all .= join(",",@rec);
 
    if($count < 1){
        $status = "No response, check cable and/or check port.";
        $ok = 0;
    }
    elsif($size1 != $read1 && $size2 != $read2 ){
        $status = "Could not read complete record! Read $count byte(s).";
        $ok = 0;
    }
    elsif($mtr250 < 0) {
        $status = "Check sum error!";
        $ok = 0;
    }
    else {
        $type = chr($rec[1]);	
        if($mtr250){
            $type = "X";
            $n0 = 0;
            my $finish = 0;
            my $ecard = sprintf("%06d",$rec[0]+($rec[1]<<8)+($rec[2]<<16));
            my $mtrid = 0;
            my (@tmp) =  localtime(time());
            my $timeactual = sprintf("%02d.%02d.%02d %02d:%02d:%02d.000",$tmp[3],$tmp[4]+1,$tmp[5]%100,$tmp[2],$tmp[1],$tmp[0]);
            $line = "\"X\",\"0\",\"$mtrid\",\"$ecard\",\"$timeactual\",\"$timeactual\",$ecard,0000,0000";
            for my $i (0 .. 49){
                my $c = $rec[ 8+$i*3];
                my $l = $rec[ 9+$i*3]+($rec[10+$i*3]<<8);
                $line .= sprintf(",%03d,%05d",$c,$l);
                $finish = $l if($i < 49 && $rec[8+$i*3+3] == 250);
            }
            $line .= sprintf(",%07d",$n0);
            $status = sprintf("%s %5d %6d, %d:%02d",  sprintf("%02d.%02d.%02d %02d:%02d:%02d",$tmp[3],$tmp[4]+1,$tmp[5]%100,$tmp[2],$tmp[1],$tmp[0]), $n0, $ecard,$finish/60,$finish%60);	
        }
        elsif($type eq 'S'){
            $status = "MTR ".($rec[2]+($rec[3]<<8)).", ".sprintf("%04d/%02d/%02d %02d:%02d:%02d",1900+$rec[4]+($rec[4]<50?100:0),$rec[5],$rec[6],$rec[7],$rec[8],$rec[9]).", battery ".($rec[12]>0?"low":"ok").", recent=".($rec[13]+($rec[14]<<8)+($rec[15]<<16)+($rec[16]<<24)).", oldest=".($rec[17]+($rec[18]<<8)+($rec[19]<<16)+($rec[20]<<24)).", current=".($rec[21]+($rec[22]<<8)+($rec[23]<<16)+($rec[24]<<24));
            my $mtrid = $rec[2]+($rec[3]<<8);
            my $timestamp = sprintf("%02d.%02d.%02d %02d:%02d:%02d.%03d",$rec[6],$rec[5],$rec[4],$rec[7],$rec[8],$rec[9],$rec[10],($rec[11]<<8));
            $status .= ", prev=".($rec[21+4]+($rec[22+4]<<8)+($rec[23+4]<<16)+($rec[24+$4]<<24));
            for my $i (2 .. 7){
                $status .= ", ".($rec[21+$i*4]+($rec[22+$i*4]<<8)+($rec[23+$i*4]<<16)+($rec[24+$i*4]<<24));
            }
            $status .=".";
            $n0 = $rec[13]+($rec[14]<<8)+($rec[15]<<16)+($rec[16]<<24);
            #my $m = $rec[21]+($rec[22]<<8)+($rec[23]<<16)+($rec[24]<<24);
            #$n0 = $m if($m > $n0);
            #$m = $rec[17]+($rec[18]<<8)+($rec[19]<<16)+($rec[20]<<24);
            #$n0 = $m if($m > $n0);	    
            # "S","1019","22.04.03 23:48:07.000",000223,000001,000098,000036,000005,000004,000003,000001,000000,000000,0
            $line = "\"S\",\"$mtrid\",\"$timestamp\"";
            for my $i (0 .. 9){
                $line .= sprintf(",%06d",$rec[13+$i*4]+($rec[14+$i*4]<<8)+($rec[15+$i*4]<<16)+($rec[16+$i*4]<<24));
            }
            $line .= ",".$rec[12];
        }
        elsif($type eq 'M'){
            my $finish = 0;
            $n0 = $rec[12]+($rec[13]<<8)+($rec[14]<<16)+($rec[15]<<24);
            my $ecard = sprintf("%06d",$rec[16]+($rec[17]<<8)+($rec[18]<<16));
            my $mtrid = $rec[2]+($rec[3]<<8);
            my $timestamp = sprintf("%02d.%02d.%02d %02d:%02d:%02d.%03d",$rec[6],$rec[5],$rec[4],$rec[7],$rec[8],$rec[9],$rec[10]+($rec[11]<<8));
            my (@tmp) =  localtime(time());
            my $timeactual = sprintf("%02d.%02d.%02d %02d:%02d:%02d.000",$tmp[3],$tmp[4]+1,$tmp[5]%100,$tmp[2],$tmp[1],$tmp[0]);
            $line = "\"M\",\"0\",\"$mtrid\",\"$ecard\",\"$timeactual\",\"$timestamp\",$ecard,0000,0000";
            for my $i (0 .. 49){
                my $c = $rec[22+$i*3];
                my $l = $rec[23+$i*3]+($rec[24+$i*3]<<8);
                $line .= sprintf(",%03d,%05d",$c,$l);
                $finish = $l if($i < 49 && $rec[22+$i*3+3] == 250);
            }
            $line .= sprintf(",%07d",$n0);
            $status = sprintf("%s %5d %6d, %d:%02d",  sprintf("%02d.%02d.%02d %02d:%02d:%02d",$rec[6],$rec[5],$rec[4],$rec[7],$rec[8],$rec[9]), $n0, $ecard,$finish/60,$finish%60);	
        }
        else {
            $status = "Was expecting a status or message record, but got type \"".$type."\".";
        }
    }
    return ($ok,$type,$count,$size,$line,$status,$n0,$all,@rec);
}


##################################################################
sub initAPIPorts {
##################################################################
    my @ports = getPorts();
    printing("\n") if($#ports >= 0);
    my $port = "";
    for(my $i=0;$i<=$#ports;$i+=2){
	printing("$ports[$i] : $ports[$i+1]\n");
	if($ports[$i+1] =~ /232/ && (length($port) <= 0 || $ports[$i] le $port )){
	    $port = $ports[$i]; 
#	    printing("Detected RS232 Serial Port : $port\n");
	}
    }
    printing("\n");
    printing("Could not detect any RS232 Serial Port.\n") unless(length($port)> 0);
    $RS232 = $port if(length($port)> 0);
    printing("Using $RS232 as default RS232 Serial Port\n");
}

##################################################################
sub getPorts {
##################################################################
    my @res = ();

    for(my $i=0;$i<=99;$i++){
	my $port =  ($^O eq 'MSWin32' ? "COM$i" : "/dev/ttyS$i");
	if($^O ne 'MSWin32' || $i > 0){
	    if(testPort($port)){
		push(@res,$port);
		push(@res,"RS232 Serial Port, Communications Port ($port)");
	    }
	    elsif($i < 10 && !$autoDetect){
		push(@res,"$port");
		push(@res,"");
	    } 
	}
    }
    return (@res);
}



##################################################################
sub removeDirPath {
##################################################################
    my $str = shift;
    $str =~ s/^.*[\\\/]//g;
    $str =~ s/^\s+//g;
    $str =~ s/\s+$//g;
    return $str;
}