+This is also available in a plain-text format for download. +
+To use this script, follow the instructions +or wait for the next version, which will be easier to install. +
+
>001 use Win32::TieRegistry ( Delimiter=>"/", ArrayValues=>1 ); +002 use Locale::Language; +003 use strict; +004 use warnings; +005 +006 my %languages = ( +007 '00' => 'DV', +008 '01' => 'CY', +009 '02' => 'Syriac', +010 '03' => 'Northern Sotho', +011 '04' => '--', +012 '05' => '--', +013 '06' => '--', +014 '07' => 'NE', +015 '08' => '--', +016 '09' => '--', +017 '0A' => '--', +018 '0B' => '--', +019 '0C' => 'QU', +020 '0D' => '--', +021 '0E' => '--', +022 '0F' => '--', +023 '10' => 'BN', +024 '11' => 'PA', +025 '12' => 'GU', +026 '13' => 'OR', +027 '14' => 'ST', # Southern Sotho +028 '15' => 'SE', +029 '16' => 'KA', +030 '17' => 'HI', +031 '18' => 'AS', +032 '19' => 'MR', +033 '1A' => 'SA', +034 '1B' => 'Konkani', +035 '1C' => 'TA', +036 '1D' => 'TE', +037 '1E' => 'KN', +038 '1F' => 'ML', +039 '40' => 'NB', +040 '41' => 'PL', +041 '42' => 'PT', +042 '43' => 'RM', +043 '44' => 'IT', +044 '45' => 'JA', +045 '46' => 'KO', +046 '47' => 'NL', +047 '48' => 'SQ', +048 '49' => 'SV', +049 '4A' => 'TH', +050 '4B' => 'TR', +051 '4C' => 'RO', +052 '4D' => 'RU', +053 '4E' => 'HR', # Also Serbian and Bosnian. +054 '4F' => 'SK', +055 '50' => 'ZH', +056 '51' => 'CS', +057 '52' => 'DA', +058 '53' => 'DE', +059 '54' => '--', +060 '55' => 'AR', +061 '56' => 'BG', +062 '57' => 'CA', +063 '58' => 'FR', +064 '59' => 'HE', +065 '5A' => 'HU', +066 '5B' => 'IS', +067 '5C' => 'EL', +068 '5D' => 'EN', +069 '5E' => 'ES', +070 '5F' => 'FI', +071 '60' => 'FO', +072 '61' => 'MT', +073 '62' => 'GA', +074 '63' => 'MS', +075 '64' => '--', +076 '65' => 'XH', +077 '66' => 'ZU', +078 '67' => 'AF', +079 '68' => 'UZ', +080 '69' => 'TT', +081 '6A' => 'MN', +082 '6B' => 'GL', +083 '6C' => 'KK', +084 '6D' => 'SW', +085 '6E' => 'TL', +086 '6F' => 'KY', +087 '70' => 'SL', +088 '71' => 'ET', +089 '72' => 'LV', +090 '73' => 'LT', +091 '74' => 'UR', +092 '75' => 'ID', +093 '76' => 'UK', +094 '77' => 'BE', +095 '78' => 'AZ', +096 '79' => 'EU', +097 '7A' => 'Sorbian', +098 '7B' => 'MK', +099 '7C' => 'MI', +100 '7D' => 'FA', +101 '7E' => 'VI', +102 '7F' => 'HY', +103 ); +104 +105 +106 my $key_not_found = 0; +107 my $key = $Registry->{'HKEY_LOCAL_MACHINE/SOFTWARE/Wow6432Node/TRADOS/'} or $key_not_found = 1; +108 if ($key_not_found) { +109 $key_not_found = 0; +110 $key = $Registry->{'HKEY_LOCAL_MACHINE/SOFTWARE/TRADOS/'} or $key_not_found = 1; +111 } +112 if ($key_not_found) { +113 print "TRADOS 2007 does not appear to be installed on your machine (can't find Registry key)\n"; +114 <STDIN>; +115 exit; +116 } +117 +118 my $a = $key->{'Shared/IDNG//'} or $key_not_found = 1; +119 +120 if ($key_not_found) { +121 print "TRADOS 2007 appears to be installed, but your Registry is configured in an unexpected way.\n"; +122 <STDIN>; +123 exit; +124 } +125 +126 my $idng = $a->[0]; +127 +128 DISPLAY: +129 if (not $idng =~ /{(.*-.*-.*-.*-00)(.*)}/) { +130 print "Unexpected IDNG value $idng encountered.\n"; +131 <STDIN>; +132 exit; +133 } +134 my ($prefix, $meat) = ($1, $2); +135 +136 print "IDNG: $idng\n\n"; +137 my $slot = 0; +138 foreach my $language (unpack("(A2)*", $meat)) { +139 my $l = $languages{$language} || "-- ($language)"; +140 my $ln = code2language($l); +141 $ln = "Croatian/Serbian/Bosnian" if $l eq 'HR'; +142 $l .= " ($ln)" if $ln; +143 $slot++; +144 print "$slot: $l\n"; +145 } +146 print "\n"; +147 print "Enter new values or <Enter> to quit: "; +148 +149 READ: +150 my $line = <STDIN>; +151 chomp $line; +152 exit unless $line; +153 +154 my @values = split / /, $line; +155 if (@values > 5) { +156 print "Need 1 to 5 values or <Enter> to quit: "; +157 goto READ; +158 } +159 +160 my $problem = 0; +161 foreach my $s (0, 1, 2, 3, 4) { +162 +163 if ($s + 1 > @values or $values[$s] eq '--') { +164 $values[$s] = '84'; # Standard not-used +165 next; +166 } +167 if ($values[$s] =~ /^[0-9][0-9A-F]$/) { +168 $values[$s] =~ tr/a-z/A-Z/; +169 next; +170 } +171 my $ln = language2code ($values[$s]); +172 $values[$s] = $ln if $ln; +173 $values[$s] =~ tr/a-z/A-Z/; +174 $values[$s] = 'HR' if $values[$s] eq 'SR' or $values[$s] eq 'BS'; +175 foreach my $n (keys %languages) { +176 if (lc($languages{$n}) eq lc($values[$s])) { +177 $values[$s] = $n; +178 goto NEXTNEXT; +179 } +180 } +181 $problem = 1; +182 print sprintf("Don't understand value in slot \n", $values[$s], $s + 1); +183 NEXTNEXT: +184 } +185 +186 if ($problem) { +187 print "Need 1 to 5 values or <Enter> to quit: "; +188 goto READ; +189 } +190 +191 $idng = sprintf ("{$prefix}", join ('', @values)); +192 $key->{'Shared/IDNG//'} = [$idng, 1]; +193 goto DISPLAY; ++ +