wwrtfconverter.pas

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

  GlobalFree(ghszFile);
  GlobalFree(ghszClass);
  GlobalFree(ghszSubset);
  GlobalFree(ghBuff);
  ghBuff := 0;

  // copy the stream into the rich edit control
  mstream.Position := 0;
  richedit.Lines.LoadFromStream(mstream);

  mstream.free;
  mstream := nil;
  result:= fce;
end;

function TwwRTFConverter.RTFToForeign(richedit: TwwCustomRichEdit;
             filepath: AnsiString;
             formatclass: AnsiString = ''): TwwFileCodeError;
var ghszFile, ghszClass: HGlobal;
    fce: TwwFileCodeError;
begin
   // quick out if not implemented
   if (@RtfToForeign32=nil) then
   begin
      result:= wwfceWrongFileType;
      exit;
   end;

   // create a temporary stream to hold incoming RTF
   try
      mstream:= TMemoryStream.create;
   except
      result:= wwfceNoMemory;
      exit;
   end;

   // fill the stream from the Rich Edit control
   try
      richedit.Lines.SaveToStream(mstream);
   except
      mstream.free;
      mstream:=nil;
      result:= wwfceNoMemory;
      exit;
   end;

   // reposition stream to start
   mstream.position := 0;

   ghszFile := GlobalAllocString(filepath);
   ghszClass := GlobalAllocString(formatClass);
   ghBuff := GlobalAlloc(GHND, BUFFSIZE);

   if (ghszFile = 0) or (ghszClass = 0) or
      (ghBuff = 0) then
   begin
      if (ghszFile<>0) then GlobalFree(ghszFile);
      if (ghszClass<>0) then GlobalFree(ghszClass);
      if (ghBuff<>0) then GlobalFree(ghBuff);
      ghBuff := 0;
      result:= wwfceNoMemory;
      exit;
   end;

   // export RTF
   fce := RtfToForeign32(ghszFile, nil, ghBuff, ghszClass, RtfIn);

  // free storage
  GlobalFree(ghszFile);
  GlobalFree(ghszClass);
  GlobalFree(ghBuff);
  ghBuff := 0;

  mstream.free;
  mstream := nil;
  result:= fce;
end;

function TwwRTFConverter.IsKnownFormat(FilePath: AnsiString): Boolean;
//function TwwRTFConverter.GetFormatClass(filepath: AnsiString): AnsiString;
var hgszFile, hgszClass: HGlobal;
    stat: longint;
//    p: PChar;
begin
   // allocate global storage for filepath and format class
   result:= False;
   hgszFile := GlobalAllocString(filepath);
   hgszClass := GlobalAllocString('');

   if (hgszFile<>0) and (hgszClass<>0) then
   begin
      // test the file
      stat := IsFormatCorrect32(hgszFile, hgszClass);

      // Check if file matches format
      if (stat <> wwfceTrue) then
//      if (stat <> wwfceNoErr) then
      begin
	  GlobalFree(hgszFile);
	  GlobalFree(hgszClass);
          result:= False;
          exit;
      end
      else result:= True;

      // copy the class name into local storage and free global storage
//      p := PChar(GlobalLock(hgszClass));
//      GlobalUnlock(hgszClass);

      // return format class name
//      result:= AnsiString(p);
   end;

   if hgszFile<>0 then GlobalFree(hgszFile);
   if hgszClass<>0 then GlobalFree(hgszClass);
end;

constructor TwwRTFConverterList.Create(import: boolean);
var i: integer;
begin
	LibPath := TStringList.create;
	Description := TStringList.create;
	Description.Sorted := true;
	Description.Duplicates := dupAccept;
	RawDescription := TStringList.create;
	FormatClass := TStringList.create;
	Filters := TStringList.create;

	// get converter list for each known location
        // 6/23/03 - Fix bug by removing trailing \ in path
	GetConverterList(HKEY_LOCAL_MACHINE,
		'\Software\Microsoft\Shared Tools\Text Converters\', '',
		import);
//	GetConverterList(HKEY_CURRENT_USER,
//		'\Software\Microsoft\Office\8.0\Word\Text Converters\', 'Word 97',
//		import);
	// and build a filter list suitable for using with TOpenDialog::Filter
	for i:= 0 to Description.Count-1 do
        begin
           if (i>0) then FilterList := FilterList + '|';
           FilterList := FilterList + Description.Strings[i] + ' (' + Filters.Strings[i] +
			')|' + Filters.Strings[i];
        end;
end;

destructor TwwRTFConverterList.Destroy;
begin
   LibPath.Free;
   Description.Free;
   RawDescription.Free;
   FormatClass.Free;
   Filters.Free;
end;

procedure TwwRTFConverterList.GetConverterList(regRoot: HKey;
    regPath: AnsiString; appName: AnsiString; import: boolean);
var subkeys: TStringList;
    sRegPath, sName, sExt, sPath: AnsiString;
    reg: TRegistry;
    currKey, name, ext, path: AnsiString;
    tempExt, s: String;
    skipit: boolean;
    i, j: integer;
    rawName : AnsiString;
    ndx: integer;
    APos: integer;
begin
  subkeys:= TStringlist.create;

  // Registry key path and data value names
  sRegPath := regPath;
  sName:= 'Name';
  sExt:= 'Extensions';
  sPath:= 'Path';

  	// modify Registry key path for import or export
  if (import) then sRegPath := sRegPath + 'Import'
  else sRegPath := sRegPath + 'Export';

  // allocate a Registry object
  reg:= TRegistry.create;

  try
    // open Registry key and get subkeys
    reg.RootKey := regRoot;
//    reg.OpenKey(sRegPath, false);
    reg.OpenKeyReadOnly(sRegPath); // 9/26/05 - Support PowerUser, by not requiring write priviledge to registry
    reg.GetKeyNames(subKeys);
    reg.CloseKey();

    // for each subkey
    for i:= 0 to subKeys.count-1 do
    begin
       // append it to the import/export key
       	currKey := sRegPath + AnsiString('\') + subKeys.Strings[i];

       // open that key and retrieve "Name," "Path", & "Extensions" values
       	try
//            reg.OpenKey(currKey, false);
            reg.OpenKeyReadOnly(currKey);
            name := reg.ReadString(sName);
            path := reg.ReadString(sPath);
            tempExt := reg.ReadString(sExt);

            // extensions are returned as a space-delimited,
	    // parse extensions and format as filters
            APos:=1;
            ext:= '';
            repeat
               s:= strGetToken(tempExt, ' ', APos);
               if length(s)=0 then break;
               if length(ext)>0 then
               begin
                  ext:= ext + ';';
                  ext:= ext + AnsiString('*.') + s;
               end
               else
                  ext:= AnsiString('*.') + s
            until False;
        finally
        end;

        // close the subkey
	reg.CloseKey;

	// duplicates are possible -- look through the descriptions
	// and, if a match is found, compare the library paths, extensions,
	// and format classes... if all are the same as the existing entry,
	// then skip this one.
        skipIt := false;

        for j:= 0 to RawDescription.Count-1 do begin
(*           if (!FRawDescription->Strings[j].AnsiCompareIC(name) &&
					!LibraryPath->Strings[j].AnsiCompareIC(path) &&
					!FormatClass->Strings[j].AnsiCompareIC(subKeys->Strings[i]) &&
					!Filters->Strings[j].AnsiCompareIC(ext))
					skipIt = true;
*)
        end;
        
        // and add the values to the string lists
        if not skipit and (length(name)>0) and {(length(ext)>0) and}
           (length(path)>0) then
        begin
           rawName := name;
           if length(appName)>0 then
              name:= name + AnsiString(' - ') + appName;
           ndx := Description.Add(name);
           RawDescription.Insert(ndx, rawName);
           LibPath.Insert(ndx, path);
           FormatClass.Insert(ndx, subKeys.Strings[i]);
           Filters.Insert(ndx, ext);
        end
     end
  finally
  end;

	// free local storage
  reg.free;
  subKeys.free;

end;

function TwwRTFConverter.GetErrorMessage(ErrorCode: Smallint): string;
var buf: array[0..255] of char;//widechar;
begin
   result:= '';
   if @CchFetchLpszError<>nil then
   begin
			if CchFetchLpszError(Errorcode, @buf, sizeof(buf))<>0 then
				result:= AnsiString(buf);
   end
   else begin
      case ErrorCode of
       wwfceOpenInFileErr: result:= 'Could not open input file';
       wwfceReadErr: result:= 'Error during read';
       wwfceWriteErr: result:= 'Error during write';
       wwfceInvalidFile	: result:= 'Invalid data in conversion file';
       wwfceNoMemory: result:= 'Out of memory';
       wwfceOpenOutFileErr: result:= 'Could not open output file';
       wwfceUserCancel: result:= 'Conversion cancelled by user';
       wwfceWrongFileType: result:= 'Wrong file type for this converter';
       else result:= 'Error importing or exporting';
      end
   end;
end;

end.