neon.pas

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

(*
* NEON.PAS  -  Interfaces: Neon from mandel
*
* 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 NEON;

INTERFACE

USES Classes;

PROCEDURE Init(strCEMTPath: STRING; bToUseTraditional: Boolean=False);
FUNCTION TranSent(strInput: STRING): STRING;
FUNCTION LoopUp(strAWord: STRING; strlTarget: TStringList): Boolean;
PROCEDURE CleanUp;

IMPLEMENTATION

USES
  Windows, SysUtils, COMMON;

CONST
  DLL_CEMTAPI='mtapi.dll';

  FUNC_CEInitMTEngine='InitMTEngine';
  FUNC_CETranSent='TranSent';
  FUNC_CEfTranSent='fTranSent';
  FUNC_CETranWord='TranWord';
  FUNC_CEfTranWord='fTranWord';
  PROC_jTof='jTof';
  PROC_CEDoneMTEngine='DoneMTEngine';

  //From mtapi.dll
  mtOK     = 0;
  mtError  = -1;

  errBufferTooSmall = -2;
  errQualityLow     = -3;
  errNotTranslated  = -4;
  errOutOfMemory    = -5;
  errInternalError  = -6;
  errFileFormat     = -7;
  errFileNotFind    = -8;

TYPE
  //From mtapi.dll
  TFuncCEInitMTEngine=FUNCTION(VAR iVersion: Integer; pcPath: PChar):Integer; STDCALL;
  TFuncCETranSent=FUNCTION(pcSource, pcTarget: PChar; iBufLen: Integer):Integer; STDCALL;
  TFuncCEfTranSent=FUNCTION(pcSource, pcTarget: PChar; iBufLen: Integer):Integer; STDCALL;
  TFuncCETranWord=FUNCTION(pcSource, pcTarget: PChar; iBufLen: Integer):Integer; STDCALL;
  TFuncCEfTranWord=FUNCTION(pcSource, pcTarget: PChar; iBufLen: Integer):Integer; STDCALL;
  TProcjTof=PROCEDURE(pcSource: PChar); STDCALL;
  TProcCEDoneMTEngine=PROCEDURE; STDCALL;

  TIWrap=CLASS
  PRIVATE
    FbisInitOK: Boolean;
    bisCEMTInitOK: Boolean;

    hCEMTEngine: Cardinal;

    bToUseTraditional: Boolean;

    funcCEInitEngine:TFuncCEInitMTEngine;
    funcCETranSent:TFuncCETranSent;
    funcCEfTranSent:TFuncCEfTranSent;
    funcCETranWord:TFuncCETranWord;
    funcCEfTranWord:TFuncCEfTranWord;
    procjTof:TProcjTof;
    procCEDoneMTEngine:TProcCEDoneMTEngine;
  PUBLIC
    PROPERTY isInitOK: Boolean READ FbisInitOK;

    CONSTRUCTOR Create(strCEMTPath: STRING; init_bToUseTraditional: Boolean=False);
    FUNCTION TranSent(strInput: STRING): STRING;
    FUNCTION LoopUp(strAWord: STRING; strlTarget: TStringList): Boolean;
    DESTRUCTOR Destroy; OVERRIDE;
  END;

VAR iwCEMT: TIWrap;

{$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(strCEMTPath: STRING; init_bToUseTraditional: Boolean=False);
VAR strTemp: STRING; iTemp: Integer;
BEGIN
  INHERITED Create;

  FbisInitOK:=True;

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

  bisCEMTInitOK:=False;

  funcCEInitEngine:=NIL;
  funcCETranSent:=NIL;
  funcCEfTranSent:=NIL;
  funcCETranWord:=NIL;
  funcCEfTranWord:=NIL;
  procjTof:=NIL;
  procCEDoneMTEngine:=NIL;
(* Initialize all the data member to zero. -- end *)

  strTemp:=strCEMTPath+DLL_CEMTAPI;
  hCEMTEngine:=LoadLibrary(PChar(strTemp));

  //...load functions.

  IF hCEMTEngine<>0 THEN
    BEGIN
      funcCEInitEngine:=TFuncCEInitMTEngine(GetProcAddress(hCEMTEngine,PChar(FUNC_CEInitMTEngine)));
      IF @funcCEInitEngine=NIL THEN FuncNotExported(strCEMTPath+DLL_CEMTAPI,FUNC_CEInitMTEngine, FbisInitOK);
      funcCETranSent:=TFuncCETranSent(GetProcAddress(hCEMTEngine,PChar(FUNC_CETranSent)));
      IF @funcCETranSent=NIL THEN FuncNotExported(strCEMTPath+DLL_CEMTAPI,FUNC_CETranSent, FbisInitOK);
      funcCEfTranSent:=TFuncCEfTranSent(GetProcAddress(hCEMTEngine,PChar(FUNC_CEfTranSent)));
      IF @funcCEfTranSent=NIL THEN FuncNotExported(strCEMTPath+DLL_CEMTAPI,FUNC_CEfTranSent, FbisInitOK);
      funcCETranWord:=TFuncCETranWord(GetProcAddress(hCEMTEngine,PChar(FUNC_CETranWord)));
      IF @funcCETranWord=NIL THEN FuncNotExported(strCEMTPath+DLL_CEMTAPI,FUNC_CETranWord, FbisInitOK);
      funcCEfTranWord:=TFuncCEfTranWord(GetProcAddress(hCEMTEngine,PChar(FUNC_CEfTranWord)));
      IF @funcCEfTranWord=NIL THEN FuncNotExported(strCEMTPath+DLL_CEMTAPI,FUNC_CEfTranWord, FbisInitOK);
      procjTof:=TProcjTof(GetProcAddress(hCEMTEngine,PChar(PROC_jTof)));
      IF @procjTof=NIL THEN FuncNotExported(strCEMTPath+DLL_CEMTAPI,PROC_jTof, FbisInitOK);
      procCEDoneMTEngine:=TProcCEDoneMTEngine(GetProcAddress(hCEMTEngine,PChar(PROC_CEDoneMTEngine)));
      IF @procCEDoneMTEngine=NIL THEN FuncNotExported(strCEMTPath+DLL_CEMTAPI,PROC_CEDoneMTEngine, FbisInitOK);
    END
  ELSE DLLMissing(strCEMTPath+DLL_CEMTAPI,FbisInitOK);

  //...init every modules.

  IF (@funcCEInitEngine<>NIL) THEN
    BEGIN
      bToUseTraditional:=init_bToUseTraditional;
      bisCEMTInitOK:=(funcCEInitEngine(iTemp,PChar(strCEMTPath))=0);
      IF NOT bisCEMTInitOK THEN InitFailed('汉英自动翻译',FbisInitOK);
    END;
END;

CONST
  LEN_MAGICNUM_CE=5;
  LEN_MAGICNUM_DICT=10;
  LEN_MAX=131071;

FUNCTION TIWrap.TranSent(strInput: STRING): STRING;
VAR pcSource, pcTarget: PChar; strTemp: STRING; iLen: Integer; bTemp: Boolean;
    strTheSour: STRING;
BEGIN
  IF NOT bisCEMTInitOK THEN BEGIN Result:=''; Exit; END;

  strTemp:=strInput;
  strTheSour:=strInput;
  IF strTemp='' THEN BEGIN Result:=''; Exit; END;
  SetLength(strTemp,Length(strTemp)+1);
  strTemp[Length(strTemp)]:=Chr(0);
  pcSource:=@strTemp[1];

  iLen:=Length(strInput)*LEN_MAGICNUM_CE+1;
  bTemp:=False;
  pcTarget:=NIL;
  WHILE iLen<LEN_MAX DO
    BEGIN
      ReallocMem(pcTarget,iLen);
      FillChar(pcTarget^,iLen,#0);
      IF NOT bToUseTraditional THEN
        IF funcCETranSent(pcSource,pcTarget,iLen)<>mtOK THEN iLen:=iLen*LEN_MAGICNUM_CE+1
        ELSE BEGIN bTemp:=True; Break; END
      ELSE
        IF funcCEfTranSent(pcSource,pcTarget,iLen)<>mtOK THEN iLen:=iLen*LEN_MAGICNUM_CE+1
        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;

FUNCTION TIWrap.LoopUp(strAWord: STRING; strlTarget: TStringList): Boolean;
VAR pcSource, pcTarget: PChar; strTemp: STRING; iLen: Integer; bTemp: Boolean;
    strTheSour: STRING; strTranslation, strLooper: STRING;
BEGIN
  Result:=False;
  //IF strlTarget=NIL THEN Exit;
  //strlTarget.Clear;
  IF NOT bisCEMTInitOK THEN Exit;

  strTemp:=strAWord;
  strTheSour:=strAWord;
  IF strTemp='' THEN Exit;
  SetLength(strTemp,Length(strTemp)+1);
  strTemp[Length(strTemp)]:=Chr(0);
  pcSource:=@strTemp[1];

  iLen:=Length(strAWord)*LEN_MAGICNUM_DICT+1;
  bTemp:=False;
  pcTarget:=NIL;
  WHILE iLen<LEN_MAX DO
    BEGIN
      ReallocMem(pcTarget,iLen);
      FillChar(pcTarget^,iLen,#0);
      IF NOT bToUseTraditional THEN
        IF funcCETranWord(pcSource,pcTarget,iLen)<>mtOK THEN iLen:=iLen*LEN_MAGICNUM_DICT+1
        ELSE BEGIN bTemp:=True; Break; END
      ELSE
        IF funcCEfTranWord(pcSource,pcTarget,iLen)<>mtOK THEN iLen:=iLen*LEN_MAGICNUM_DICT+1
        ELSE BEGIN bTemp:=True; Break; END
    END;
  IF bTemp THEN
    BEGIN
      SetLength(strTranslation,StrLen(pcTarget));
      Move(pcTarget^,strTranslation[1],StrLen(pcTarget));
      FreeMem(pcTarget);

      IF (Length(strTranslation)>1) AND (Pos(';', strTranslation)>0) THEN
        WHILE strTranslation<>'' DO
          BEGIN
            strLooper:=ReadTruncEx(strTranslation, ';');
            strlTarget.Add(strLooper);
          END
      ELSE strlTarget.Add(strTranslation);

      Result:=True;
    END
  ELSE FreeMem(pcTarget);
END;

DESTRUCTOR TIWrap.Destroy;
BEGIN
  IF bisCEMTInitOK AND (@procCEDoneMTEngine<>NIL) THEN procCEDoneMTEngine;
  IF hCEMTEngine<>0 THEN FreeLibrary(hCEMTEngine);
  INHERITED Destroy;
END;

PROCEDURE Init(strCEMTPath: STRING; bToUseTraditional: Boolean=False);
BEGIN
	iwCEMT:=TIWrap.Create(strCEMTPath, bToUseTraditional);
END;

FUNCTION TranSent(strInput: STRING): STRING;
BEGIN
	Result:=iwCEMT.TranSent(strInput);
END;

FUNCTION LoopUp(strAWord: STRING; strlTarget: TStringList): Boolean;
BEGIN
	Result:=iwCEMT.LoopUp(strAWord, strlTarget);
END;

PROCEDURE CleanUp;
BEGIN
	iwCEMT.Free;
END;

END.