Удаление EXIF информации в VBA

[proc]

Удаление EXIF информации в VBA

Привет всем!

Понимаю, что тут вопрос по Visual Basic не в тему, но..... Перерыл весь интернет и ничего не нашел. Как программным путем удалить EXIF информацию из JPG файла (Visual Basic for Application 6, Corel Photo-Paint 12)

HEEEEEEELP!!!!!

Спасибо

 

[SiMM]

Взято у Степанищева

#!/usr/bin/php -q
<?
  // Version v1.22

  $help = <<<HELP

\033[1;37m+-------------------------------------------+
| \033[1;32mPhotoshop's Crap Remover (in JPEG files).\033[0m \033[1;37m|
| \033[1;32m2002. Evgeny Stepanischev aka BOLK\033[0m        \033[1;37m|
|                                           |
|  \033[1;31mUsage: pcr.php jpeg_file [out_file]\033[0m      \033[1;37m|
+-------------------------------------------+\033[0m

HELP;

  if ($is_windows = (substr($OS, 0, 7) == 'Windows' || substr($_ENV['OS'], 0, 7) == 'Windows'))
  $help = preg_replace ("/\\033\\[[\d;]+m/", '', $help);

  function showerr ($str)
  {
    echo $str, "\n";
    exit;
  }

  function cecho ($str, $color)
  {
    global $is_windows;

    if (!$is_windows) echo "\033[", $color, "m";
    echo $str;
    if (!$is_windows) echo "\033[0m";
  }

  function DetermineFormat(&$fp)
  {
    # Check for SOI segment
    if ("\xFF\xD8" <> fread ($fp, 2)) showerr ("Invalid file format (not a JPEG file).");
  }

  function SegReg($h, $str, $s, $e)
  {
    if ($h >= $s && $h <= $e)
    return $str.(ord($h) - ord($s));
    return false;
  }

  function TypeOfSeg($h)
  {
    $type = array ("\xC4" => "DHT", "\xC8" => 'JPG', "\xCC" => 'DAC', "\xD8" => 'SOI', "\xD9" => 'EOI',
    "\xDA" => 'SOS', "\xDB" => 'DQT', "\xDC" => 'DNL', "\xDD" => 'DRI', "\xFE" => 'COM');

    if (isset($type[$h])) return $type[$h];
    if (($v = SegReg($h, 'SOF', "\xC0", "\xCA")) !== false) return $v;
    if (($v = SegReg($h, 'RST', "\xD0", "\xD7")) !== false) return $v;
    if (($v = SegReg($h, 'APP', "\xE0", "\xEF")) !== false) return $v;

    return 'UNKNOWN';
  }

  if (count($argv) == 2)
  $argv[2] = $is_windows ? 'nul' : '/dev/null'; else
  if (count($argv) < 2) showerr ($help);

  $fp = @fopen ($argv[1], 'r');
  if (!$fp) showerr ('Cannot open the file.');
  DetermineFormat ($fp);

  $fd = @fopen ($argv[2], 'w');
  if (!$fd) showerr ('Cannot create destination file.');

  fwrite ($fd, "\xFF\xD8");             // Write JPEG header

  cecho ("\n  Hello, fella! Let's rock. Reading '$argv[1]' file.\n-----------------------------------------------------\n\n", '1;30');

  for ($sum = 0; !feof ($fp); )
  {
    $handle = fread ($fp, 2);
    $seg = join ('', unpack("H*", $handle));

    if ($handle[0] <> "\xFF") showerr ("Error file format.");
    if ($handle[1] == "\x01" || $handle[1] >= "\xD0" && $handle[1] <= "\xD7") continue; # Two-bytes segment
    if ($handle[1] == "\xDA") break;

    $type = TypeOfSeg ($handle[1]);

    $len = join('', unpack ('n', $str = fread ($fp, 2)));

    if ($type == 'UNKNOWN' || $handle[1] >= "\xE0" && $handle[1] <= "\xEF" || $handle[1] == "\xFE")
    {
      fseek ($fp, $len - 2, SEEK_CUR);
//      echo preg_replace('/\W/', '_', fread ($fp, $len - 2))."\n\n";;
      cecho ('  Cleaning "'.$type.'" segment (size '.($len + 2). " bytes).\n", '1;32'); 

      $sum += $len + 2;
    } else
    {
      cecho ("  Copying '$seg' (\"$type\") segment (size ".($len + 2)." bytes).\n", '1;37');
      fwrite ($fd, $handle);
      fwrite ($fd, $str.fread ($fp, $len - 2));
    }
  }

  if (!feof($fp))
  {
    cecho ("  Copying 'ffda' (\"SOS\") segment.\n", '1;37');

    fwrite ($fd, "\xFF\xDA");             // Write SOS signature

    while (!feof($fp))                  // Copy content
    fwrite ($fd, fread ($fp, 4096));
  }

  cecho ("\n-----------------------------------------------------", '1;30');
  cecho ("\n\nTotal stripped: $sum byte(s).\n\n", '1;31');

  fclose ($fp);
  fclose ($fd);
?>

С VB разбирайтесь сами - алгоритм всё равно остаётся тем же.

 

[proc]

Ok. Спасибо, буду кавырять