1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:

type
  TInitConverter32 = function(hWnd: integer; szModule: PChar): integer; stdcall;
  TForeignToRtf32 = function(ghszFile: integer; pstgForeign: Pointer;
        ghBuff: integer; ghszClass: integer;
        ghszSubset: integer; lpfnOut: integer): integer; stdcall;
  THandle = Integer;

var
  RTFStream : TMemoryStream;
  mHandle: THandle;
  InitConverter32: TInitConverter32;
  ForeignToRtf32 : TForeignToRtf32;

function InitConverter: integer;
function ForeignToRtf(filepath, formatClass: AnsiString): integer;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:

function RtfOut(cchBuff, nPercent: integer) : integer;
  var p : PChar;
begin
    Result := 0;  // assume success
    p := GlobalLock(ghBuff);
    if p = nil then Result := fceNoMemory
    else begin
    try
      try
        mStream.Write(p, cchBuff);
      except
        Result := fceNoMemory; // what to return???
      end
    finally
      GlobalUnlock(ghBuff);
    end
  end
end; { RtfOut }

function GlobalAllocString(s: AnsiString): HGLOBAL;
  var hgsz : HGLOBAL;
      p    : PChar;
begin
  // allocate a block of storage large enough for string
  hgsz := GlobalAlloc(GMEM_MOVEABLE, Length(s) + 1);
  if hgsz = 0 then Result := 0;

  // lock the storage and copy the string into it
  p := PChar(GlobalLock(hgsz));
  if p = nil then begin
    GlobalFree(hgsz);
    Result := 0
  end;
  lstrcpy(p, PChar(s));

  // unlock the storage and return the global handle
  GlobalUnlock(hgsz);
  Result := hgsz;
end; { GlobalAllocString }

function ForeignToRtf(filepath, formatClass: AnsiString): integer;
  var ghszFile, ghszClass, ghszSubset : HGLOBAL;
begin
  // create a temporary stream to hold incoming RTF
  try
    mStream := TMemoryStream.Create;
  except
    Result := fceNoMemory;
  end;
  // 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 Boolean(ghszFile) then GlobalFree(ghszFile);
    if Boolean(ghszClass) then GlobalFree(ghszClass);
    if Boolean(ghszSubset) then GlobalFree(ghszSubset);
    if Boolean(ghBuff) then GlobalFree(ghBuff);
    ghBuff := 0;
    Result := fceNoMemory;
  end;

  // import RTF
  mHandle := LoadLibrary('Word2.dll');
  if mHandle <> 0 then
  begin
    @ForeignToRtf32 := GetProcAddress(mHandle, 'ForeignToRtf32');
    try
      if @ForeignToRtf32 <> nil then
        FCE := ForeignToRtf32(ghszFile, nil, ghBuff,
                              ghszClass, ghszSubSet, Integer(@RtfOut));