rvofficecnv.pas

richview1.7 full.source

{==============================================================================}
{ Interface for Microsoft(R) Office Text Converters.                           }
{ (c) Sergey Tkachenko                                                         }
{==============================================================================}

unit RVOfficeCnv;


interface
{$I RV_Defs.inc}
uses Windows, Classes, SysUtils,
     RVClasses, Forms, RichView;


  {
    Error codes for converters. They are assigned to converter.ErrorCode
    after import/export operation.
  }
const
  // errors running converter
  rvceCnvLoadError   = 1;       // error loading converter's DLL
  rvceFuncError      = 2;       // required function is not found in converter's DLL
  rvceInitError      = 3;       // converter initialization failure
  
  // errors returned by converters; this is NOT an exhaustive list! 
  rvceOpenInFileErr  = -1;	// could not open input file
  rvceReadErr	     = -2;	// error during read
  rvceOpenConvErr    = -3;	// error opening conversion file
  rvceWriteErr	     = -4;	// error during write
  rvceInvalidFile    = -5;	// invalid data in conversion file
  rvceOpenExceptErr  = -6;	// error opening exception file
  rvceWriteExceptErr = -7;	// error writing exception file
  rvceNoMemory	     = -8;	// out of memory
  rvceInvalidDoc     = -9;	// invalid document
  rvceDiskFull	     = -10;	// out of space on output
  rvceDocTooLarge    = -11;	// conversion document too large for target
  rvceOpenOutFileErr = -12;	// could not open output file
  rvceUserCancel     = -13;     // conversion cancelled by user
  rvceWrongFileType  = -14;     // wrong file type for this converter

type
  TRVOfficeConverterInfo = class
    public
      Name, Path, Filter: String;
  end;


  TInitConverter32 = function(hwndWord: HWND; szModule: PChar): Integer; stdcall;
  TUninitConverter = procedure; stdcall;
  TForeignToRtf32Callback = function (cchBuff, nPercent: Integer): Integer; stdcall;
  TRtfToForeign32Callback = function (rgfOptions, nReserved: Integer): Integer; stdcall;
  TForeignToRtf32 = function (ghszFile: HGLOBAL; pstgForeign: Pointer; ghBuff, ghszClass, ghszSubset: HGLOBAL;
                              lpfnOut: TForeignToRtf32Callback): SmallInt; stdcall;
  TRtfToForeign32 = function(ghszFile: HGLOBAL; pstgForeign: Pointer; ghBuff, ghszClass: HGLOBAL;
                              lpfnIn: TRtfToForeign32Callback): SmallInt; stdcall;
  TRegisterApp = function(lFlags: Integer; lpRegApp: Pointer):HGLOBAL; stdcall;
  TConvertingEvent = procedure (Sender:TObject; Percent: Integer) of object;

  TRVOfficeConverter = class;

  TRVOfficeCnvList = class (TRVList)
    private
      FOwner: TRVOfficeConverter;
      hBuffer: HGLOBAL;
      FOnConverting: TConvertingEvent;
      FStream: TMemoryStream;
      FStep, FStart, FSize: Integer;
      procedure Put(Index: Integer; Value: TRVOfficeConverterInfo);
      function Get(Index: Integer):TRVOfficeConverterInfo;
      procedure LoadList(const RegPath: String; ExcludeHTML: Boolean);
    public
      constructor Create(const RegPath: String; Owner: TRVOfficeConverter;
                         ExcludeHTML: Boolean);
      function GetFilter(IncludeExtensions: Boolean): String;
      procedure ImportRTF(const FileName: String; Index: Integer);
      procedure ExportRTF(const FileName: String; Index: Integer);
      property Items[Index: Integer]: TRVOfficeConverterInfo read Get write Put; default;
  end;

  TRVOfficeConverter = class (TComponent)
    private
      FImportConverters, FExportConverters: TRVOfficeCnvList;
      FOnConverting: TConvertingEvent;
      FStream: TMemoryStream;
      FExcludeHTMLImportConverter: Boolean;
      FExcludeHTMLExportConverter: Boolean;
      FErrorCode: Integer;
      FExtensionsInFilter: Boolean;
      function GetExportConverters: TRVOfficeCnvList;
      function GetImportConverters: TRVOfficeCnvList;
    public
      constructor Create(AOwner: TComponent); override;
      destructor Destroy; override;
      function ImportRTF(const FileName: String; ConverterIndex: Integer): Boolean;
      function ExportRTF(const FileName: String; ConverterIndex: Integer): Boolean;
      function ImportRV(const FileName: String; rv: TCustomRichView; ConverterIndex: Integer): Boolean;
      function ExportRV(const FileName: String; rv: TCustomRichView; ConverterIndex: Integer): Boolean;
      function GetImportFilter: String;
      function GetExportFilter: String;
      property ImportConverters: TRVOfficeCnvList read GetImportConverters;
      property ExportConverters: TRVOfficeCnvList read GetExportConverters;
      property Stream: TMemoryStream read FStream;
      property ErrorCode: Integer read FErrorCode;
    published
      property ExcludeHTMLImportConverter: Boolean read FExcludeHTMLImportConverter write FExcludeHTMLImportConverter default False;
      property ExcludeHTMLExportConverter: Boolean read FExcludeHTMLExportConverter write FExcludeHTMLExportConverter default False;
      property ExtensionsInFilter: Boolean read FExtensionsInFilter write FExtensionsInFilter default False;
      property OnConverting: TConvertingEvent read FOnConverting write FOnConverting;
  end;

implementation

var Converters: TRVOfficeCnvList;

{==============================================================================}
function ForeignToRtf32Callback(cchBuff, nPercent: Integer): Integer; stdcall;
var p: Pointer;
begin
  if Assigned(Converters.FOnConverting) then
    Converters.FOnConverting(Converters.FOwner, nPercent);
  Result := 0;
  if cchBuff=0 then
    exit;
  p := GlobalLock(Converters.hBuffer);
  Converters.FStream.WriteBuffer(p^,cchBuff);
  GlobalUnlock(Converters.hBuffer);
end;
{------------------------------------------------------------------------------}
function RtfToForeign32Callback(rgfOptions, nReserved: Integer): Integer; stdcall;
var p: Pointer;
begin
  Result := Converters.FStream.Size-Converters.FStream.Position;
  if Result>Converters.FStep then
    Result :=Converters.FStep;
  if Result>0 then begin
    p := GlobalLock(Converters.hBuffer);
    Converters.FStream.ReadBuffer(p^, Result);
    GlobalUnlock(Converters.hBuffer);
  end;
  if Assigned(Converters.FOnConverting) then
    Converters.FOnConverting(Converters.FOwner,  (Converters.FStream.Position-Converters.FStart)*100 div Converters.FSize);
end;
{======================== TRVOfficeCnvList =================================}
procedure TRVOfficeCnvList.Put(Index: Integer; Value: TRVOfficeConverterInfo);
begin
  inherited Put(Index, Value);
end;
{------------------------------------------------------------------------------}
function TRVOfficeCnvList.Get(Index: Integer):TRVOfficeConverterInfo;
begin
  Result := TRVOfficeConverterInfo(inherited Get(Index));
end;
{------------------------------------------------------------------------------}
constructor TRVOfficeCnvList.Create(const RegPath: String; Owner: TRVOfficeConverter; ExcludeHTML: Boolean);
begin
  inherited Create;
  FOwner := Owner;
  try
    LoadList(RegPath, ExcludeHTML);
  except
  ;
  end;
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeCnvList.LoadList(const RegPath: String; ExcludeHTML: Boolean);
var key, subkey: HKEY;
    KeyName, KeyBuf: String;
    i: Integer;
    Item: TRVOfficeConverterInfo;
    {........................................}
    function DecodeExt(s: String): String;
    var p: Integer;
        s1: String;
    begin
      Result := '';
      while s<>'' do begin
        p := Pos(' ',s);
        if p=0 then begin
          s1 := s;
          s  := '';
          end
        else begin
          s1 := Copy(s,1,p-1);
          s  := Copy(s,p+1,Length(s));
        end;
        if Result<>'' then
          Result := Result+';';
        Result := Result+'*.'+s1;
      end;
    end;
    {........................................}
    function ReadString(Key: HKEY; const ValueName: String; var Value: String): Boolean;
    var l: Integer;
    begin
      SetLength(Value, MAX_PATH);
      l := MAX_PATH;
      Result := RegQueryValueEx(Key, PChar(ValueName), nil, nil, PByte(Value), @l)=ERROR_SUCCESS;
      if Result then
        SetLength(Value, l-1);
    end;
    {........................................}
begin
   Clear;
   SetLength(KeyBuf, MAX_PATH);
   if RegOpenKeyEx(HKEY_LOCAL_MACHINE, PChar(RegPath), 0, KEY_READ, Key)<>ERROR_SUCCESS then
     exit;
   try
     i := 0;
     while RegEnumKey(Key, i, PChar(KeyBuf), MAX_PATH+1)=ERROR_SUCCESS do begin
       KeyName := PChar(KeyBuf);
       if RegOpenKeyEx(HKEY_LOCAL_MACHINE, PChar(RegPath+'\'+KeyName), 0, KEY_READ, SubKey)=ERROR_SUCCESS then
         try
           Item := TRVOfficeConverterInfo.Create;
           if ReadString(SubKey, 'Name', Item.Name) and
              ReadString(SubKey, 'Path', Item.Path) and
              ReadString(SubKey, 'Extensions', Item.Filter) and
              (not ExcludeHTML or (AnsiCompareText(ExtractFileName(Item.Path),'HTML32.CNV')<>0))
               then begin
             Item.Filter := DecodeExt(Item.Filter);
             Add(Item)
             end
           else
             Item.Free;
         finally
           RegCloseKey(SubKey);
         end;
       inc(i);
     end;
   finally
     RegCloseKey(Key);   
   end;
end;
{------------------------------------------------------------------------------}
function TRVOfficeCnvList.GetFilter(IncludeExtensions: Boolean): String;
var i: Integer;
begin
  Result := '';
  for i := 0 to Count-1 do begin
    if i>0 then
      Result := Result + '|';
    if IncludeExtensions then
      Result := Result + Items[i].Name+' ('+Items[i].Filter+')|'+Items[i].Filter
    else
      Result := Result + Items[i].Name+'|'+Items[i].Filter;
  end;
end;

{$A-}
type TAppInfo = record
	cbStruct: SmallInt;