ictclas.pas

解码器是基于短语的统计机器翻译系统的核心模块

(*
* ICTCLAS.PAS  -  Interfaces: ICTCLAS from ICT, CAS
*
* Copyright (C) 2006 by Yidong Chen <[e-mail]>
Institute of Artificial Intelligence, Xiamen University

* Begin       : 09/18/2006
* Last Change : 09/18/2006
*
* This program is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
* License as published by the Free Software Foundation; either
* version 2.1 of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
*)

UNIT ICTCLAS;

INTERFACE

PROCEDURE Init(strICTCLASPath: STRING);
FUNCTION SegSent(strInput: STRING): STRING;
PROCEDURE CleanUp;

IMPLEMENTATION

USES
  Windows, SysUtils, Classes, COMMON;

CONST
  DLL_ICTCLAS='ictdll.dll';

  PROC_InitICT='_InitICT@4';
  FUNC_ICTSeg='_ICTSeg@16';
  PROC_CleanUpICT='_CleanUpICT@0';

  ICT_OK=0;
  ICT_ERROR=-1;
  ICT_BUFTOSMALL=-2;
TYPE
  //From ictdll.dll
  TProcInitICT=PROCEDURE(pcDataPath: PChar); STDCALL;
  TFuncICTSeg=FUNCTION(pcInput: PChar; ilen: Integer; pOutBuf: PChar; iBufLen: Integer):Integer; STDCALL;
  TProcCleanUpICT=PROCEDURE; STDCALL;

  TIWrap=CLASS
  PRIVATE
    FbisInitOK: Boolean;

    hICTCLAS: Cardinal;

    procInitICT:TProcInitICT;
    funcICTSeg:TFuncICTSeg;
    procCleanUpICT: TProcCleanUpICT;
  PUBLIC
    PROPERTY isInitOK: Boolean READ FbisInitOK;

    CONSTRUCTOR Create(strICTCLASPath: STRING);
    FUNCTION SegSent(strInput: STRING): STRING;
    DESTRUCTOR Destroy; OVERRIDE;
  END;

VAR iwICTCLAS: TIWrap;
    wSaved8087CW: Word;

{$IFDEF CONSOLE}
PROCEDURE PrintErrMsg(strErrMsg: STRING);
BEGIN
  WriteLn(strErrMsg);
END;
{$ELSE}
PROCEDURE PrintErrMsg(strErrMsg: STRING);
BEGIN
  MessageBox(0,PChar(strErrMsg),'出错',MB_OK);
END;
{$ENDIF}

PROCEDURE DLLMissing(strDLLPathName: STRING; VAR bisInitOK: Boolean);
VAR strTemp: STRING;
BEGIN
  strTemp:='动态链接库'+strDLLPathName+'丢失，请与提供商联系！';
  IF bisInitOK THEN PrintErrMsg(strTemp);
  bisInitOK:=False;
END;

PROCEDURE FuncNotExported(strDLLPathName, strFuncName: STRING; VAR bisInitOK: Boolean);
VAR strTemp: STRING;
BEGIN
  strTemp:='动态链接库'+strDLLPathName+'中的'+strFuncName+'未导出，请与提供商联系！';
  IF bisInitOK THEN PrintErrMsg(strTemp);
  bisInitOK:=False;
END;

PROCEDURE InitFailed(strModule: STRING; VAR bisInitOK: Boolean);
VAR strTemp: STRING;
BEGIN
  strTemp:=strModule+'模块初始化失败，请与提供商联系！';
  IF bisInitOK THEN PrintErrMsg(strTemp);
  bisInitOK:=False;
END;

CONSTRUCTOR TIWrap.Create(strICTCLASPath: STRING);
VAR strTemp: STRING;
BEGIN
  INHERITED Create;

  FbisInitOK:=True;

(* Initialize all the data member to zero. -- start *)
  hICTCLAS:=0;

  procInitICT:=NIL;
  funcICTSeg:=NIL;
  procCleanUpICT:=NIL;
(* Initialize all the data member to zero. -- end *)

  strTemp:=strICTCLASPath+DLL_ICTCLAS;
  hICTCLAS:=LoadLibrary(PChar(strTemp));

  //...load functions.

  IF hICTCLAS<>0 THEN
    BEGIN
      procInitICT:=TProcInitICT(GetProcAddress(hICTCLAS,PChar(PROC_InitICT)));
      IF @procInitICT=NIL THEN FuncNotExported(strICTCLASPath+DLL_ICTCLAS,PROC_InitICT, FbisInitOK);
      funcICTSeg:=TFuncICTSeg(GetProcAddress(hICTCLAS,PChar(FUNC_ICTSeg)));
      IF @funcICTSeg=NIL THEN FuncNotExported(strICTCLASPath+DLL_ICTCLAS,FUNC_ICTSeg, FbisInitOK);
      procCleanUpICT:=TProcCleanUpICT(GetProcAddress(hICTCLAS,PChar(PROC_CleanUpICT)));
      IF @procCleanUpICT=NIL THEN FuncNotExported(strICTCLASPath+DLL_ICTCLAS,PROC_CleanUpICT, FbisInitOK);
    END
  ELSE DLLMissing(strICTCLASPath+DLL_ICTCLAS,FbisInitOK);

  //...init every modules.

  IF (@procInitICT<>NIL) THEN procInitICT(PChar(ConvertToCDir(strICTCLASPath)));
END;

CONST
  INITLEN=127;
  MAXLEN=131071;
  MAGICLEN=127;

FUNCTION TIWrap.SegSent(strInput: STRING): STRING;
VAR
  pcTarget: PChar;
  iLen: Integer;
  bTemp: Boolean;
BEGIN
  IF NOT FbisInitOK THEN BEGIN Result:=''; Exit; END;

  iLen:=INITLEN;
  bTemp:=False;
  pcTarget:=NIL;
  WHILE iLen<MAXLEN DO
    BEGIN
      ReallocMem(pcTarget,iLen);
      FillChar(pcTarget^,iLen,#0);
      IF funcICTSeg(PChar(strInput),Length(strInput),pcTarget,iLen)<>ICT_OK THEN iLen:=iLen+MAGICLEN
      ELSE BEGIN bTemp:=True; Break; END;
    END;
  IF NOT bTemp THEN
    BEGIN
      FreeMem(pcTarget);
      Result:='';
    END
  ELSE
    BEGIN
      SetLength(Result,StrLen(pcTarget));
      Move(pcTarget^,Result[1],StrLen(pcTarget));
      FreeMem(pcTarget);
    END;
END;

DESTRUCTOR TIWrap.Destroy;
BEGIN
  IF @procCleanUpICT<>NIL THEN procCleanUpICT;
  IF hICTCLAS<>0 THEN FreeLibrary(hICTCLAS);
  INHERITED Destroy;
END;

PROCEDURE Init(strICTCLASPath: STRING);
BEGIN
  wSaved8087CW := Default8087CW;
  Set8087CW($133f);

	iwICTCLAS:=TIWrap.Create(strICTCLASPath);
END;

FUNCTION SegSent(strInput: STRING): STRING;
BEGIN
	Result:=iwICTCLAS.SegSent(strInput);
END;

PROCEDURE CleanUp;
BEGIN
	iwICTCLAS.Free;
  Set8087CW(wSaved8087CW);
END;

END.