fstrlist.pas

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

(*
* FSTRLIST.PAS  -  A flexible TStringList class
*
* 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 FSTRLIST;

INTERFACE

USES SysUtils, Classes;

TYPE
  TContentType=(cteError,
                cteANSI,
                cteUTF8_BOM, cteUTF8,
                cteUTF16_BE_BOM, cteUTF16_BE,
                cteUTF16_LE_BOM, cteUTF16_LE,
                cteUCS4_1234_BOM, cteUCS4_1234,
                cteUCS4_4321_BOM, cteUCS4_4321,
                cteUCS4_2143_BOM, cteUCS4_2143,
                cteUCS4_3412_BOM, cteUCS4_3412);

  TFStringList=CLASS
  PRIVATE
    strlContent: TStringList;
    ctType: TContentType;
    FUNCTION GetCount: Integer;
    FUNCTION GetString(iIdx: Integer): STRING;
    PROCEDURE SetString(iIdx: Integer; Value: STRING);
  PUBLIC
    PROPERTY Count: Integer READ GetCount;
    PROPERTY Item[iIdx: Integer]: STRING READ GetString WRITE SetString; DEFAULT;
    CONSTRUCTOR Create;
    PROCEDURE LoadXML(strFileName: STRING);
    PROCEDURE Save(strFileName: STRING);
    DESTRUCTOR Destroy; OVERRIDE;
  END;

IMPLEMENTATION

FUNCTION UTF16LE2ANSI(wUTF16LE: Word): STRING;
VAR pwstrTemp: PWideChar; awcTemp: ARRAY[0..1] OF WideChar;
BEGIN
  pwstrTemp:=@awcTemp;
  awcTemp[0]:=WideChar(wUTF16LE);
  awcTemp[1]:=WideChar(0);
  Result:=WideCharToString(pwstrTemp);
END;

PROCEDURE ReadAUTF16LEFile(strInputput: STRING; strlTarget: TStringList; ReadTag: Boolean=True);
VAR fUTF16LEText: FILE;
    strTemp: STRING;
    wTemp: Word;
    strText: STRING;
BEGIN
  AssignFile(fUTF16LEText, strInputput);
  ReSet(fUTF16LEText,2);

  IF ReadTag THEN BlockRead(fUTF16LEText,wTemp,1);

  strText:='';
  WHILE NOT Eof(fUTF16LEText) DO
    BEGIN
      BlockRead(fUTF16LEText,wTemp,1);

      strTemp:=UTF16LE2ANSI(wTemp);
      strText:=strText+strTemp;
    END;

  strlTarget.Text:=strText;

  CloseFile(fUTF16LEText);
END;

PROCEDURE WriteAUTF16LEFile(strlSource: TStringList; strOutput: STRING; WriteTag: Boolean=True);
VAR fUTF16LEText: FILE;
    wstrTemp: WideString;
    wTemp: Word;
    iLooper, jLooper: Integer;
BEGIN
  AssignFile(fUTF16LEText, strOutput);
  ReWrite(fUTF16LEText,2);

  IF WriteTag THEN
    BEGIN
      wTemp:=$FEFF;
      BlockWrite(fUTF16LEText,wTemp,1);
    END;

  FOR iLooper:=0 TO strlSource.Count-1 DO
    BEGIN
      wstrTemp:=strlSource[iLooper]+#13+#10;
      FOR jLooper:=1 TO Length(wstrTemp) DO
        BEGIN
          wTemp:=Word(wstrTemp[jLooper]);
          BlockWrite(fUTF16LEText,wTemp,1);
        END;
    END;

  CloseFile(fUTF16LEText);
END;

FUNCTION TFStringList.GetCount: Integer;
BEGIN
  Result:=strlContent.Count;
END;

FUNCTION TFStringList.GetString(iIdx: Integer): STRING;
BEGIN
  Result:='';
  IF (iIdx<0) OR (iIdx>=Count) THEN Exit;
  Result:=strlContent[iIdx];
END;

PROCEDURE TFStringList.SetString(iIdx: Integer; Value: STRING);
BEGIN
  IF (iIdx<0) OR (iIdx>=Count) THEN Exit;
  strlContent[iIdx]:=Value;
END;

CONSTRUCTOR TFStringList.Create;
BEGIN
  INHERITED Create;
  strlContent:=TStringList.Create;
  ctType:=cteANSI;
END;

PROCEDURE TFStringList.LoadXML(strFileName: STRING);
VAR fAFile: FILE;
    aTemp: ARRAY[1..4] OF Byte;
    iLooper: Integer;
BEGIN
  strlContent.Clear;

  AssignFile(fAFile, strFileName);
  ReSet(fAFile,1);

  FOR iLooper:=1 TO 4 DO
    BEGIN
      IF Eof(fAFile) THEN Exit;
      BlockRead(fAFile, aTemp[iLooper], 1);
    END;
  CloseFile(fAFile);

  IF (aTemp[1]=0) AND (aTemp[2]=0) AND (aTemp[3]=$FE) AND (aTemp[4]=$FF) THEN ctType:=cteUCS4_1234_BOM
  ELSE IF (aTemp[1]=$FF) AND (aTemp[2]=$FE) AND (aTemp[3]=0) AND (aTemp[4]=0) THEN ctType:=cteUCS4_4321_BOM
  ELSE IF (aTemp[1]=0) AND (aTemp[2]=0) AND (aTemp[3]=$FF) AND (aTemp[4]=$FE) THEN ctType:=cteUCS4_2143_BOM
  ELSE IF (aTemp[1]=$FE) AND (aTemp[2]=$FF) AND (aTemp[3]=0) AND (aTemp[4]=0) THEN ctType:=cteUCS4_3412_BOM
  ELSE IF (aTemp[1]=0) AND (aTemp[2]=0) AND (aTemp[3]=0) AND (aTemp[4]=$3C) THEN ctType:=cteUCS4_1234
  ELSE IF (aTemp[1]=$3C) AND (aTemp[2]=0) AND (aTemp[3]=0) AND (aTemp[4]=0) THEN ctType:=cteUCS4_4321
  ELSE IF (aTemp[1]=0) AND (aTemp[2]=0) AND (aTemp[3]=$3C) AND (aTemp[4]=0) THEN ctType:=cteUCS4_2143
  ELSE IF (aTemp[1]=0) AND (aTemp[2]=$3C) AND (aTemp[3]=0) AND (aTemp[4]=0) THEN ctType:=cteUCS4_3412
  ELSE IF (aTemp[1]=$FF) AND (aTemp[2]=$FE) AND ((aTemp[3]<>0) OR (aTemp[4]<>0)) THEN ctType:=cteUTF16_LE_BOM
  ELSE IF (aTemp[1]=$FE) AND (aTemp[2]=$FF) AND ((aTemp[3]<>0) OR (aTemp[4]<>0)) THEN ctType:=cteUTF16_BE_BOM
  ELSE IF (aTemp[1]=$3C) AND (aTemp[2]=0) AND (aTemp[3]=$3F) AND (aTemp[4]=0) THEN ctType:=cteUTF16_LE
  ELSE IF (aTemp[1]=0) AND (aTemp[2]=$3C) AND (aTemp[3]=0) AND (aTemp[4]=$3F) THEN ctType:=cteUTF16_BE
  ELSE IF (aTemp[1]=$EF) AND (aTemp[2]=$BB) AND (aTemp[3]=$BF) THEN ctType:=cteUTF8_BOM
  ELSE ctType:=cteANSI; //...still some bug...

  CASE ctType OF
    cteANSI: strlContent.LoadFromFile(strFileName);
    cteUTF16_LE_BOM: ReadAUTF16LEFile(strFileName, strlContent, True);
    cteUTF16_LE: ReadAUTF16LEFile(strFileName, strlContent, False);
  END;
END;

PROCEDURE TFStringList.Save(strFileName: STRING);
BEGIN
  CASE ctType OF
    cteANSI: strlContent.SaveToFile(strFileName);
    cteUTF16_LE_BOM: WriteAUTF16LEFile(strlContent, strFileName, True);
    cteUTF16_LE: WriteAUTF16LEFile(strlContent, strFileName, False);
  END;
END;

DESTRUCTOR TFStringList.Destroy;
BEGIN
  strlContent.Free;
  INHERITED Destroy;
END;

END.