Source code of Windows XP (NT5)
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

154 lines
3.8 KiB

  1. package BinComp;
  2. use strict;
  3. use Carp;
  4. use Win32::Pipe;
  5. use Win32::Process;
  6. use Win32;
  7. sub new {
  8. my $class = shift;
  9. my $instance = {
  10. DIFF => '',
  11. ERR => ''
  12. };
  13. return bless $instance;
  14. }
  15. sub GetLastError {
  16. my $self = shift;
  17. if (!ref $self) {croak "Invalid object reference"}
  18. return $self->{ERR};
  19. }
  20. sub GetLastDiff {
  21. my $self = shift;
  22. if (!ref $self) {croak "Invalid object reference"}
  23. return $self->{DIFF};
  24. }
  25. sub ExecCmd {
  26. if ( @_ < 3 ) {croak "Invalid parameters to ExecCmd"}
  27. my $self = shift;
  28. my $exe_path = shift; # path to exe
  29. my $params = shift; # parameters
  30. my $exit_code = shift; # (OPTIONAL) exit code of process stored here
  31. my $output = shift; # (OPTIONAL) output of process is stored here
  32. if (!ref $self) {croak "Invalid object reference"}
  33. if ( $exit_code && 'SCALAR' ne ref $exit_code ||
  34. $output && 'SCALAR' ne ref $output ) {
  35. croak "Invalid parameters to ExecCmd";
  36. }
  37. # Open up a pipe to read spawned process output
  38. my $pipe_name = "spawn$$";
  39. my $pipe = new Win32::Pipe($pipe_name);
  40. if ( !defined $pipe ) {
  41. $self->{ERR} = "Error executing child command: ". $pipe->Error();
  42. return;
  43. }
  44. # Redirect STDOUT and STDERR as child process will inherit
  45. open R_STDOUT, ">&STDOUT";
  46. open R_STDERR, ">&STDERR";
  47. if ( !open STDOUT, ">\\\\.\\pipe\\$pipe_name" ) {
  48. $self->{ERR} = "Error executing child command: $!";
  49. return;
  50. }
  51. if ( !open STDERR, ">&STDOUT" ) {
  52. $self->{ERR} = "Error executing child command: $!";
  53. # Restore STDOUT
  54. close STDOUT; open STDOUT, ">&R_STDOUT";
  55. return;
  56. }
  57. # Construct command as <exe> <params>
  58. my $command = $exe_path;
  59. $command =~ s/(?:.*\\)?([^\\]+)$/$1/;
  60. $command .= " $params";
  61. # Spawn process
  62. my ($process, $ret);
  63. $ret = Win32::Process::Create( $process,
  64. $exe_path,
  65. $command,
  66. 0,
  67. NORMAL_PRIORITY_CLASS,
  68. '.' );
  69. if ( !$ret ) {
  70. $self->{ERR} = "Error executing child command: $^E";
  71. # can't exit here as our STDOUT and STDERR are still redirected
  72. }
  73. # Restore STDOUT/STDERR
  74. close STDOUT; close STDERR;
  75. open STDOUT, ">&R_STDOUT";
  76. open STDERR, ">&R_STDERR";
  77. if ( !$ret ) {return;}
  78. # Wait for process to terminate
  79. $process->Wait(INFINITE);
  80. # Store output and exit code
  81. $process->GetExitCode( $$exit_code ) if $exit_code;
  82. $$output = $pipe->Read() if $output;
  83. # Close the pipe
  84. $pipe->Close();
  85. # Successfully completed
  86. return 1;
  87. }
  88. #
  89. # 0 - different
  90. # 1 - same
  91. # undefined - error
  92. #
  93. sub compare {
  94. my $self = shift;
  95. my $base = shift;
  96. my $upd = shift;
  97. if (!ref $self) {croak "Invalid object reference"}
  98. if (!$base||!$upd) {croak "Invalid function call -- missing required parameters"}
  99. if ( ! -e $base ) {
  100. $self->{ERR} = "Invalid file: $base";
  101. return;
  102. }
  103. if ( ! -e $upd ) {
  104. $self->{ERR} = "Invalid file: $upd";
  105. return;
  106. }
  107. my ($exit_code, $verbose);
  108. if ( !$self->ExecCmd( "$ENV{RazzleToolPath}\\$ENV{PROCESSOR_ARCHITECTURE}\\pecomp.exe",
  109. "$base $upd",
  110. \$exit_code,
  111. \$verbose ) ) {
  112. $self->{ERR} = "Error calling pecomp.exe - $self->{ERR}";
  113. return;
  114. }
  115. elsif ( 999999999 == $exit_code ) {
  116. chomp $verbose;
  117. $self->{ERR} = $verbose;
  118. return;
  119. }
  120. elsif ( $exit_code ) {
  121. chomp $verbose;
  122. $self->{DIFF} = $verbose;
  123. return 0;
  124. }
  125. else {
  126. # Compare equal
  127. return 1;
  128. }
  129. }
  130. 1;