298 lines
11 KiB
ObjectPascal
298 lines
11 KiB
ObjectPascal
|
unit funciones;
|
|||
|
|
|
|||
|
|
interface
|
|||
|
|
|
|||
|
|
function RtfToText(Cadena: PChar): PChar; cdecl; export;
|
|||
|
|
|
|||
|
|
implementation
|
|||
|
|
|
|||
|
|
uses
|
|||
|
|
Forms, Classes, SysUtils, StdCtrls, ComCtrls,
|
|||
|
|
RVRTF, RVRTFErr, Menus, RVTypes;
|
|||
|
|
|
|||
|
|
type
|
|||
|
|
TConversor = class(TObject)
|
|||
|
|
private
|
|||
|
|
FirstLine: Boolean;
|
|||
|
|
procedure DoReaderText(Sender: TRVRTFReader; const Text: TRVAnsiString;
|
|||
|
|
Position: TRVRTFPosition);
|
|||
|
|
public
|
|||
|
|
RTFText: TRVAnsiString;
|
|||
|
|
function ExtractTextFromRTF(const AStream: TStream): Boolean;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
{ TConversor }
|
|||
|
|
|
|||
|
|
procedure TConversor.DoReaderText(Sender: TRVRTFReader;
|
|||
|
|
const Text: TRVAnsiString; Position: TRVRTFPosition);
|
|||
|
|
begin
|
|||
|
|
if (Position <> rtf_ts_ContinuePara) and not FirstLine then
|
|||
|
|
RTFText := RTFText+#13#10;
|
|||
|
|
FirstLine := False;
|
|||
|
|
RTFText := RTFText+Text;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TConversor.ExtractTextFromRTF(const AStream: TStream): Boolean;
|
|||
|
|
var
|
|||
|
|
Parser: TRVRTFReader;
|
|||
|
|
begin
|
|||
|
|
{FirstLine := True;}
|
|||
|
|
parser := TRVRTFReader.Create(nil);
|
|||
|
|
try
|
|||
|
|
Parser.OnNewText := DoReaderText;
|
|||
|
|
Result := (Parser.ReadFromStream(AStream) = rtf_ec_OK);
|
|||
|
|
finally
|
|||
|
|
Parser.Free;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function RtfToText(Cadena: PChar): PChar;
|
|||
|
|
var
|
|||
|
|
AStream : TStringStream;
|
|||
|
|
AConversor : TConversor;
|
|||
|
|
begin
|
|||
|
|
AStream := TStringStream.Create(Cadena);
|
|||
|
|
AConversor := TConversor.Create;
|
|||
|
|
try
|
|||
|
|
AConversor.ExtractTextFromRTF(AStream);
|
|||
|
|
Result := PChar(AConversor.RTFText);
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(AConversor);
|
|||
|
|
FreeAndNIL(AStream);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
// NO USAR LAS FUNCIONES QUE VIENEN A CONTINUACI<43>N
|
|||
|
|
|
|||
|
|
|
|||
|
|
// Esta funci<63>n falla cuando hay caracteres especiales en el texto (<28>, por ejemplo).
|
|||
|
|
// Mejor la de abajo.
|
|||
|
|
|
|||
|
|
function RtfToText2(Cadena: PChar): PChar;
|
|||
|
|
var
|
|||
|
|
i: integer;
|
|||
|
|
CadenaAux1: String;
|
|||
|
|
|
|||
|
|
begin
|
|||
|
|
//Si no tiene ninguna llave no esta guardado como rtf
|
|||
|
|
if (Pos('{', Cadena) = 0) then
|
|||
|
|
Result := Cadena
|
|||
|
|
else
|
|||
|
|
//Esta guardado con rtf
|
|||
|
|
begin
|
|||
|
|
//Quitamos todo lo que est<73> antes de \fs1x
|
|||
|
|
i := Pos('\fs', Cadena);
|
|||
|
|
CadenaAux1 := Copy(Cadena, i, StrLen(Cadena)-1);
|
|||
|
|
|
|||
|
|
//Quitamos la parte de delante \fs1x
|
|||
|
|
i:= Pos(' ', CadenaAux1);
|
|||
|
|
CadenaAux1 := Copy(PChar(CadenaAux1), i+1, StrLen(PChar(CadenaAux1))-1);
|
|||
|
|
|
|||
|
|
//Quitamos todo lo de la parte de atras a partir de la primera barra \ que tengamos
|
|||
|
|
i:= Pos('\', CadenaAux1);
|
|||
|
|
CadenaAux1 := Copy(PChar(CadenaAux1), 0, i-1);
|
|||
|
|
|
|||
|
|
Result := PChar(CadenaAux1);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
|
|||
|
|
{
|
|||
|
|
Convert RTF enabled text to plain.
|
|||
|
|
http://www.delphipraxis.net/topic45179.html
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
// Esta funci<63>n falla porque se come letras del final de cada l<>nea (<28>?)
|
|||
|
|
|
|||
|
|
// HAY QUE LIMPIAR LA CADENA DE ENTRADA DE SALTOS DE L<>NEA (#$D#$A) POR QUE
|
|||
|
|
// SI NO, NO ES UNA CADENA CON TEXTO RTF V<>LIDO
|
|||
|
|
|
|||
|
|
function RtfToText3(Cadena: PChar): PChar;
|
|||
|
|
const
|
|||
|
|
SaltoLinea = #13#10; //--> #$D#$A
|
|||
|
|
var
|
|||
|
|
aSource: string; // <- Para almacenar la cadena de entrada sin saltos de l<>nea
|
|||
|
|
Source: string;
|
|||
|
|
NChar: Integer;
|
|||
|
|
|
|||
|
|
function ProcessGroupRecursevly: string;
|
|||
|
|
|
|||
|
|
function HexToInt(HexStr: String): Integer;
|
|||
|
|
begin
|
|||
|
|
result := StrToInt('$' + HexStr);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure SkipStar;
|
|||
|
|
var
|
|||
|
|
BracesOpened: Integer;
|
|||
|
|
Escaped: Boolean;
|
|||
|
|
begin
|
|||
|
|
BracesOpened:=1;
|
|||
|
|
Escaped:=false;
|
|||
|
|
while BracesOpened>0
|
|||
|
|
do begin
|
|||
|
|
Inc (NChar);
|
|||
|
|
case Source [NChar] of
|
|||
|
|
'{': if Escaped
|
|||
|
|
then Escaped:=false
|
|||
|
|
else Inc (BracesOpened);
|
|||
|
|
'}': if Escaped
|
|||
|
|
then Escaped:=false
|
|||
|
|
else Dec (BracesOpened);
|
|||
|
|
'\': Escaped:=not Escaped;
|
|||
|
|
else Escaped:=false;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function UnicodeCharCode2ANSIChar (aCode: LongInt): Char;
|
|||
|
|
type
|
|||
|
|
TUnicode2ANSITable=array [$0410..$044f] of Char;
|
|||
|
|
const
|
|||
|
|
Unicode2ANSITable: TUnicode2AnsiTable=('<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>',
|
|||
|
|
'<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>', '<27>');
|
|||
|
|
begin
|
|||
|
|
if (Low (Unicode2ANSITable)<=aCode) and (aCode<=High (Unicode2ANSITable)) then
|
|||
|
|
UnicodeCharCode2ANSIChar:=Unicode2ANSITable [aCode]
|
|||
|
|
else UnicodeCharCode2ANSIChar:='?';
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
var
|
|||
|
|
Control, NumericValue, TextValue: string;
|
|||
|
|
begin
|
|||
|
|
Result:='';
|
|||
|
|
Inc (NChar);
|
|||
|
|
while NChar<=Length (Source)
|
|||
|
|
do case Source [NChar] of
|
|||
|
|
'{': Result:=Result+ProcessGroupRecursevly;
|
|||
|
|
'}': begin
|
|||
|
|
Inc (NChar);
|
|||
|
|
Break;
|
|||
|
|
end;
|
|||
|
|
'\': begin
|
|||
|
|
Inc (NChar);
|
|||
|
|
case Source [NChar] of
|
|||
|
|
'''': begin
|
|||
|
|
Result:=Result+Chr (HexToInt (Copy (Source, NChar+1, 2)));
|
|||
|
|
Inc (NChar, 3);
|
|||
|
|
end;
|
|||
|
|
'~': Result:=Result+#$20;
|
|||
|
|
'*': SkipStar;
|
|||
|
|
'a'..'z': begin
|
|||
|
|
Control:='';
|
|||
|
|
while Source [NChar] in ['a'..'z']
|
|||
|
|
do begin
|
|||
|
|
Control:=Control+Source [NChar];
|
|||
|
|
Inc (NChar);
|
|||
|
|
end;
|
|||
|
|
if Source [NChar]='-'
|
|||
|
|
then begin
|
|||
|
|
NumericValue:=Source [NChar];
|
|||
|
|
Inc (NChar);
|
|||
|
|
end
|
|||
|
|
else NumericValue:='';
|
|||
|
|
while Source [NChar] in ['0'..'9']
|
|||
|
|
do begin
|
|||
|
|
NumericValue:=NumericValue+Source [NChar];
|
|||
|
|
Inc (NChar);
|
|||
|
|
end;
|
|||
|
|
if Source [NChar]='{'
|
|||
|
|
then ProcessGroupRecursevly;
|
|||
|
|
TextValue:='';
|
|||
|
|
if not (Source [NChar] in ['a'..'z', '{', '}', '\'])
|
|||
|
|
then begin
|
|||
|
|
Inc (NChar);
|
|||
|
|
while not (Source [NChar] in ['{', '}', '\'])
|
|||
|
|
do begin
|
|||
|
|
TextValue:=TextValue+Source [NChar];
|
|||
|
|
Inc (NChar);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
if (Control='line') or (Control='par')
|
|||
|
|
then Result:=Result+#$0D#$0A
|
|||
|
|
else if Control='tab'
|
|||
|
|
then Result:=Result+#$09
|
|||
|
|
else if Control='u'
|
|||
|
|
then Result:=Result+UnicodeCharCode2ANSIChar (StrToInt (NumericValue))
|
|||
|
|
else if Control='colortbl'
|
|||
|
|
then TextValue:='';
|
|||
|
|
if Length (TextValue)>0
|
|||
|
|
then if (not ((TextValue [Length (TextValue)]=';') and (Source [NChar]='}')))
|
|||
|
|
then begin
|
|||
|
|
Result:=Result+TextValue;
|
|||
|
|
TextValue:='';
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
else begin
|
|||
|
|
Result:=Result+Source [NChar];
|
|||
|
|
Inc (NChar);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
else begin
|
|||
|
|
Result:=Result+Source [NChar];
|
|||
|
|
Inc (NChar);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function InitSource: Boolean;
|
|||
|
|
var
|
|||
|
|
BracesCount: Integer;
|
|||
|
|
Escaped: Boolean;
|
|||
|
|
begin
|
|||
|
|
if Copy (aSource, 1, 5) <> '{\rtf' then
|
|||
|
|
InitSource:=false
|
|||
|
|
else begin
|
|||
|
|
Source:='';
|
|||
|
|
BracesCount:=0;
|
|||
|
|
Escaped:=false;
|
|||
|
|
NChar:=1;
|
|||
|
|
while (NChar<=Length (aSource)) and (BracesCount>=0)
|
|||
|
|
do begin
|
|||
|
|
if not (aSource [NChar] in [#$0D, #$0A])
|
|||
|
|
then begin
|
|||
|
|
Source:=Source+aSource [NChar];
|
|||
|
|
case aSource [NChar] of
|
|||
|
|
'{': if not Escaped
|
|||
|
|
then Inc (BracesCount)
|
|||
|
|
else Escaped:=false;
|
|||
|
|
'}': if not Escaped
|
|||
|
|
then Dec (BracesCount)
|
|||
|
|
else Escaped:=false;
|
|||
|
|
'\': Escaped:=true;
|
|||
|
|
else Escaped:=false;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
Inc (NChar);
|
|||
|
|
end;
|
|||
|
|
InitSource:=BracesCount=0;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
begin
|
|||
|
|
// Hay que quitar el salto de l<>nea al final de la aSource RTF
|
|||
|
|
aSource := Copy(Cadena, 1, length(Cadena)-2);
|
|||
|
|
|
|||
|
|
// Cambiar los saltos de l<>nea que no son de RTF por un caracter para
|
|||
|
|
// que se limpien.
|
|||
|
|
// aSource := StringReplace(aSource, SaltoLinea, '^', [rfreplaceall]);
|
|||
|
|
|
|||
|
|
if InitSource then
|
|||
|
|
begin
|
|||
|
|
NChar:=1;
|
|||
|
|
Result:= PChar(ProcessGroupRecursevly);
|
|||
|
|
end
|
|||
|
|
else
|
|||
|
|
Result := PChar(aSource);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
end.
|