DFM中文本形式 的中文变为明文的形式

procedure TransferDfmFile(ASrcFile: string);
var
  aFormString:String;
  lsrc,ldest:TStringStream;
  lbin:TMemoryStream;
  StrList: TStringList;
  sFile, sNewFile: string;
begin
  ldest:=TStringStream.Create('');
  lbin:=TMemoryStream.Create;
  StrList := TStringList.Create;
  try
    if FileExists(ASrcFile) then
    begin
      StrList.LoadFromFile(ASrcFile);
      aFormString:= StrList.Text;
      lsrc:=TStringStream.Create(aFormstring);
      try
        lsrc.Seek(0,soFromBeginning);
        ObjectTexttoBinary(lsrc,lbin);
        lbin.Seek(0,soFromBeginning);
        ObjectBinarytoTextEx(lbin,ldest);
        StrList.Text:=ldest.DataString;
        StrList.SaveToFile(ASrcFile);
      finally
        lsrc.Free;
      end;
    end;
  finally
    StrList.Free;
    ldest.Free;
    lbin.Free;
  end;
end;

 

procedure ObjectBinaryToTextEx(Input, Output: TStream);
var
  SaveSeparator: Char;
  ObjectName, PropName: string;
  NestingLevel: Integer;
  Reader: TReader;
  Writer: TWriter;

  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 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;

 //因为ConvertValue 和 ConvertProperty是互相调用
  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[I] >= ' ') and (S[I] <> '''') then
            begin
              J := I;
              repeat
                Inc(I)
              until (I > L) or (S[I] < ' ') or (S[I] = '''') 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[I])));
              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
          //!!! these 2 lines are modified in order to write string property in D5 format !!!//
          //!!! please read the old code in Classes.pas !!!//
          S := Reader.ReadWideString;
          ConvertString;
        end;
      vaString, vaLString:
        begin
          //!!! these 2 lines are modified in order to write string property in D5 format !!!//
          //!!! please read the old code in Classes.pas !!!//
          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);
            Reader.CheckValue(vaList);
            Inc(NestingLevel);
            while not Reader.EndOfList do
              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, DotSep, 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.EndOfList do
      ConvertProperty;
    Reader.ReadListEnd;
    while not Reader.EndOfList do
      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;