rvofficecnv.pas

richview1.7 full.source

	cbSizeVer: Byte;
	opcodeVer: Byte;
	verMajor: SmallInt;
	verMinor: SmallInt;

        cbSizeCharset: Byte;
        opcodeCharset: Byte;
        Charset:       Byte;

     end;
const AppInfo: TAppInfo =
    (
	cbStruct: sizeof(TAppInfo);

	cbSizeVer: 1+1+2+2;
	opcodeVer: $01;
	verMajor: 10;
	verMinor: 0;

        cbSizeCharset: 1+1+1;
        opcodeCharset: $03;
        Charset:       DEFAULT_CHARSET;
    );
{------------------------------------------------------------------------------}
function GetFileNameHandle(const FileName: String): HGLOBAL;
var pc: PChar;
begin
  Result := GlobalAlloc(GHND, Length(FileName)+1);
  pc := GlobalLock(Result);
  CharToOEM(PChar(FileName), pc);
  GlobalUnlock(Result);
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeCnvList.ImportRTF(const FileName: String;
  Index: Integer);
var hLib : HMODULE;
    ExeName: String;
    InitConverter32:TInitConverter32;
    UninitConverter:TUninitConverter;
    ForeignToRtf32: TForeignToRtf32;
    RegisterApp: TRegisterApp;
    hFileName,hPref: HGLOBAL;
begin
   FStream.Clear;
   Converters := Self;
   SetLength(ExeName, Length(Application.ExeName));
   CharToOEM(PChar(Application.ExeName), PChar(ExeName));
   hFileName     :=  GetFileNameHandle(FileName);
   hBuffer := GlobalAlloc(GHND, 4096);
   hLib := LoadLibrary(PChar(Items[Index].Path));
   if hLib=0 then begin
     FOwner.FErrorCode := rvceCnvLoadError;
     abort;
   end;
   try
      InitConverter32 := GetProcAddress(hLib, 'InitConverter32');
      if not Assigned(InitConverter32) then begin
        FOwner.FErrorCode := rvceFuncError;
        abort;
      end;
      if InitConverter32(Application.Handle, PChar(ExeName))=0 then begin
        FOwner.FErrorCode := rvceInitError;
        abort;
      end;
      RegisterApp := GetProcAddress(hLib, 'RegisterApp');
      if Assigned(RegisterApp) then begin
        hPref := RegisterApp(0,@AppInfo);
        if hPref<>0 then
          GlobalFree(hPref);
      end;
      try
        ForeignToRtf32 := GetProcAddress(hLib, 'ForeignToRtf32');
        if not Assigned(ForeignToRtf32) then begin
          FOwner.FErrorCode := rvceFuncError;
          abort;
        end;
        FOwner.FErrorCode := ForeignToRtf32(hFileName,nil,hBuffer,0,0,ForeignToRtf32Callback);
        if FOwner.FErrorCode<>0 then
          abort;
      finally
        UninitConverter := GetProcAddress(hLib, 'UninitConverter');
        if Assigned(UninitConverter) then
          UninitConverter;
      end;
   finally
     FreeLibrary(hLib);
     GlobalFree(hBuffer);
     GlobalFree(hFileName);
   end;
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeCnvList.ExportRTF(const FileName: String;
  Index: Integer);
var hLib : HMODULE;
    ExeName: String;
    InitConverter32:TInitConverter32;
    UninitConverter:TUninitConverter;
    RtfToForeign32: TRtfToForeign32;
    RegisterApp: TRegisterApp;
    hFileName, hPref: HGLOBAL;
begin
   Converters := Self;
   FStart := FStream.Position;
   FSize  := FStream.Size-FStart;
   if FSize=0 then
     exit;
   FStep := 4096;
   if FStep>FSize then
     FStep := FSize;
   if Assigned(Converters.FOnConverting) then
     Converters.FOnConverting(Self, 0);
   SetLength(ExeName, Length(Application.ExeName));
   CharToOEM(PChar(Application.ExeName), PChar(ExeName));
   hFileName     :=  GetFileNameHandle(FileName);
   hBuffer := GlobalAlloc(GHND, FStep);
   hLib := LoadLibrary(PChar(Items[Index].Path));
   if hLib=0 then begin
     FOwner.FErrorCode := rvceCnvLoadError;
     abort;
   end;
   try
      InitConverter32 := GetProcAddress(hLib, 'InitConverter32');
      if not Assigned(InitConverter32) then begin
        FOwner.FErrorCode := rvceFuncError;
        abort;
      end;
      if InitConverter32(Application.Handle, PChar(ExeName))=0 then begin
        FOwner.FErrorCode := rvceInitError;
        abort;
      end;
      RegisterApp := GetProcAddress(hLib, 'RegisterApp');
      if Assigned(RegisterApp) then begin
        hPref := RegisterApp(0,@AppInfo);
        if hPref<>0 then
          GlobalFree(hPref);
      end;
      try
        RtfToForeign32 := GetProcAddress(hLib, 'RtfToForeign32');
        if not Assigned(RtfToForeign32) then begin
          FOwner.FErrorCode := rvceFuncError;
          abort;
        end;
        FOwner.FErrorCode := RtfToForeign32(hFileName, nil, hBuffer,0,RtfToForeign32Callback);
        if FOwner.FErrorCode<>0 then
          abort;
      finally
        UninitConverter := GetProcAddress(hLib, 'UninitConverter');
        if Assigned(UninitConverter) then
          UninitConverter;
      end;
   finally
     FreeLibrary(hLib);
     GlobalFree(hBuffer);
     GlobalFree(hFileName);
   end;
end;
{============================ TRVOfficeConverter ==============================}
constructor TRVOfficeConverter.Create(AOwner: TComponent);
begin
  inherited;
  FStream := TMemoryStream.Create;
end;
{------------------------------------------------------------------------------}
destructor TRVOfficeConverter.Destroy;
begin
  FExportConverters.Free;
  FImportConverters.Free;
  FStream.Free;
  inherited;
end;
{------------------------------------------------------------------------------}
function TRVOfficeConverter.GetExportConverters: TRVOfficeCnvList;
begin
   if FExportConverters=nil then
     FExportConverters := TRVOfficeCnvList.Create('SOFTWARE\Microsoft\Shared Tools\Text Converters\Export', Self,
       ExcludeHTMLExportConverter);
   Result := FExportConverters;
end;
{------------------------------------------------------------------------------}
function TRVOfficeConverter.GetImportConverters: TRVOfficeCnvList;
begin
   if FImportConverters=nil then
     FImportConverters := TRVOfficeCnvList.Create('SOFTWARE\Microsoft\Shared Tools\Text Converters\Import', Self,
       ExcludeHTMLImportConverter);
   Result := FImportConverters;
end;
{------------------------------------------------------------------------------}
function TRVOfficeConverter.GetImportFilter: String;
begin
  Result := ImportConverters.GetFilter(ExtensionsInFilter);
end;
{------------------------------------------------------------------------------}
function TRVOfficeConverter.GetExportFilter: String;
begin
  Result := ExportConverters.GetFilter(ExtensionsInFilter);
end;
{------------------------------------------------------------------------------}
function TRVOfficeConverter.ImportRTF(const FileName: String;
  ConverterIndex: Integer): Boolean;
begin
  FErrorCode := 0;
  ImportConverters.FStream := Stream;
  FImportConverters.FOnConverting := OnConverting;
  try
    FImportConverters.ImportRTF(FileName, ConverterIndex);
    Result := True;
  except
    Result := False;
  end;
end;
{------------------------------------------------------------------------------}
function TRVOfficeConverter.ExportRTF(const FileName: String;
  ConverterIndex: Integer): Boolean;
begin
  FErrorCode := 0;
  ExportConverters.FStream := Stream;
  FExportConverters.FOnConverting := OnConverting;
  try
    FExportConverters.ExportRTF(FileName, ConverterIndex);
    Result := True;
  except
    Result := False;
  end;
end;
{------------------------------------------------------------------------------}
function TRVOfficeConverter.ExportRV(const FileName: String; rv: TCustomRichView;
  ConverterIndex: Integer): Boolean;
begin
  FErrorCode := 0;
  Stream.Clear;
  Result := rv.SaveRTFToStream(Stream,False);
  if Result then begin
    FStream.Position := 0;
    Result := ExportRTF(FileName, ConverterIndex);
  end;
  Stream.Clear;
end;
{------------------------------------------------------------------------------}
function TRVOfficeConverter.ImportRV(const FileName: String; rv: TCustomRichView;
  ConverterIndex: Integer): Boolean;
begin
  FErrorCode := 0;
  Result := ImportRTF(FileName, ConverterIndex);
  FStream.Position := 0;
  Result := rv.LoadRTFFromStream(Stream) and Result;
  Stream.Clear;
end;
{------------------------------------------------------------------------------}

end.