spellers.pas

拼写检查

  FOptions:= Options;
  SpellChecker:= Owner;
end;

procedure CheckSR(SR: TSEC);
begin
  if (SR<>secNoErrors) then
    case FUserLanguage of
      ulEnglish: raise ESpellError.CreateFmt(SpellRes.spsError, [SR]);
      ulown: raise ESpellError.CreateFmt(SpellResDe.spsError, [SR]);
      ulother: raise ESpellError.CreateFmt(spOError, [SR]);
    end;
end;

{TCSAPISpeller}
type
  TCSAPISpeller = class(TAbstractSpeller)
  private
    SpellInstance: THandle;
    DLLName: String;
    LexName: String;
    UserDict: TFileName;
    UnkWord: String;
    FOptions: TSpellOptions;
    SpellVer: TSpellVerFunc;
    SpellInit: TSpellInitFunc;
    SpellOptions: TSpellOptionsFunc;
    SpellCheck: TSpellCheckFunc;
    SpellTerminate: TSpellTerminateFunc;
    SpellVerifyMdr: TSpellVerifyMdrFunc;
    SpellOpenMdr: TSpellOpenMdrFunc;
    SpellOpenUdr: TSpellOpenUdrFunc;
    SpellAddUdr: TSpellAddUdrFunc;
    SpellAddChangeUdr: TSpellAddChangeUdrFunc;
    SpellDelUdr: TSpellDelUdrFunc;
    SpellClearUdr: TSpellClearUdrFunc;
    SpellGetSizeUdr: TSpellGetSizeUdrFunc;
    SpellGetListUdr: TSpellGetListUdrFunc;
    SpellCloseMdr: TSpellCloseMdrFunc;
    SpellCloseUdr: TSpellCloseUdrFunc;
  protected
    Handle: TSPLID;
    SpecChars: TWSC;
    Mdrs: TMDRS;
    Udr: TUDR;
    InputBuffer: TSIB;
    ResultBuffer: TSRB;
    constructor Create(Language: TLanguage; Owner: TSpellChecker; Options: TSpellOptions); override;
    destructor Destroy; override;
    function FindMisspell(Buf: PChar; MaxLen: Integer; var Start, Len: Integer): TSpellReturnCode; override;
    function FindNextMisspell(Buf: PChar; MaxLen: Integer; var Start, Len: Integer): TSpellReturnCode; override;
    procedure ChangeOnce(Word, NewWord: String); override;
    procedure ChangeAlways(Word, NewWord: String); override;
    procedure Add(Word: String); override;
    procedure IgnoreAlways(Word: String); override;
    procedure GetVariants(Word: String; Variants: TStrings); override;
    function GetChangeText: String; override;
    function GetMisspellText: String; override;
  end;

{$O-}

constructor TCSAPISpeller.Create(Language: TLanguage; Owner: TSpellChecker; Options: TSpellOptions);
var
  UdrRO: Boolean;
  NotFound: Boolean;
  Registry: TRegistry;
begin
  inherited;
  FSpellerType := sptMSOffice;
  with SpecChars do
    begin
      bIgnore:= #0;
      bHyphenHard:= #45;
      bHyphenSoft:= #31;
      bHyphenNonBreaking:= #30;
      bEmDash:= #151;
      bEnDash:= #150;
      bEllipsis:= #133;
      rgLineBreak:= #11#10;
      rgParaBreak:= #13#10;
    end;
  Registry:= TRegistry.Create;
  Registry.RootKey:= HKEY_LOCAL_MACHINE;
  try
    NotFound:= True;
    if Registry.OpenKeyReadOnly(
        Format('\SOFTWARE\Microsoft\Shared Tools\Proofing Tools\Spelling\%d\Normal', [FLanguage])) or
       Registry.OpenKeyReadOnly(
        Format('\SOFTWARE\Microsoft\Shared Tools\Proofing Tools\Spelling\%d\Normal', [1024+(FLanguage mod 1024)]))
      then begin
      DLLName:= Registry.ReadString('Engine');
      LexName:= Registry.ReadString('Dictionary');
      NotFound := False;
      end;
    if not NotFound then begin
      if (SpellChecker.CustomDict='') and Registry.OpenKeyReadOnly(
         '\SOFTWARE\Microsoft\Shared Tools\Proofing Tools\Custom Dictionaries')
        then UserDict:= Registry.ReadString('1')
        else begin
          UserDict:= SpellChecker.CustomDict;
          if (SpellChecker.CustomDict='') then begin
            try
              Registry.Access := KEY_ALL_ACCESS;
              Registry.OpenKey(
                '\SOFTWARE\Microsoft\Shared Tools\Proofing Tools\Custom Dictionaries', True)
            except on E: Exception do
              Registry.Access := KEY_READ;
            end;
          end;
        end;
      if Assigned(SpellChecker.FOnGetDict)
        then SpellChecker.FOnGetDict(SpellChecker, FLanguage, UserDict);
      if UserDict='' then
        begin
          UserDict:= ExtractFilePath(LexName)+'CUSTOM.DIC';
          try
            Registry.WriteString('1', UserDict);
            Registry.CloseKey;
          except end;  
        end;
    end;
  finally
    Registry.Free;
  end;  
  if NotFound then
    begin
      FNotActive:= True;
      Exit;
    end;
  try
    SpellInstance:= LoadLibrary(PChar(DllName));
  except
    FNotActive:= True;
    case FUserLanguage of
      ulEnglish: raise ESpellError.CreateFmt(SpellRes.spsErrorLoad, [DllName]);
      ulown: raise ESpellError.CreateFmt(SpellResDe.spsErrorLoad, [DllName]);
      ulother: raise ESpellError.CreateFmt(spOErrorLoad, [DllName]);
    end;
  end;
  try
    @SpellVer:= GetProcAddress(SpellInstance, 'SpellVer');
    @SpellInit:= GetProcAddress(SpellInstance, 'SpellInit');
    @SpellOptions:= GetProcAddress(SpellInstance, 'SpellOptions');
    @SpellCheck:= GetProcAddress(SpellInstance, 'SpellCheck');
    @SpellTerminate:= GetProcAddress(SpellInstance, 'SpellTerminate');
    @SpellVerifyMdr:= GetProcAddress(SpellInstance, 'SpellVerifyMdr');
    @SpellOpenMdr:= GetProcAddress(SpellInstance, 'SpellOpenMdr');
    @SpellOpenUdr:= GetProcAddress(SpellInstance, 'SpellOpenUdr');
    @SpellAddUdr:= GetProcAddress(SpellInstance, 'SpellAddUdr');
    @SpellAddChangeUdr:= GetProcAddress(SpellInstance, 'SpellAddChangeUdr');
    @SpellDelUdr:= GetProcAddress(SpellInstance, 'SpellDelUdr');
    @SpellClearUdr:= GetProcAddress(SpellInstance, 'SpellClearUdr');
    @SpellGetSizeUdr:= GetProcAddress(SpellInstance, 'SpellGetSizeUdr');
    @SpellGetListUdr:= GetProcAddress(SpellInstance, 'SpellGetListUdr');
    @SpellCloseMdr:= GetProcAddress(SpellInstance, 'SpellCloseMdr');
    @SpellCloseUdr:= GetProcAddress(SpellInstance, 'SpellCloseUdr');
  except
    FreeLibrary(SpellInstance);
    FNotActive:= True;
    case FUserLanguage of
      ulEnglish: raise ESpellError.CreateFmt(SpellRes.spsErrorLoad, [DllName]);
      ulown: raise ESpellError.CreateFmt(SpellResDe.spsErrorLoad, [DllName]);
      ulother: raise ESpellError.CreateFmt(spOErrorLoad, [DllName]);
    end;
  end;
  FNotActive:= False;
  FOptions:= Options;
  CheckSR(SpellInit(Handle, SpecChars));
  CheckSR(SpellOptions(Handle, Word(FOptions)));
  CheckSR(SpellOpenMdr(Handle, PChar(LexName), nil, False, True, FLanguage, Mdrs));
  CheckSR(SpellOpenUdr(Handle, PChar(UserDict), True, IgnoreAlwaysProp, Udr, UdrRO));
  with InputBuffer do
    begin
      cMdr:= 1;
      cUdr:= 1;
      lrgMdr:= @Mdrs.MDR;
      lrgUdr:= @Udr;
    end;
  with ResultBuffer do
    begin
      cch:= 1024;
      lrgsz:= AllocMem(1024);
      lrgbRating:= AllocMem(255);
      cbRate:= 255;
    end;
end;

destructor TCSAPISpeller.Destroy;
var
 SR1: TSEC;
begin
  if not FNotActive then
    begin
      FreeMem(ResultBuffer.lrgsz);
      FreeMem(ResultBuffer.lrgbRating);
      CheckSR(SpellCloseMdr(Handle, Mdrs));
      SR1 := SpellCloseUdr(Handle, Udr, True);
      if (SR1 <> 33026) then CheckSR(SR1);
      CheckSR(SpellTerminate(Handle, True));
      try
        FreeLibrary(SpellInstance);
      except
        case FUserLanguage of
          ulEnglish: raise ESpellError.CreateFmt(SpellRes.spsErrorUnLoad, [DllName]);
          ulown: raise ESpellError.CreateFmt(SpellResDe.spsErrorUnLoad, [DllName]);
          ulother: raise ESpellError.CreateFmt(spOErrorUnLoad, [DllName]);
        end;
      end;
    end;
  inherited;
end;

function TCSAPISpeller.FindMisspell(Buf: PChar; MaxLen: Integer; var Start, Len: Integer): TSpellReturnCode;
begin
  if FNotActive then
    begin
      Result:= srNoErrors;
      Exit;
    end;
  InputBuffer.cch:= MaxLen;
  InputBuffer.lrgch:= Buf;
  InputBuffer.wSpellState:= fssStartsSentence;
  CheckSR(SpellCheck(handle, sccVerifyBuffer, InputBuffer, ResultBuffer));
  Result:= TSpellReturnCode(ResultBuffer.scrs);
  if Result<>srNoErrors then
    begin
      Start:= ResultBuffer.ichError;
      Len:= ResultBuffer.cchError;
      SetLength(UnkWord, ResultBuffer.cchError);
      StrLCopy(@UnkWord[1], InputBuffer.lrgch+ResultBuffer.ichError, ResultBuffer.cchError);
    end;
end;

function TCSAPISpeller.FindNextMisspell(Buf: PChar; MaxLen: Integer; var Start, Len: Integer): TSpellReturnCode;
begin
  if FNotActive then
    begin
      Result:= srNoErrors;
      Exit;
    end;
  InputBuffer.cch:= MaxLen;
  InputBuffer.lrgch:= Buf;
  InputBuffer.wSpellState:= fssIsContinued;
  CheckSR(SpellCheck(Handle, sccVerifyBuffer, InputBuffer, ResultBuffer));
  Result:= TSpellReturnCode(ResultBuffer.scrs);
  if Result<>srNoErrors then
    begin
      Start:= ResultBuffer.ichError;
      Len:= ResultBuffer.cchError;
      SetLength(UnkWord, ResultBuffer.cchError);
      StrLCopy(@UnkWord[1], InputBuffer.lrgch+ResultBuffer.ichError, ResultBuffer.cchError);
    end;
end;

procedure TCSAPISpeller.ChangeOnce(Word, NewWord: String);
begin
  if FNotActive then
    Exit;
  CheckSR(SpellAddChangeUdr(Handle, udrChangeOnce,
      PChar(Word), PChar(NewWord)));
end;

procedure TCSAPISpeller.ChangeAlways(Word, NewWord: String);
begin
  if FNotActive then
    Exit;
  CheckSR(SpellAddChangeUdr(Handle, udrChangeAlways,
      PChar(Word), PChar(NewWord)));
end;

procedure TCSAPISpeller.Add(Word: String);
begin
  if FNotActive then
    Exit;
  CheckSR(SpellAddUdr(Handle, Udr, PChar(Word)));
end;

procedure TCSAPISpeller.IgnoreAlways(Word: String);
begin
  if FNotActive then
    Exit;
  CheckSR(SpellAddUdr(Handle, udrIgnoreAlways, PChar(Word)));
end;

procedure TCSAPISpeller.GetVariants(Word: String; Variants: TStrings);
var
  SIB: TSIB;
  SRB: TSRB;
  Buf: array[0..2047]of Char;
  Ratings: array[0..255]of Byte;
  P: PChar;
begin
  Variants.Clear;
  if FNotActive then
    Exit;
  with SIB do
    begin
      cch:= Length(Word);
      cMdr:= 1;
      cUdr:= 1;
      wSpellState:= fssNoStateInfo;
      lrgch:= @Word[1];
      lrgMdr:= @Mdrs.MDR;
      lrgUdr:= @Udr;
    end;
  with SRB do
    begin
      cch:= 2047;
      lrgsz:= @Buf;
      lrgbRating:= @Ratings;
      cbRate:= 255;
    end;
  CheckSR(SpellCheck(Handle, sccSuggest, SIB, SRB));
  while SRB.scrs<>scrsNoMoreSuggestions do
    begin
      P:= SRB.lrgsz;
      while P^<>#0 do
        begin
          if Variants.IndexOf(P)=-1 then
            Variants.Add(P);
          while P^<>#0 do
            Inc(P);
          Inc(P);
        end;
      CheckSR(SpellCheck(Handle, sccSuggestMore, SIB, SRB));
    end;
end;

function TCSAPISpeller.GetChangeText: String;
begin
  if FNotActive then
    Result:= ''
  else
    Result:= ResultBuffer.lrgsz;
end;

function TCSAPISpeller.GetMisspellText: String;
begin
  if FNotActive then
    Result:= ''
  else
    Result:= UnkWord;
end;  {TCSAPISpeller}
{$O+}

{TISpeller}
type
  TISpeller = class(TAbstractSpeller)
  private
    FOptions: TSpellOptions;
    si_r, si_w, so_r, so_w, se_r, se_w: THandle;
    PI: TProcessInformation;
    M, Repl: String;
    UnkWord: WideString;
    ReplData: TStringList;
    function SpellCheck (word: String): String;
    function Check(Word: WideString): Boolean;
    procedure SpellCommand (Word: WideString);
  protected
    constructor Create(Language: TLanguage; Owner: TSpellChecker; Options: TSpellOptions); override;