把Delphi6格式的dfm文件内容转换为Delphi5格式

把Delphi6格式的dfm文件内容转换为Delphi5格式
uses
Class, RTLConsts, TypInfo;
function ConvertForm(AFormString: string): string;
var
lSrc, lDest: TStringStream;
lBin: TMemoryStream;
begin
lSrc := TStringStream.Create(AFormString);
lDest := TStringStream.Create('');
lBin := TMemoryStream.Create;
try
ObjectTextToBinary(lSrc, lBin);
lBin.Seek(0, soFromBeginning);
ObjectBinaryToTextEx(lBin, lDest);
Result := lDest.DataString;
finally
lSrc.Free;
lDest.Free;
lBin.Free;
end;
end;
　
其中ObjectBinaryToTextEx是照抄了class.pas中的ObjectBinaryToText过程，改了一点点内容:
case Reader.NextValue of
vaWString, vaUTF8String:
begin
// 此处修改为:
S := Reader.ReadWideString;
ConvertString;
end;
vaString, vaLString:
begin
// 此处修改为:
S := Reader.ReadString;
ConvertString;
end;
end;
修改后的代码如下：
procedure ObjectBinaryToTextEx(Input, Output: TStream);
var
NestingLevel: Integer;
SaveSeparator: Char;
Reader: TReader;
Writer: TWriter;
ObjectName, PropName: string;
procedure WriteIndent;
const
Blanks: array[0..1] of Char = ' ';
var
I: Integer;
begin
for I := 1 to NestingLevel do
Writer.Write(Blanks, SizeOf(Blanks));
end;
procedure WriteStr(const S: string);
begin
Writer.Write(S[1], Length(S));
end;
procedure NewLine;
begin
WriteStr(sLineBreak);
WriteIndent;
end;
procedure ConvertValue; forward;
procedure ConvertHeader;
var
ClassName: string;
Flags: TFilerFlags;
Position: Integer;
begin
Reader.ReadPrefix(Flags, Position);
ClassName := Reader.ReadStr;
ObjectName := Reader.ReadStr;
WriteIndent;
if ffInherited in Flags then
WriteStr('inherited ')
else if ffInline in Flags then
WriteStr('inline ')
else
WriteStr('object ');
if ObjectName <> '' then
begin
WriteStr(ObjectName);
WriteStr(': ');
end;
WriteStr(ClassName);
if ffChildPos in Flags then
begin
WriteStr(' [');
WriteStr(IntToStr(Position));
WriteStr(']');
end;
if ObjectName = '' then
ObjectName := ClassName; // save for error reporting
WriteStr(sLineBreak);
end;
procedure ConvertBinary;
const
BytesPerLine = 32;
var
MultiLine: Boolean;
I: Integer;
Count: Longint;
Buffer: array[0..BytesPerLine - 1] of Char;
Text: array[0..BytesPerLine * 2 - 1] of Char;
begin
Reader.ReadValue;
WriteStr('{');
Inc(NestingLevel);
Reader.Read(Count, SizeOf(Count));
MultiLine := Count >= BytesPerLine;
while Count > 0 do
begin
if MultiLine then
NewLine;
if Count >= 32 then
I := 32
else
I := Count;
Reader.Read(Buffer, I);
BinToHex(Buffer, Text, I);
Writer.Write(Text, I * 2);
Dec(Count, I);
end;
Dec(NestingLevel);
WriteStr('}');
end;
procedure ConvertProperty; forward;
procedure ConvertValue;
const
LineLength = 64;
var
I, J, K, L: Integer;
S: string;
LineBreak: Boolean;
procedure ConvertString;
begin
L := Length(S);
if L = 0 then
WriteStr('''''')
else
begin
I := 1;
Inc(NestingLevel);
try
if L > LineLength then
NewLine;
K := I;
repeat
LineBreak := False;
if (S >= ' ') and (S <> '''') then
begin
J := I;
repeat
Inc(I)
until (I > L) or (S < ' ') or (S = '''') or
((I - K) >= LineLength);
if ((I - K) >= LineLength) then
begin
LIneBreak := True;
if ByteType(S, I) = mbTrailByte then
Dec(I);
end;
WriteStr('''');
Writer.Write(S[J], I - J);
WriteStr('''');
end
else
begin
WriteStr('#');
WriteStr(IntToStr(Ord(S)));
Inc(I);
if ((I - K) >= LineLength) then
LineBreak := True;
end;
if LineBreak and (I <= L) then
begin
WriteStr(' +');
NewLine;
K := I;
end;
until I > L;
finally
Dec(NestingLevel);
end;
end;
end;
begin
case Reader.NextValue of
vaList:
begin
Reader.ReadValue;
WriteStr('(');
Inc(NestingLevel);
while not Reader.EndOfList do
begin
NewLine;
ConvertValue;
end;
Reader.ReadListEnd;
Dec(NestingLevel);
WriteStr(')');
end;
vaInt8, vaInt16, vaInt32:
WriteStr(IntToStr(Reader.ReadInteger));
vaExtended:
WriteStr(FloatToStr(Reader.ReadFloat));
vaSingle:
WriteStr(FloatToStr(Reader.ReadSingle) + 's');
vaCurrency:
WriteStr(FloatToStr(Reader.ReadCurrency * 10000) + 'c');
vaDate:
WriteStr(FloatToStr(Reader.ReadDate) + 'd');
vaWString, vaUTF8String:
begin
S := Reader.ReadWideString;
ConvertString;
end;
vaString, vaLString:
begin
S := Reader.ReadString;
ConvertString;
end;
vaIdent, vaFalse, vaTrue, vaNil, vaNull:
WriteStr(Reader.ReadIdent);
vaBinary:
ConvertBinary;
vaSet:
begin
Reader.ReadValue;
WriteStr('[');
I := 0;
while True do
begin
S := Reader.ReadStr;
if S = '' then
Break;
if I > 0 then
WriteStr(', ');
WriteStr(S);
Inc(I);
end;
WriteStr(']');
end;
vaCollection:
begin
Reader.ReadValue;
WriteStr('<');
Inc(NestingLevel);
while not Reader.EndOfList do
begin
NewLine;
WriteStr('item');
if Reader.NextValue in [vaInt8, vaInt16, vaInt32] then
begin
WriteStr(' [');
ConvertValue;
WriteStr(']');
end;
WriteStr(sLineBreak);