写了一小段程序,把Delphi6格式的dfm文件内容转换为Delphi5格式(0分)

  • 主题发起人 主题发起人 李颖
  • 开始时间 开始时间

李颖

Unregistered / Unconfirmed
GUEST, unregistred user!
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, soFrombegin
ning);
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 NestingLeveldo

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 > 0do

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.EndOfListdo

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 Truedo

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.EndOfListdo

begin

NewLine;
WriteStr('item');
if Reader.NextValue in [vaInt8, vaInt16, vaInt32] then

begin

WriteStr(' [');
ConvertValue;
WriteStr(']');
end;

WriteStr(sLineBreak);
Reader.CheckValue(vaList);
Inc(NestingLevel);
while not Reader.EndOfListdo

ConvertProperty;
Reader.ReadListend;

Dec(NestingLevel);
WriteIndent;
WriteStr('end');
end;

Reader.ReadListend;

Dec(NestingLevel);
WriteStr('>');
end;

vaInt64:
WriteStr(IntToStr(Reader.ReadInt64));
else

raise EReadError.CreateResFmt(@sPropertyException,
[ObjectName,do
tSep, PropName, Ord(Reader.NextValue)]);
end;

end;

procedure ConvertProperty;
begin

WriteIndent;
PropName := Reader.ReadStr;
// save for error reporting
WriteStr(PropName);
WriteStr(' = ');
ConvertValue;
WriteStr(sLineBreak);
end;

procedure ConvertObject;
begin

ConvertHeader;
Inc(NestingLevel);
while not Reader.EndOfListdo

ConvertProperty;
Reader.ReadListend;

while not Reader.EndOfListdo

ConvertObject;
Reader.ReadListend;

Dec(NestingLevel);
WriteIndent;
WriteStr('end' + sLineBreak);
end;

begin

NestingLevel := 0;
Reader := TReader.Create(Input, 4096);
SaveSeparator := DecimalSeparator;
DecimalSeparator := '.';
try
Writer := TWriter.Create(Output, 4096);
try
Reader.ReadSignature;
ConvertObject;
finally
Writer.Free;
end;

finally
DecimalSeparator := SaveSeparator;
Reader.Free;
end;

end;
 
谢谢李大侠!
不过李兄的程序应该是Delphi6下写的吧?一些单元名和变量D5中都没有,
明天找台有D6的机器试试。
 
接受答案了.
 
后退
顶部