2008-10-24 3 views
2

Довольно странный опыт. Используя последнюю версию PDK (v7.3) из ActiveState, я использовал perlctrl для создания COM-библиотеки DLL. Перлктрл бежал без затруднений. OLEView читал typelib в порядке. RegSvr32 зарегистрировал его в порядке. Однако ... в реестре нет никаких признаков, и все, что пытается его использовать, терпит неудачу. Я охотился за различными UID, используя RegEdit, и их просто нет.RegSvr32 регистрируется, пока ничего не зарегистрировано

Код приведен ниже. Это оболочка Lingua :: ZH :: WordSegmenter, но с кодировкой изменено на utf8, а не на gbk.

Это, вероятно, что-то очевидно ...

package ZHWordSeg; 

use strict; 
use warnings; 
use utf8; 
use ws; 

use Encode; 

use constant STX => chr(2); #[ 
use constant ETX => chr(3); #] 
use constant FS => chr(28); #^ 
use constant RS => chr(30); #~ 

use constant TAB_SEPARATOR => 0; 
use constant CARET_SEPARATOR => 1; 
use constant FS_SEPARATOR => 2; 
use constant SPACE_SEPARATOR => 3; 
use constant AS_ARRAY => 4; 

use feature 'switch'; 

our $segmenter; 

sub ZHWordSeg_Setup { 
    my $dic = shift; 
    my $dic_encoding = shift; 
    my $separator = shift; 
    my $verbose = shift; 

    $dic_encoding = 'utf8' unless defined($dic_encoding); 
    $separator = " " unless defined($separator); 
    $verbose = 0 unless defined($verbose); 

    if (defined($dic)) { 
    $segmenter = ws->new(dic => $dic, dic_encoding => $dic_encoding, seperator => $separator, verbose => $verbose); 
    } else { 
    $segmenter = ws->new(dic_encoding => $dic_encoding, seperator => $separator, verbose => $verbose); 
    } 
} 

sub ZHWordSeg { 
    my $source = shift; 
    print STDERR $source; 
    my $sepcode = shift; 
    $source = encode("utf8",$source); 
    my $stringres = $segmenter->seg($source); 
    my @arrayres; 

    given ($sepcode) { 
    when (TAB_SEPARATOR) { 
     $stringres =~ tr/ /\t/; 
     return $stringres; 
    } 
    when (CARET_SEPARATOR) { 
     $stringres =~ tr/ /^/; 
     $stringres .= "^"; 
     return $stringres; 
    } 
    when (FS_SEPARATOR) { 
     $stringres =~ s/ /FS/eg; 
     $stringres .= FS; 
     return $stringres; 
    } 
    when (SPACE_SEPARATOR) { 
     return $stringres; 
    } 
    default { 
     @arrayres = split(/ /, $stringres); 
     return \@arrayres; 
    } 
    } 
} 

sub SetDictionary { 
    my ($source) = shift; 
    my $res = set_dic($source); 
    return $res; 
} 

1; 

=pod 

=begin PerlCtrl 

%TypeLib = (
    PackageName  => 'ZHWordSeg', 
    DocString  => 'Chinese word segmentation', 
    HelpContext  => 1, 
    TypeLibGUID  => '{F6C9BD66-7CA1-4610-B77F-E219A7122C18}', # do NOT edit this line 
    ControlGUID  => '{45D47C6A-2B9A-4D62-9CFD-F18C95DC00C5}', # do NOT edit this line either 
    DispInterfaceIID=> '{007E4E7A-3B75-4DC3-864C-7746860941B3}', # or this one 
    ControlName  => 'BOCWS', 
    ControlVer  => 2, # increment if new object with same ProgID 
    # create new GUIDs as well 
    ProgID   => 'ZHWordSeg.BOCWS', 
    LCID   => 0, 
    DefaultMethod => 'ChineseWordSegmenter', 
    Methods   => { 
     'ChineseWordSegmenter' => { 
     RetType    => VT_VARIANT, 
     TotalParams   => 2, 
     NumOptionalParams => 1, 
     ParamList   => 
      [ 'source' => VT_BSTR, 
      'sepcode' => VT_I4 
      ] 
     }, 
     'ChineseWordSegmenter_Setup' => { 
     RetType    => VT_VARIANT, 
     TotalParams   => 4, 
     NumOptionalParams => 4, 
     ParamList   => 
      [ 'dic' => VT_BSTR, 
      'dic_encoding' => VT_BSTR, 
      'separator' => VT_BSTR, 
      'verbose' => VT_BSTR 
      ] 
     } 
    }, # end of 'Methods' 
    Properties  => { 
    TAB_SEPARATOR => { 
     DocString => "Separate items with TAB (0x0)", 
     Type => VT_I4, 
     DispID => 3, 
     ReadOnly => 1, 
    }, 
    CARET_SEPARATOR => { 
     DocString => "Separate items with^(0x1)", 
     Type => VT_I4, 
     DispID => 4, 
     ReadOnly => 1, 
    }, 
    FS_SEPARATOR => { 
     DocString => "Separate items with ascii 28 (0x2)", 
     Type => VT_I4, 
     DispID => 5, 
     ReadOnly => 1, 
    }, 
    SPACE_SEPARATOR => { 
     DocString => "Separate items with space (0x3)", 
     Type => VT_I4, 
     DispID => 6, 
     ReadOnly => 1, 
    }, 
    AS_ARRAY => { 
     DocString => "Separate items as array (0x4)", 
     Type => VT_I4, 
     DispID => 7, 
     ReadOnly => 1, 
    } 
    }, # end of 'Properties' 
); # end of %TypeLib 

=end PerlCtrl 

=cut 

Это .perlctrl файл, в случае, если это имеет значение:

#!C:\Program Files\ActiveState Perl Dev Kit 7.3 Deployment\bin\lib\pai.exe 
PAP-Version: 1.0 
Packer: C:\Program Files\ActiveState Perl Dev Kit 7.3 Deployment\bin\perlctrl.exe 
Script: ZHWordSeg.ctrl 
Cwd: P:\BOCWS 
Byref: 0 
Clean: 0 
Date: 2008-10-24 18:05:42 
Debug: 127.0.0.1:2000 
Dependent: 0 
Dyndll: 0 
Exe: BOCWS.dll 
Force: 1 
Gui: 0 
Hostname: xi 
No-Compress: 0 
No-Gui: 0 
No-Logo: 0 
Runlib: 
Shared: none 
Singleton: 0 
Tmpdir: 
Verbose: 0 
Version-Comments: 
Version-CompanyName: 
Version-FileDescription: Wrapper of Lingua::ZH::WordSegmenter.pm 
Version-FileVersion: 1.0 
Version-InternalName: ZHWordSeg 
Version-LegalCopyright: 
Version-LegalTrademarks: 
Version-OriginalFilename: ZHWordSeg.ctrl 
Version-ProductName: BOChineseWordSegmenter 
Version-ProductVersion: 1.0 
Warnings: 0 
Xclude: 1 

ответ

1

Единственный "solution", что я нашел было предложено более на новостях: comp.os.ms-windows.programmer.win32

Я не являюсь пользователем PDK, но из опыта я могу сказать вам, что вы шо uld проверяет код экспорта DllRegister и то, что он делает внутренне, поскольку это то, что вызывает regsvr32, и этот код создает ключи реестра для вашего COM-сервера/прокси и т. д., ...

Вы можете отслеживать изменения реестра с помощью инструментов sysinternal, таких как regmon или procmon, просто чтобы убедиться!

В конечном счете, я сдался и вернулся к предыдущей версии, которая сработала и изменила ее.