Преобразование Unicode строк в DFM файлах Delphi 6 в Ansi строки

{ **** UBPFD *********** by kladovka.net.ru ****
>> Преобразование Unicode строк в DFM файлах Delphi 6 в Ansi строки.
 
При попытке открыть проект созданный в Delphi 6 из Delphi 5 возникает 
проблема с чтением DFM-файла. Проблема заключается в том, что Delphi5 
не может прочитать строки, записанные в формате Unicode (WideString). 
Данная функция переводит строки из DFM файла в формат ANSI, после чего
DFM файл читается в D5. Но при этом может возникнуть проблема, 
связанная с незнакомыми для D5 свойствами компонентов, которая, 
в свою очередь, решается игнорированием этих свойств.
 
Зависимости: Classes
Автор:       Радионов Алексей (Alx2), alx@argo.mv.ru, ICQ:113442587, Ульяновск
Copyright:   Alx2
Дата:        31 мая 2002 г.
********************************************** }
 
Procedure RemoveUnicodeFromDFM(Const Filename: String);
  Function isChanges(Const S: String; Var Res: String): Boolean;
  Var len: Integer;
    Function LexemSharp(Var K: Integer): Boolean; 
    Begin
      Result := (K < len) And (S[K] = '#');
      If Result Then
      Begin
        inc(K);
        While (K <= len) And (S[K] In ['0'..'9']) Do inc(K);
      End;
    End;
    Function LexemAp(Var K: Integer): Boolean;
    Begin
      Result := (K < len) And (S[K] = '''');
      If Result Then
      Begin
        inc(K);
        While (K <= len) And (S[K] <> '''') Do inc(K);
        If K <= len
          Then
          inc(K);
      End;
    End;
 
    Function Lexem(Var K: Integer; Var Str: String): Boolean;
    Var
      Start: Integer;
      ValS : String;
    Begin
      Result := False;
      Start := K;
      If LexemSharp(K) Then
      Begin
        ValS := Copy(S, Start + 1, K - Start - 1);
        Str := WideChar(StrToInt(ValS));
        Result := True;
      End
      Else
        If LexemAp(K) Then
        Begin
          Str := Copy(S, Start + 1, K - Start - 2);
          Result := True;
        End;
    End;
 
    Function Prepare(Var K: Integer): String;
    Var Str: String;
      WasLexem: Boolean;
    Begin
      Result := '';
      WasLexem := False;
      While Lexem(K, Str) Do
      Begin
        Result := Result + Str;
        WasLexem := True;
      End;
      If Result <> '' Then
        Result := '''' + Result + '''' + Copy(S, K, Length(S))
      Else
        If Not WasLexem Then
          Result := S
        Else
          Result := '''''';
    End;
    Function Min(A, B: Integer): Integer;
    Begin
      If A = 0 Then Result := B
      Else
        If B = 0 Then Result := A
        Else
          If A > B Then Result := B
          Else Result := A;
    End;
 
  Var
    StartIdx: Integer;
  Begin
    Result := False;
    StartIdx := Min(Pos('#', S), Pos('''', S));
    If StartIdx > 0 Then
    Begin
      len := Length(S);
      While (StartIdx <= len) And (Not (S[StartIdx] In ['#', ''''])) Do inc(StartIdx);
      If StartIdx < len Then
      Begin
        Res := Copy(S, 1, StartIdx - 1) + Prepare(StartIdx);
        Result := True;
      End;
    End;
  End;
 
Var
  SList: TStringList;
  K : Integer;
  Res : String;
Begin
  SList := TStringList.Create;
  Try
    SList.LOADFROMFILE(Filename);
    For K := 0 To SList.Count - 1 Do
      If isChanges(SList[K], Res) Then
        SList[K] := Res;
    SList.SaveToFile(Filename);
  Finally
    SList.Free;
  End;
End; 

Пример использования:

Procedure TForm1.Button1Click(Sender: TObject);
Var
  K: Integer;
Begin
  If OpenDialog1.Execute Then
    For K := 0 To OpenDialog1.Files.Count - 1 Do
      RemoveUnicodeFromDFM(OpenDialog1.Files[K]);
End;