盒子论坛 v2.1

有个工具，我找不到在哪里下载，我传到我FTP上了（注：我自己还没用过）

点击下载

介绍如下：
Delphi 6 到 5 转换工具 1.01
用途：

    用Delphi6做的工程在Delphi5中打不开，表现在许多form的信息丢失，
用本工具可转换Delphi6的工程到Delphi5的格式，令6、5之间可以互用。
并且一次性批量转换，省去许多时间。

（同样可用于C++Builder 6到5的转换）

原理：
    Delphi6中的form文件.dfm对于非ACSII字符串（如中文字符串）使用的是字符的编码，
如#ddddd（十进制数），而不是直接可见的字符串，这样造成Delphi5不能识别这样的字符
串，因为Delphi5只能识别dfm文件中的ASCII字符编码#ddd（0-255）（可能可以调整Delphi5
的内码识别如GB2312的字符编码使Delphi5能够识别，但如何调整？）
    本工具把字符串中的中文编码（理论上也可以转换各种语言的delphi6文件，但需要在
各自语言环境的Windows中转换）转换成直接可见的字符串，使Delphi5能识别，这样Delphi6
的工程就可在Delphi5中使用了。

适用对象：
    本工具适用于既使用Delphi6又使用Delphi5的所有开发人员，用本工具可使你的工程在
6与5中穿插使用。

----------------------------------------------

充电..........

作者：

shj209 (shj209)	★☆☆☆☆	-
	盒子活跃会员

2003/5/14 20:04:28

4楼：

谢谢，我自己刚写好了一个，还不完善：
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Buttons, StdCtrls, Menus;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Memo2: TMemo;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    OpenDialog1: TOpenDialog;
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
  private
    { Private declarations }
    function UnicodeToAnsi(Unicode: string):string;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.SpeedButton1Click(Sender: TObject);
var s,a:string;
    i,j,k:integer;
    b:boolean;
begin
s:=memo1.Lines.Text;
for i:=1 to length(s) do
  begin
    if s[i]='#' then
      begin
        j:=i;
        repeat
        j:=j+1;
        until not(s[j] in  ['0','1','2','3','4','5','6','7','8','9']);
        a:=copy(s,i+1,j-i-1);
        delete(s,i,j-i);
        insert(''+UnicodeToAnsi(IntToHex(StrToInt(a), 4))+'',s,i);
      end;
  end;
memo2.Lines.Text:=s;
//memo2.Lines.SaveToFile(OpenDialog1.FileName);
end;

function TForm1.UnicodeToAnsi(Unicode: string):string;
var
  s:string;
  i:integer;
  j,k:string[2];

function ReadHex(AString:string):integer;
begin
  Result:=StrToInt('$'+AString)
end;

begin
  i:=1;
  s:=';
  while i<Length(Unicode)+1 do begin
    j:=Copy(Unicode,i+2,2);
    k:=Copy(Unicode,i,2);
    i:=i+4;
    s:=s+Char(ReadHex(j))+Char(ReadHex(k));
  end;
  if s<>' then
    s:=WideCharToString(PWideChar(s+#0#0#0#0))
  else
    s:=';
  Result:=s;
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
OpenDialog1.Execute;
memo1.Lines.LoadFromFile(OpenDialog1.FileName);
end;

end.
----------------------------------------------
-

作者：

Another (Another)	★☆☆☆☆	-
	盒子活跃会员

2003/5/14 20:34:05

5楼：

这么多高手！

以后可要多多帮忙呀！
----------------------------------------------

作者：

boy (阿門)	★☆☆☆☆	-
	盒子活跃会员

2003/5/15 0:04:34

6楼：

Delphi 6 到 5 转换工具

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, FileCtrl;

type
  TForm1 = class(TForm)
    DirectoryListBox1: TDirectoryListBox;
    DirectoryListBox2: TDirectoryListBox;
    Edit1: TEdit;
    Label1: TLabel;
    Edit2: TEdit;
    Label2: TLabel;
    Button1: TButton;
    FileListBox1: TFileListBox;
    procedure FormCreate(Sender: TObject);
    procedure DirectoryListBox1Change(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
function CopyFileTo(const Source, Destination: string): Boolean;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  DirectoryListBox1.OnChange(Sender);
end;

procedure TForm1.DirectoryListBox1Change(Sender: TObject);
begin
  Edit1.Text := DirectoryListBox1.Directory;
  Edit2.Text := DirectoryListBox2.Directory;
  FileListBox1.Directory := DirectoryListBox1.Directory;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  I,J,K,L,P,Q: integer;
  F,S,T,R: string;
  H: TextFile;
begin
  for I := 0 to FileListBox1.Items.Count-1 do begin
    F := FileListBox1.Items[I];
    if pos('.~',F) > 0 then continue;
    if pos('.exe',F) > 0 then continue;
    if pos('.dfm',F) = 0 then begin
      CopyFileTo(DirectoryListBox1.Directory+'\'+FileListBox1.Items[I],DirectoryListBox2.Directory+'\'+FileListBox1.Items[I]);
      Continue;
    end;
    AssignFile(H,DirectoryListBox1.Directory+'\'+FileListBox1.Items[I]);
    Reset(H);
    F := ';
    while True do
    begin
      ReadLn(H,S);
      if S = ' then break;
      if pos('#',S) = 0 then
      begin
         F := F+S+#13#10;
         continue;
      end;
      while pos(#39,S) > 0 do
        Delete(S,Pos(#39,S),1);
      T := ';
      J := 0;
      L := 0;
      while S <> ' do
      begin
         P := pos('#',S);
         if P = 0 then
         begin
            T := T+#39+S;
            L := 1;
            break;
         end;
         if P <> 1 then T := T+copy(S,1,P-1);
         if J = 0 then T := T+#39;
         K := 0;
         if pos(copy(S,P+1,1),'0123456789') = 0 then inc(K);
         if pos(copy(S,P+2,1),'0123456789') = 0 then inc(K);
         if pos(copy(S,P+3,1),'0123456789') = 0 then inc(K);
         if pos(copy(S,P+4,1),'0123456789') = 0 then inc(K);
         if K > 0 then
         begin
            S := copy(S,P+1,length(S)-P);
            Q := pos('#',S);
            if Q > 0 then
            begin
               S := copy(S,Q,length(S)-Q+1);
               T := T + '#'+copy(S,1,Q-1);
            end else
            begin
               S := ';
               T := T + S;
            end;
            continue;
         end;
         Inc(J);
         S := copy(S,P+1,length(S)-P);
         Q := pos('#',S);
         R := ';
         R := WideChar(StrToInt(copy(S,1,5)));
         T := T+R;
         if Q > 6 then
         T := T + copy(S,6,Q-6);
         S := copy(S,Q,length(S)-Q+1);
         if Q = 0 then
         S := copy(S,6,length(S)-6+1);
      end;
      if L = 0 then
        F := F+T+#39#13#10
      else
        F := F+T+#13#10;
    end;
    CloseFile(H);
    AssignFile(H,DirectoryListBox2.Directory+'\'+FileListBox1.Items[I]);
    ReWrite(H);
    WriteLn(H,F);
    CloseFile(H);
  end;
  showmessage('Translater Ok');
end;

function TForm1.CopyFileTo(const Source, Destination: string): Boolean;
var
  SourceStream: TFileStream;
begin
  result := false;
  if not FileExists(Destination) then
  begin
    SourceStream := TFileStream.Create(Source, fmOpenRead);
    try
      with TFileStream.Create(Destination, fmCreate) do
      try
        CopyFrom(SourceStream, 0);
      finally free;
      end;
    finally SourceStream.free;
    end;
    result := true;
  end;
end;

end.
==================================
object Form1: TForm1
  Left = 193
  Top = 111
  Width = 443
  Height = 348
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = CHINESEBIG5_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = '細明體'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 11
  object Label1: TLabel
    Left = 16
    Top = 24
    Width = 186
    Height = 11
    Caption = 'Source Directory( for Delphi 6)'
  end
  object Label2: TLabel
    Left = 224
    Top = 24
    Width = 186
    Height = 11
    Caption = 'Target Directory( for Delphi 5)'
  end
  object DirectoryListBox1: TDirectoryListBox
    Left = 16
    Top = 64
    Width = 185
    Height = 193
    ImeName = '蒙恬筆輸入法'
    ItemHeight = 16
    TabOrder = 0
    OnChange = DirectoryListBox1Change
  end
  object DirectoryListBox2: TDirectoryListBox
    Left = 224
    Top = 64
    Width = 185
    Height = 193
    ImeName = '蒙恬筆輸入法'
    ItemHeight = 16
    TabOrder = 1
    OnChange = DirectoryListBox1Change
  end
  object Edit1: TEdit
    Left = 16
    Top = 40
    Width = 185
    Height = 19
    ImeName = '蒙恬筆輸入法'
    TabOrder = 2
    Text = 'Edit1'
  end
  object Edit2: TEdit
    Left = 224
    Top = 40
    Width = 185
    Height = 19
    ImeName = '蒙恬筆輸入法'
    TabOrder = 3
    Text = 'Edit2'
  end
  object Button1: TButton
    Left = 216
    Top = 288
    Width = 75
    Height = 25
    Caption = 'Translater'
    TabOrder = 4
    OnClick = Button1Click
  end
  object FileListBox1: TFileListBox
    Left = 38
    Top = 142
    Width = 145
    Height = 97
    ImeName = '蒙恬筆輸入法'
    ItemHeight = 11
    TabOrder = 5
    Visible = False
  end
end

----------------------------------------------
Delphi開發◆伺服器架設◆免安裝APACHE,PHP,CGI Perl, MYSQL ★

作者：

cjrb (Thinking In 魂)	★☆☆☆☆	-
	盒子活跃会员

2003/5/15 14:16:58

7楼：

把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[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

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



----------------------------------------------

充电..........

作者：

Another (Another)	★☆☆☆☆	-
	盒子活跃会员

2003/5/15 14:48:07

8楼：

我晕！
----------------------------------------------

作者：

bear (bear)	★☆☆☆☆	-
	盒子活跃会员

2003/5/25 9:17:30

9楼：

（1）  boy 的转换程序可以解决大部份问题，但在以下内容在转换时出了点毛病，需要人工处理：
D6的内容是：  Caption = '86 '#20116#31508#30721#65306
转换结果为：  Caption = 86'五笔码：'
由于单号没有将 86 两个字包括进去，所以在加载时发生错误，后来用人工处理才过关。
（2）网页上 cjrb(虚渺) 的格式转换程序好象未完，请问我应当在什么地方找到  class.pas中的ObjectBinaryToText 过程
----------------------------------------------
-

作者：

shj209 (shj209)	★☆☆☆☆	-
	盒子活跃会员

2003/5/25 9:35:02

10楼：

用记事本打开classes.pas，然后查找ObjectBinaryToText，大概查几次后，就会有这个过程了。另外，Delphi6转Delphi5的这个程序我已经编好了，想要的可以跟我说，或者我发布上去。
----------------------------------------------
-

作者：

bear (bear)	★☆☆☆☆	-
	盒子活跃会员

2003/5/26 9:09:35

11楼：

谢谢10楼大虾。请将程序发布吧，相信不只我一个人需要。
----------------------------------------------
-

作者：

shj209 (shj209)	★☆☆☆☆	-
	盒子活跃会员

2003/5/26 16:35:31

12楼：

好的，我发布上去。可能还有些bug，请大家指出。
----------------------------------------------
-

信息

登陆以后才能回复