home *** CD-ROM | disk | FTP | other *** search
/ isnet Internet / Isnet Internet CD.iso / prog / hiz / 09 / 09.exe / adynware.exe / perl / lib / site / Win32 / Console.pm < prev    next >
Encoding:
Perl POD Document  |  1999-12-28  |  16.0 KB  |  550 lines
  1. package Win32::Console;
  2.  
  3. require Exporter;       # to export the constants to the main:: space
  4. require DynaLoader;     # to dynuhlode the module.
  5.  
  6. @ISA= qw( Exporter DynaLoader );
  7. @EXPORT = qw(
  8.     BACKGROUND_BLUE
  9.     BACKGROUND_GREEN
  10.     BACKGROUND_INTENSITY
  11.     BACKGROUND_RED
  12.     CAPSLOCK_ON
  13.     CONSOLE_TEXTMODE_BUFFER
  14.     CTRL_BREAK_EVENT    
  15.     CTRL_C_EVENT
  16.     ENABLE_ECHO_INPUT
  17.     ENABLE_LINE_INPUT
  18.     ENABLE_MOUSE_INPUT
  19.     ENABLE_PROCESSED_INPUT
  20.     ENABLE_PROCESSED_OUTPUT
  21.     ENABLE_WINDOW_INPUT
  22.     ENABLE_WRAP_AT_EOL_OUTPUT
  23.     ENHANCED_KEY
  24.     FILE_SHARE_READ
  25.     FILE_SHARE_WRITE
  26.     FOREGROUND_BLUE
  27.     FOREGROUND_GREEN
  28.     FOREGROUND_INTENSITY
  29.     FOREGROUND_RED
  30.     LEFT_ALT_PRESSED
  31.     LEFT_CTRL_PRESSED
  32.     NUMLOCK_ON
  33.     GENERIC_READ
  34.     GENERIC_WRITE
  35.     RIGHT_ALT_PRESSED
  36.     RIGHT_CTRL_PRESSED
  37.     SCROLLLOCK_ON
  38.     SHIFT_PRESSED
  39.     STD_INPUT_HANDLE
  40.     STD_OUTPUT_HANDLE
  41.     STD_ERROR_HANDLE
  42. );
  43.  
  44.  
  45.  
  46. sub AUTOLOAD {
  47.     my($constname);
  48.     ($constname = $AUTOLOAD) =~ s/.*:://;
  49.     $!=0;
  50.     my $val = constant($constname, @_ ? $_[0] : 0);
  51.     if ($! != 0) {
  52.         ($pack, $file, $line) = caller; undef $pack;
  53.         die "Symbol Win32::Console::$constname not defined, used at $file line $line.";
  54.     }
  55.     eval "sub $AUTOLOAD { $val }";
  56.     goto &$AUTOLOAD;
  57. }
  58.  
  59.  
  60. $VERSION = "0.03";
  61.  
  62.  
  63.  
  64. sub new {
  65.     my($class, $param1, $param2) = @_;
  66.  
  67.     my $self = {};
  68.  
  69.     if(defined($param1) 
  70.     and ($param1 == constant("STD_INPUT_HANDLE",  0)
  71.     or   $param1 == constant("STD_OUTPUT_HANDLE", 0)
  72.     or   $param1 == constant("STD_ERROR_HANDLE",  0))) {
  73.  
  74.         $self->{'handle'} = _GetStdHandle($param1);
  75.  
  76.     } else {
  77.  
  78.         $param1 = constant("GENERIC_READ", 0)    | constant("GENERIC_WRITE", 0) unless $param1;
  79.         $param2 = constant("FILE_SHARE_READ", 0) | constant("FILE_SHARE_WRITE", 0) unless $param2;
  80.         $self->{'handle'} = _CreateConsoleScreenBuffer($param1, $param2, 
  81.                                                        constant("CONSOLE_TEXTMODE_BUFFER", 0));
  82.     }
  83.     bless $self, $class;
  84.     return $self;
  85. }
  86.  
  87.  
  88. sub Display {
  89.     my($self)=@_;
  90.     return undef unless ref($self);
  91.  
  92.     return _SetConsoleActiveScreenBuffer($self->{'handle'});
  93. }
  94.  
  95. sub Select {
  96.     ($self, $type) = @_;
  97.     return undef unless ref($self);
  98.  
  99.     return _SetStdHandle($type, $self->{'handle'});
  100. }
  101.  
  102.  
  103. sub Title {
  104.     my($self, $title) = @_;
  105.  
  106.     $title = $self unless ref($self);
  107.  
  108.     if(defined($title)) {
  109.       return _SetConsoleTitle($title);
  110.     } else {
  111.       return _GetConsoleTitle();
  112.     }
  113. }
  114.  
  115. sub WriteChar {
  116.     my($self, $text, $col, $row) = @_;
  117.     return undef unless ref($self);
  118.  
  119.     return _WriteConsoleOutputCharacter($self->{'handle'},$text,$col,$row);
  120. }
  121.  
  122. sub ReadChar {
  123.     my($self, $size, $col, $row) = @_;
  124.     return undef unless ref($self);
  125.   
  126.     my $buffer = (" " x $size);  
  127.     if(_ReadConsoleOutputCharacter($self->{'handle'}, $buffer, $size, $col, $row)) {
  128.         return $buffer;
  129.     } else {
  130.         return undef;
  131.     }
  132. }
  133.  
  134.  
  135.  
  136. sub WriteAttr {
  137.     my($self, $attr, $col, $row) = @_;
  138.     return undef unless ref($self);
  139.     return _WriteConsoleOutputAttribute($self->{'handle'}, $attr, $col, $row);
  140. }
  141.  
  142. sub ReadAttr {
  143.     my($self, $size, $col, $row) = @_;
  144.     return undef unless ref($self);
  145.   
  146.     return _ReadConsoleOutputAttribute($self->{'handle'}, $size, $col, $row);
  147. }
  148.  
  149.  
  150. sub Write {
  151.     my($self,$string) = @_;
  152.     return undef unless ref($self);
  153.     return _WriteConsole($self->{'handle'}, $string);
  154. }
  155.  
  156.  
  157. sub ReadRect {
  158.     my($self, $left, $top, $right, $bottom) = @_;
  159.     return undef unless ref($self);
  160.     
  161.     my $col = $right  - $left + 1;
  162.     my $row = $bottom - $top  + 1;
  163.  
  164.     my $buffer = (" " x ($col*$row*4));
  165.     if(_ReadConsoleOutput($self->{'handle'},   $buffer,
  166.                           $col,  $row, 0,      0,
  167.                           $left, $top, $right, $bottom)) {
  168.         return $buffer;
  169.     } else {
  170.         return undef;
  171.     }
  172. }
  173.  
  174.  
  175. sub WriteRect {
  176.     my($self, $buffer, $left, $top, $right, $bottom) = @_;
  177.     return undef unless ref($self);
  178.  
  179.     my $col = $right  - $left + 1;
  180.     my $row = $bottom - $top  + 1;
  181.  
  182.     return _WriteConsoleOutput($self->{'handle'},   $buffer,
  183.                                $col,  $row, 0,  0,
  184.                                $left, $top, $right, $bottom);
  185. }
  186.  
  187.  
  188.  
  189. sub Scroll {
  190.     my($self, $left1, $top1, $right1, $bottom1,
  191.               $col,   $row,  $char,   $attr,
  192.               $left2, $top2, $right2, $bottom2) = @_;
  193.     return undef unless ref($self);
  194.   
  195.     return _ScrollConsoleScreenBuffer($self->{'handle'},
  196.                                       $left1, $top1, $right1, $bottom1,
  197.                                       $col,   $row,  $char,   $attr,
  198.                                       $left2, $top2, $right2, $bottom2);
  199. }
  200.  
  201.  
  202. sub MaxWindow {
  203.     my($self, $flag) = @_;
  204.     return undef unless ref($self);
  205.   
  206.     if(not defined($flag)) {
  207.         my @info = _GetConsoleScreenBufferInfo($self->{'handle'});
  208.         return $info[9], $info[10];
  209.     } else {
  210.         return _GetLargestConsoleWindowSize($self->{'handle'});
  211.     }
  212. }
  213.  
  214. sub Info {
  215.     my($self) = @_;
  216.     return undef unless ref($self);
  217.   
  218.     return _GetConsoleScreenBufferInfo($self->{'handle'});
  219. }
  220.  
  221.  
  222. sub Window {
  223.     my($self, $flag, $left, $top, $right, $bottom) = @_;
  224.     return undef unless ref($self);
  225.   
  226.     if(not defined($flag)) {
  227.         my @info = _GetConsoleScreenBufferInfo($self->{'handle'});
  228.         return $info[5], $info[6], $info[7], $info[8];
  229.     } else {
  230.         return _SetConsoleWindowInfo($self->{'handle'}, $flag, $left, $top, $right, $bottom);
  231.     }
  232. }
  233.  
  234. sub GetEvents {
  235.     my $self="";
  236.     ($self)=@_;
  237.     return undef unless ref($self);
  238.   
  239.     return _GetNumberOfConsoleInputEvents($self->{'handle'});
  240. }
  241.  
  242.  
  243. sub Flush {
  244.     my($self) = @_;
  245.     return undef unless ref($self);
  246.  
  247.     return _FlushConsoleInputBuffer($self->{'handle'});
  248. }
  249.  
  250. sub InputChar {
  251.     my($self, $number) = @_;
  252.     return undef unless ref($self);
  253.     
  254.     $number = 1 unless defined($number);
  255.   
  256.     my $buffer = (" " x $number);
  257.     if(_ReadConsole($self->{'handle'}, $buffer, $number) == $number) {
  258.         return $buffer;
  259.     } else {
  260.         return undef;
  261.     }
  262. }
  263.  
  264. sub Input {
  265.     my($self) = @_;
  266.     return undef unless ref($self);
  267.   
  268.     return _ReadConsoleInput($self->{'handle'});
  269. }
  270.  
  271. sub PeekInput {
  272.     my($self) = @_;
  273.     return undef unless ref($self);
  274.   
  275.     return _PeekConsoleInput($self->{'handle'});
  276. }
  277.  
  278.  
  279. sub WriteInput {
  280.     my($self) = shift;
  281.     return undef unless ref($self);
  282.   
  283.     return _WriteConsoleInput($self->{'handle'}, @_);
  284. }
  285.  
  286.  
  287. sub Mode {
  288.     my($self, $mode) = @_;
  289.     return undef unless ref($self);
  290.   
  291.     if(defined($mode)) {
  292.         return _SetConsoleMode($self->{'handle'}, $mode);
  293.     } else {
  294.         return _GetConsoleMode($self->{'handle'});
  295.     }
  296. }
  297.  
  298. sub Cls {
  299.     my($self, $attr) = @_;
  300.     return undef unless ref($self);
  301.  
  302.     $attr = $main::ATTR_NORMAL unless defined($attr);
  303.     
  304.     my ($x, $y) = $self->Size();
  305.     my($left, $top, $right ,$bottom) = $self->Window();
  306.     my $vx = $right  - $left;
  307.     my $vy = $bottom - $top;
  308.     $self->FillChar(" ", $x*$y, 0, 0);
  309.     $self->FillAttr($attr, $x*$y, 0, 0);
  310.     $self->Cursor(0, 0);
  311.     $self->Window(1, 0, 0, $vx, $vy);
  312. }
  313.  
  314.  
  315. sub Attr {
  316.     my($self, $attr) = @_;
  317.     return undef unless ref($self);
  318.   
  319.     if(not defined($attr)) {
  320.         return (_GetConsoleScreenBufferInfo($self->{'handle'}))[4];
  321.     } else {
  322.         return _SetConsoleTextAttribute($self->{'handle'}, $attr);
  323.     }
  324. }
  325.  
  326. sub Cursor {
  327.     my($self, $col, $row, $size, $visi) = @_;
  328.     return undef unless ref($self);
  329.  
  330.     my $curr_row  = 0;
  331.     my $curr_col  = 0;
  332.     my $curr_size = 0;
  333.     my $curr_visi = 0;
  334.     my $return    = 0;
  335.     my $discard   = 0;
  336.  
  337.   
  338.     if(defined($col)) {
  339.         $row = -1 if not defined($row);
  340.         if($col == -1 or $row == -1) {
  341.             ($discard, $discard, $curr_col, $curr_row) = _GetConsoleScreenBufferInfo($self->{'handle'});
  342.             $col=$curr_col if $col==-1;
  343.             $row=$curr_row if $row==-1;
  344.         }
  345.         $return += _SetConsoleCursorPosition($self->{'handle'}, $col, $row);
  346.         if(defined($size) and defined($visi)) {
  347.             if($size == -1 or $visi == -1) {
  348.                 ($curr_size, $curr_visi) = _GetConsoleCursorInfo($self->{'handle'});
  349.                 $size = $curr_size if $size == -1;
  350.                 $visi = $curr_visi if $visi == -1;
  351.             }
  352.             $size = 1 if $size < 1;
  353.             $size = 99 if $size > 99;
  354.             $return += _SetConsoleCursorInfo($self->{'handle'}, $size, $visi);
  355.         }
  356.         return $return;
  357.     } else {
  358.         ($discard, $discard, $curr_col, $curr_row) = _GetConsoleScreenBufferInfo($self->{'handle'});
  359.         ($curr_size, $curr_visi) = _GetConsoleCursorInfo($self->{'handle'});
  360.         return ($curr_col, $curr_row, $curr_size, $curr_visi);
  361.     }
  362. }
  363.   
  364. sub Size {
  365.     my($self, $col, $row) = @_;
  366.     return undef unless ref($self);
  367.     if(not defined($col)) {
  368.         ($col, $row) = _GetConsoleScreenBufferInfo($self->{'handle'});
  369.         return ($col, $row);
  370.     } else {
  371.         $row = -1 if not defined($row);
  372.         if($col == -1 or $row == -1) {
  373.             ($curr_col, $curr_row) = _GetConsoleScreenBufferInfo($self->{'handle'});
  374.             $col=$curr_col if $col==-1;
  375.             $row=$curr_row if $row==-1;
  376.         }
  377.         return _SetConsoleScreenBufferSize($self->{'handle'}, $col, $row);
  378.     }
  379. }
  380.  
  381. sub FillAttr {
  382.     my($self, $attr, $number, $col, $row) = @_;
  383.     return undef unless ref($self);
  384.  
  385.     $number = 1 unless $number;
  386.  
  387.     if(!defined($col) or !defined($row) or $col == -1 or $row == -1) {
  388.         ($discard,  $discard, 
  389.          $curr_col, $curr_row) = _GetConsoleScreenBufferInfo($self->{'handle'});
  390.         $col = $curr_col if !defined($col) or $col == -1;
  391.         $row = $curr_row if !defined($row) or $row == -1;
  392.     }
  393.     return _FillConsoleOutputAttribute($self->{'handle'}, $attr, $number, $col, $row);
  394. }
  395.  
  396. sub FillChar {
  397.     my($self, $char, $number, $col, $row) = @_;
  398.     return undef unless ref($self);
  399.  
  400.     if(!defined($col) or !defined($row) or $col == -1 or $row == -1) {
  401.         ($discard,  $discard,
  402.          $curr_col, $curr_row) = _GetConsoleScreenBufferInfo($self->{'handle'});
  403.         $col = $curr_col if !defined($col) or $col == -1;
  404.         $row = $curr_row if !defined($row) or $row == -1;
  405.     }
  406.     return _FillConsoleOutputCharacter($self->{'handle'}, $char, $number, $col, $row);
  407. }
  408.  
  409. sub InputCP {
  410.     my($self, $codepage) = @_;
  411.     $codepage = $self if (defined($self) and ref($self) ne "Win32::Console");
  412.     if(defined($codepage)) {
  413.         return _SetConsoleCP($codepage);
  414.     } else {
  415.         return _GetConsoleCP();
  416.     }
  417. }
  418.  
  419. sub OutputCP {
  420.     my($self, $codepage) = @_;
  421.     $codepage = $self if (defined($self) and ref($self) ne "Win32::Console");
  422.     if(defined($codepage)) {
  423.         return _SetConsoleOutputCP($codepage);
  424.     } else {
  425.         return _GetConsoleOutputCP();
  426.     }
  427. }
  428.  
  429. sub GenerateCtrlEvent {
  430.     my($self, $type, $pid) = @_;
  431.     $type = constant("CTRL_C_EVENT", 0) unless defined($type);
  432.     $pid = 0 unless defined($pid);
  433.     return _GenerateCtrlEvent($type, $pid);
  434. }
  435.  
  436.  
  437.  
  438.  
  439.  
  440. sub DESTROY {
  441.     my($self) = @_;
  442.     _CloseHandle($self->{'handle'});
  443. }
  444.  
  445.  
  446.  
  447.  
  448. bootstrap Win32::Console;
  449.  
  450.  
  451. $main::FG_BLACK        = 0;
  452. $main::FG_BLUE         = constant("FOREGROUND_BLUE",0);
  453. $main::FG_LIGHTBLUE    = constant("FOREGROUND_BLUE",0)|
  454.                          constant("FOREGROUND_INTENSITY",0);
  455. $main::FG_RED          = constant("FOREGROUND_RED",0);
  456. $main::FG_LIGHTRED     = constant("FOREGROUND_RED",0)|
  457.                          constant("FOREGROUND_INTENSITY",0);
  458. $main::FG_GREEN        = constant("FOREGROUND_GREEN",0);
  459. $main::FG_LIGHTGREEN   = constant("FOREGROUND_GREEN",0)|
  460.                          constant("FOREGROUND_INTENSITY",0);
  461. $main::FG_MAGENTA      = constant("FOREGROUND_RED",0)|
  462.                          constant("FOREGROUND_BLUE",0);
  463. $main::FG_LIGHTMAGENTA = constant("FOREGROUND_RED",0)|
  464.                          constant("FOREGROUND_BLUE",0)|
  465.                          constant("FOREGROUND_INTENSITY",0);
  466. $main::FG_CYAN         = constant("FOREGROUND_GREEN",0)|
  467.                          constant("FOREGROUND_BLUE",0);
  468. $main::FG_LIGHTCYAN    = constant("FOREGROUND_GREEN",0)|
  469.                          constant("FOREGROUND_BLUE",0)|
  470.                          constant("FOREGROUND_INTENSITY",0);
  471. $main::FG_BROWN        = constant("FOREGROUND_RED",0)|
  472.                          constant("FOREGROUND_GREEN",0);
  473. $main::FG_YELLOW       = constant("FOREGROUND_RED",0)|
  474.                          constant("FOREGROUND_GREEN",0)|
  475.                          constant("FOREGROUND_INTENSITY",0);
  476. $main::FG_GRAY         = constant("FOREGROUND_RED",0)|
  477.                          constant("FOREGROUND_GREEN",0)|
  478.                          constant("FOREGROUND_BLUE",0);
  479. $main::FG_WHITE        = constant("FOREGROUND_RED",0)|
  480.                          constant("FOREGROUND_GREEN",0)|
  481.                          constant("FOREGROUND_BLUE",0)|
  482.                          constant("FOREGROUND_INTENSITY",0);
  483.  
  484. $main::BG_BLACK        = 0;
  485. $main::BG_BLUE         = constant("BACKGROUND_BLUE",0);
  486. $main::BG_LIGHTBLUE    = constant("BACKGROUND_BLUE",0)|
  487.                          constant("BACKGROUND_INTENSITY",0);
  488. $main::BG_RED          = constant("BACKGROUND_RED",0);
  489. $main::BG_LIGHTRED     = constant("BACKGROUND_RED",0)|
  490.                          constant("BACKGROUND_INTENSITY",0);
  491. $main::BG_GREEN        = constant("BACKGROUND_GREEN",0);
  492. $main::BG_LIGHTGREEN   = constant("BACKGROUND_GREEN",0)|
  493.                          constant("BACKGROUND_INTENSITY",0);
  494. $main::BG_MAGENTA      = constant("BACKGROUND_RED",0)|
  495.                          constant("BACKGROUND_BLUE",0);
  496. $main::BG_LIGHTMAGENTA = constant("BACKGROUND_RED",0)|
  497.                          constant("BACKGROUND_BLUE",0)|
  498.                          constant("BACKGROUND_INTENSITY",0);
  499. $main::BG_CYAN         = constant("BACKGROUND_GREEN",0)|
  500.                          constant("BACKGROUND_BLUE",0);
  501. $main::BG_LIGHTCYAN    = constant("BACKGROUND_GREEN",0)|
  502.                          constant("BACKGROUND_BLUE",0)|
  503.                          constant("BACKGROUND_INTENSITY",0);
  504. $main::BG_BROWN        = constant("BACKGROUND_RED",0)|
  505.                          constant("BACKGROUND_GREEN",0);
  506. $main::BG_YELLOW       = constant("BACKGROUND_RED",0)|
  507.                          constant("BACKGROUND_GREEN",0)|
  508.                          constant("BACKGROUND_INTENSITY",0);
  509. $main::BG_GRAY         = constant("BACKGROUND_RED",0)|
  510.                          constant("BACKGROUND_GREEN",0)|
  511.                          constant("BACKGROUND_BLUE",0);
  512. $main::BG_WHITE        = constant("BACKGROUND_RED",0)|
  513.                          constant("BACKGROUND_GREEN",0)|
  514.                          constant("BACKGROUND_BLUE",0)|
  515.                          constant("BACKGROUND_INTENSITY",0);
  516.  
  517. $main::ATTR_NORMAL = $main::FG_GRAY|$main::BG_BLACK;
  518. $main::ATTR_INVERSE = $main::FG_BLACK|$main::BG_GRAY;
  519.  
  520. undef unless $main::ATTR_NORMAL;
  521. undef unless $main::ATTR_INVERSE;
  522. undef unless $VERSION;
  523.  
  524. @main::CONSOLE_COLORS = ();
  525.  
  526. foreach $fg ($main::FG_BLACK, $main::FG_BLUE, $main::FG_GREEN, $main::FG_CYAN, 
  527.              $main::FG_RED, $main::FG_MAGENTA, $main::FG_BROWN, $main::FG_GRAY,
  528.              $main::FG_LIGHTBLUE, $main::FG_LIGHTGREEN, $main::FG_LIGHTCYAN,
  529.              $main::FG_LIGHTRED, $main::FG_LIGHTMAGENTA, $main::FG_YELLOW, 
  530.              $main::FG_WHITE) {
  531.  
  532.     foreach $bg ($main::BG_BLACK, $main::BG_BLUE, $main::BG_GREEN, $main::BG_CYAN, 
  533.                  $main::BG_RED, $main::BG_MAGENTA, $main::BG_BROWN, $main::BG_GRAY,
  534.                  $main::BG_LIGHTBLUE, $main::BG_LIGHTGREEN, $main::BG_LIGHTCYAN,
  535.                  $main::BG_LIGHTRED, $main::BG_LIGHTMAGENTA, $main::BG_YELLOW, 
  536.                  $main::BG_WHITE) {
  537.         push(@main::CONSOLE_COLORS, $fg|$bg);
  538.     }
  539. }
  540.  
  541. undef $fg;
  542. undef $bg;
  543.  
  544.  
  545.  
  546. 1;
  547.  
  548. __END__
  549.  
  550.