wwrtfconverter.pas

胜天进销存源码,国产优秀的进销存

unit wwrtfconverter;

interface

{$i wwIfDef.pas}

uses
  Windows, Messages, SysUtils,
  {$ifdef wwDelphi6Up}
  Variants,
  {$endif}
  Classes, Graphics, Controls,
  forms, registry,
  Dialogs, StdCtrls, Buttons, ComCtrls, wwriched, activex;

const
  // File Conversion Errors
  wwfceTrue		 = 1;	// true (used by IsFormatCorrect32() only)
  wwfceNoErr             = 0;	// success
  wwfceOpenInFileErr	 = -1;	// could not open input file
  wwfceReadErr		 = -2;	// error during read
  wwfceWriteErr	         = -4;	// error during write
  wwfceInvalidFile	 = -5;	// invalid data in conversion file
  wwfceNoMemory	         = -8;	// out of memory
  wwfceOpenOutFileErr	 = -12;	// could not open output file
  wwfceUserCancel        = -13;	// conversion cancelled by user
  wwfceWrongFileType	 = -14;	// wrong file type for this converter

type
  TwwFileCodeError = smallint;
  TwwConvertCallbackOut = function(cchBuff: longint; nPercent: Longint): Longint; stdcall;
  TwwConvertCallbackIn = function(rgfOptions: longint; p2: Longint): Longint; stdcall;

  TwwInitConverter32 = function(hwnd: THandle; szModule: LPWSTR): HResult; stdcall;
  TwwUninitConverter = procedure(); stdcall;
  TwwIsFormatCorrect32 = function(ghszFile: THandle; ghszClass: THANDLE): TwwFileCodeError; stdcall;
  TwwForeignToRtf32 = function(hFile: THandle;
            pStorage: IStorage; hBuffer, hClass,
            hSubset: THandle; OutFunction: TwwConvertCallbackOut): TwwFileCodeError; stdcall;
  TwwRtfToForeign32 = function(hFile: THandle;
            pStorage: IStorage; hBuffer, hClass: THandle;
            InFunction: TwwConvertCallbackIn): TwwFileCodeError; stdcall;
  TwwRegisterApp = function(lFlags: DWord; lpFuture: Pointer): Pointer; stdcall;
  TwwCchFetchLpszError = function(fce: longint; lpszError: LPWSTR; cb: longint): longint; stdcall;
  TwwGetReadNames = procedure(haszClass: THandle; haszDescrip: THandle; haszExt: THandle); stdcall;
  TwwGetWriteNames = procedure(haszClass: THandle; haszDescrip: THandle; haszExt: THandle); stdcall;
  TwwRegisterConverter = function(hkeyRoot: THandle): longint; stdcall;

type

  TwwRTFConverter  = class
  protected
     FLibrary: HModule; // library DLL instance
     InitConverter32: TwwInitConverter32;
     UninitConverter: TwwUninitConverter;
     IsFormatCorrect32: TwwIsFormatCorrect32;
     ForeignToRtf32: TwwForeignToRtf32;
     RtfToForeign32: TwwRtfToForeign32;
     RegisterApp: TwwRegisterApp;
     CchFetchLpszError: TwwCchFetchLpszError;
     GetReadNames: TwwGetReadNames;
     GetWriteNames: TwwGetWriteNames;
     RegisterConverter: TwwRegisterConverter;

     procedure LoadLibrary(hwnd: HWND; libpath: AnsiString);
     procedure UnloadLibrary;
  public
     constructor Create(hwnd : HWND; libpath: AnsiString);
     destructor Destroy; override;
     function IsKnownFormat(FilePath: AnsiString): Boolean;
//     function GetFormatClass(filepath: AnsiString): AnsiString;
     function ForeignToRTF(richedit: TwwCustomRichEdit;
             filepath: AnsiString;
             formatClass: AnsiString = ''): TwwFileCodeError;
     function RTFToForeign(richedit: TwwCustomRichEdit;
             filepath: AnsiString;
             formatclass: AnsiString = ''): TwwFileCodeError;
     function GetErrorMessage(ErrorCode: Smallint): string;
  end;

  TwwRtfConverterList = class
  private
     RawDescription: TStringList;
  public
     LibPath: TStringList;
     Description: TStringList;
     FormatClass: TStringList;
     Filters: TStringList;
     FilterList: AnsiString;  			// for use with TOpenDialog
  public
     constructor Create(import: boolean);
     destructor Destroy; override;

     procedure GetConverterList(regRoot: HKey;
       regPath: AnsiString; appName: AnsiString; import: boolean);
  end;


implementation

uses wwstr;

  constructor TwwRTFConverter.Create(hwnd : HWND; libpath: AnsiString);
  begin
	@InitConverter32 := nil;
	@UninitConverter := nil;
	@IsFormatCorrect32 := nil;
	@ForeignToRtf32 := nil;
	@RtfToForeign32 := nil;
	@RegisterApp := nil;
	@CchFetchLpszError := nil;
	@GetReadNames := nil;
	@GetWriteNames := nil;
	@RegisterConverter := nil;
	LoadLibrary(hwnd, libpath);
  end;

  destructor TwwRTFConverter.Destroy;
  begin
       UnloadLibrary;
  end;

  procedure TwwRTFConverter.LoadLibrary(hwnd: HWND; libpath: AnsiString);
  var hinst: HModule;
      name: WideString;
  begin
	// attempt to load library
	hinst := Windows.LoadLibrary(pchar(libpath));

	if (hinst=0) then showmessage('Unable to load library ' + libpath);

	// library loaded ok
	FLibrary := hinst;

	// get entry points for calls
	@InitConverter32 := GetProcAddress(FLibrary, 'InitConverter32');
	@UninitConverter := GetProcAddress(FLibrary, 'UninitConverter');
	@IsFormatCorrect32 := GetProcAddress(FLibrary, 'IsFormatCorrect32');
	@ForeignToRtf32 := GetProcAddress(FLibrary, 'ForeignToRtf32');
	@RtfToForeign32 := GetProcAddress(FLibrary, 'RtfToForeign32');
	@RegisterApp := GetProcAddress(FLibrary, 'RegisterApp');
	@CchFetchLpszError := GetProcAddress(FLibrary, 'CchFetchLpszError');
	@GetReadNames := GetProcAddress(FLibrary, 'GetReadNames');
	@GetWriteNames := GetProcAddress(FLibrary, 'GetWriteNames');
	@RegisterConverter := GetProcAddress(FLibrary, 'FRegisterConverter');

	// verify that required entry points are available
	if (@InitConverter32 = Nil) or  (@IsFormatCorrect32 = Nil) or
            (@ForeignToRtf32 = Nil)  then begin
           UnloadLibrary();
           Showmessage('Unable to initialize library (required entry points missing)');
        end;

	// initialize converter - if cannot, unload and return failure
        name:= Application.ExeName;
	if InitConverter32(hwnd, PWideChar(name)) = 0 then
        begin
           UnloadLibrary();
           Showmessage('Unable to initialize library (initialization failed)');
        end;
end;

procedure TwwRTFConverter.UnloadLibrary;
begin
   // if library loaded and pUninitConverter is exported, uninitialize the library
   if (FLibrary<>0) and (@UninitConverter<>nil) then
      UninitConverter;

   // if the library is loaded, free it
   if (FLibrary<>0) then FreeLibrary(FLibrary);

   // clear FLibrary and globals
   FLibrary := 0;
   @InitConverter32 := nil;
   @UninitConverter := nil;
   @IsFormatCorrect32 := nil;
   @ForeignToRtf32 := nil;
   @RtfToForeign32 := nil;
   @RegisterApp := nil;
   @CchFetchLpszError := nil;
   @GetReadNames := nil;
   @GetWriteNames := nil;
   @RegisterConverter := nil;

end;


// GlobalAllocString() - utility function to allocate global storage and
// put a string in it
// s - string to put in global storage
//
function GlobalAllocString(s: AnsiString): HGlobal;
var hgsz: HGlobal;
    p: PChar;
begin
   result:= 0;

   // allocate a block of storage large enough for string
   hgsz := GlobalAlloc(GMEM_MOVEABLE, Length(s) + 1);
   if (hgsz=0) then exit;

   // lock the storage and copy the string into it and then unlock the storage
   p := GlobalLock(hgsz);
   if (p=nil) then
   begin
      GlobalFree(hgsz);
      exit;
   end;

   lstrcpy(p, pchar(s));

   GlobalUnlock(hgsz);
   result:= hgsz;
end;

const
  BUFFSIZE = $4000;	// 16k buffer

var
  ghBuff : HGlobal;
  mstream: TMemoryStream;

function RtfOut(cchBuff: longint; nPercent: longint): longint; stdcall;
var retval: longint;
    p : PChar;
begin
   retval := 0;
   p := PChar(GlobalLock(ghBuff));
   if (p=nil) then retval := wwfceNoMemory
   else begin
      try
         mstream.Write(p^, cchBuff);
      except
         GlobalUnlock(ghBuff);
      end;
   end;
   result:= retval;
end;

function RtfIn(rgfOptions: longint; p2: Longint): Longint; stdcall;
//function RtfIn(rgfOptions: longint; dummy: longint): longint; stdcall;
var bytes: longint;
    p: PChar;
begin
//  bytes:= 0;  // assume no more to write
  p := PChar(GlobalLock(ghBuff));

  if (p=nil) then result := wwfceNoMemory
  else begin
     try
        bytes := mstream.Read(p^, BUFFSIZE);
     except
        bytes := wwfceWriteErr;
        GlobalUnlock(ghBuff);
     end;
     result:= bytes;
  end;
end;

function TwwRTFConverter.ForeignToRTF(richedit: TwwCustomRichEdit;
             filepath: AnsiString;
             formatClass: AnsiString = ''): TwwFileCodeError;
var ghszFile, ghszClass, ghszSubset: HGlobal;
    fce: TwwFileCodeError;
begin
   // create a temporary stream to hold incoming RTF
   mstream:= TMemoryStream.create;

  // create global handles for ghszFile, ghszClass, & ghszSubset and
  // allocate a working buffer
  ghszFile := GlobalAllocString(filepath);
  ghszClass := GlobalAllocString(formatClass);
  ghszSubset := GlobalAllocString('');
  ghBuff := GlobalAlloc(GHND, BUFFSIZE);
  if (ghszFile = 0) or (ghszClass = 0) or (ghszSubset = 0) or
     (ghBuff = 0) then
  begin
     if (ghszFile<>0) then GlobalFree(ghszFile);
     if (ghszClass<>0) then GlobalFree(ghszClass);
     if (ghszSubset<>0) then GlobalFree(ghszSubset);
     if (ghBuff<>0) then GlobalFree(ghBuff);
     ghBuff := 0;
     result:= wwfceNoMemory;
     exit;
  end;

  // import RTF
  fce := ForeignToRtf32(ghszFile, nil, ghBuff, ghszClass, ghszSubset, RtfOut);

  // free storage