分析DFM文件生成界面

转载 2004年10月22日 16:26:00

近回答了一个问题,是关于根据DFM文件来生成程序的界面的,花了数天的研究,对于一般的程序界面
基本可以还原了。不敢自留,在这里将代码贴出来,里面没有多少解释,可能阅读不大方便,在这里表示
抱歉,本人没有多少时间,所以就请各位有兴趣地自己分析代码了。
其主要思路是用递归的方式来分析DFM文件,再用流化技术将类生成出来。以下是代码:

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
下面这个单元是注册组件类的,还可以增加,有兴趣者可以自己加上去。
unit UClass;

interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, Contnrs,
  ActiveX,
  ActnList,
  ADODB,
  Buttons,
  Clipbrd,
  CommCtrl,
  ComObj,
  ComServ,
  DateUtils,
  DBCtrls,
  DBGrids,
  DBTables,
  ExtCtrls,
  Grids,
  IniFiles,
  Isapi,
  Isapi2,
  Mask,
  Math,
  Menus,
  Midas,
  MMSystem,
  MPlayer,
  msxml,
  OleDB,
  OpenGL,
  Printers,
  Registry,
  RichEdit,
  ScktComp,
  ShellAPI,
  ShlObj,
  SvcMgr,
  SyncObjs,
  UrlMon,
  WinInet,
  WinSock,
  WinSpool;

procedure RegClass;
var
  ClassArr: Array[0..57] of TPersistentClass;

implementation

procedure RegClass;
begin
  ClassArr[0] := TAnimate;
  ClassArr[1] := TButton;
  ClassArr[2] := TCheckBox;
  ClassArr[3] := TColorDialog;
  ClassArr[4] := TComboBox;
  ClassArr[5] := TComboBoxEx;
  ClassArr[6] := TCommonCalendar;
  ClassArr[7] := TCommonDialog;
  ClassArr[8] := TCoolBand;
  ClassArr[9] := TCoolBands;
  ClassArr[10] := TCoolBar;
  ClassArr[11] := TDateTimePicker;
  ClassArr[12] := TEdit;
  ClassArr[13] := TFindDialog;
  ClassArr[14] := TFontDialog;
  ClassArr[15] := TForm;
  ClassArr[16] := TFrame;
  ClassArr[17] := TGroupBox;
  ClassArr[18] := THeaderControl;
  ClassArr[19] := TImageList;
  ClassArr[20] := TLabel;
  ClassArr[21] := TListBox;
  ClassArr[22] := TListItem;
  ClassArr[23] := TListView;
  ClassArr[24] := TMemo;
  ClassArr[25] := TMonthCalendar;
  ClassArr[26] := TOpenDialog;
  ClassArr[27] := TPageControl;
  ClassArr[28] := TPageScroller;
  ClassArr[29] := TPrintDialog;
  ClassArr[30] := TProgressBar;
  ClassArr[31] := TRadioButton;
  ClassArr[32] := TReplaceDialog;
  ClassArr[33] := TRichEdit;
  ClassArr[34] := TSaveDialog;
  ClassArr[35] := TScrollBar;
  ClassArr[36] := TScrollBox;
  ClassArr[37] := TStaticText;
  ClassArr[38] := TStatusBar;
  ClassArr[39] := TStatusPanel;
  ClassArr[40] := TTabControl;
  ClassArr[41] := TTabSheet;
  ClassArr[42] := TToolBar;
  ClassArr[43] := TToolButton;
  ClassArr[44] := TTrackBar;
  ClassArr[45] := TTreeNode;
  ClassArr[46] := TTreeView;
  ClassArr[47] := TUpDown;
  ClassArr[48] := TPanel;
  ClassArr[49] := TBitBtn;
  CLassArr[50] := TShape;
  ClassArr[51] :=TRadioGroup;
  ClassArr[52] :=TImage;
  ClassArr[53] :=TMediaPlayer;
  ClassArr[54] :=TPaintBox;
  ClassArr[55] :=TSpeedButton;
  ClassArr[56] :=TMainMenu;
  ClassArr[57] := TMenuItem;
  RegisterClasses(ClassArr);
end;

initialization
  RegClass;
finalization
  UnRegisterClasses(ClassArr);
 
end.

//////////////////////////////////////////////////////////////////////////////////////////////////////////////////
下面这个就是程序的单元了,不多说了。
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, Contnrs,UClass;


type
  TForm1 = class(TForm)
    OpenDialog1: TOpenDialog;
    Panel1: TPanel;
    Panel2: TPanel;
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    CurP:integer;  //DFM文件的当前行
    SS:TStrings;   //保存DFM文件的文本格式
    TS:TStrings;   //保存DFM文件中的一个类的文本格式
    L:TList;       //管理DFM文件的所有类
  public
    { Public declarations }
    procedure GetControl(P:TWinControl);  //根据分析DFM文件来生成组件类,其中有递归
    procedure CorrectTS(TS:TStrings);     //将组件的一些属性去掉,这些属性无法由流化技术来生成
    function  StrtoCom(TS:TStrings):TComponent; //根据组件类文本生成组件
    function  CheckEvent:boolean;   //检查是否事件属性
    function isControl(com:TComponent):boolean;   //检查是否从TCotrol继承下来的
    procedure TestShow(TS:TStrings);//在Memo1中显示所有的类文本
    procedure delProp(TS:TStrings; bChar,eChar:char); //消掉一些特定的属性,为CorrectTS调用
  published
  end;

var
  Form1: TForm1;

implementation
  uses TypInfo;

{$R *.dfm}
//字符串转化为组件
function TForm1.StrToCom(TS: Tstrings): TComponent;
var
  StrStream: TStringStream;
  MemStream: TMemoryStream;
begin
  StrStream := TStringStream.Create(TS.Text);
  try
    MemStream := TMemoryStream.Create();
    try
      Classes.ObjectTextToBinary(StrStream, MemStream);
      MemStream.Seek(0, soFromBeginning);
      Result := MemStream.ReadComponent(nil);
    finally
      FreeAndNil(MemStream);
    end;
  finally
    FreeAndNil(StrStream);
  end;
end;
//打开DFM文件,并显示在Memo1中,DFM文件有可能是二进制格式,
//也有可能是文本格式,所以这里要进行判断,并最终以文本格式打开
procedure TForm1.Button1Click(Sender: TObject);
var m:TmemoryStream; S:TStringStream;
    F:array[1..6] of Char; temps:string;
begin
  if OpenDialog1.Execute then
  begin
    S := TStringStream.Create('');
    M := TMemoryStream.Create();
    try
      M.LoadFromFile(Opendialog1.FileName);
      M.Position:=0;
      M.Read(F,6);
      temps:=F;
      if temps='object' then//如果是文本格式
      begin
        M.Position:=0;
        S.Position:=0;
        S.CopyFrom(M,0);
      end
      else begin//如果是二进制格式
        M.Position:=16;
        Classes.ObjectBinaryToText(M,S);
      end;
       S.Position:=0;
       SS.Text:=S.DataString;
       Memo1.Lines:=ss;
    finally
      S.Free;
      M.Free;
    end;
  end;
end;

//分析DFM文件,并生成组件类
procedure TForm1.Button2Click(Sender: TObject);
begin
  if L.Count>0 then  TComponent(L.Items[0]).free;
    L.Clear;
  Curp:=0;
  GetControl(nil);//这里用到了递归
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
   SS:=TStringList.Create;
   TS:=TStringList.Create;
   L:=TList.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
   FreeAndNil(SS);
   if L.Count>0 then  TComponent(L.Items[0]).free;
   FreeAndNil(L);
   FreeAndNil(TS);
end;
//生成组件
procedure TForm1.GetControl(P: TWinControl);
var Con:TComponent;
begin
  while Curp<SS.Count-1 do
  begin
    if (pos('end',SS[curp])>0) then
     begin inc(curp); break; end;
    TS.Clear;
    TS.Add(SS[Curp]);
    inc(Curp);
    while (Curp<SS.Count-1) do
    begin
      if (Pos('end',SS[curp])>0) or(pos('object',SS[curp])>0) then break;
      if not CheckEvent then
        TS.Add(SS[curp]);
      inc(curp);
    end;
    TS.Add('end');
    CorrectTS(TS);
    Con:=StrtoCom(TS);
    TestShow(TS);
    if isControl(Con) then
      TControl(Con).Parent:=P;
    L.Add(Con);
    if con.ClassName='TForm' then TForm(con).Show;
    if (Pos('object',SS[curp])>0) then
      GetControl(TWincontrol(Con));  //递归
    if (Curp<SS.Count-1) then
     if (pos('end',SS[curp])>0) then  inc(curp);
  end;
end;

procedure TForm1.CorrectTS(TS: TStrings);
var cout,i:integer; temps:string;
begin
 cout:=Pos('object',TS[0]);//如果是TForm的子类,将其换成TForm类
 if cout=1 then
 begin
   i:=pos(':',TS[0]);
   temps:=Copy(TS[0],1,i);
   temps:=temps+' Tform';
   TS[0]:=temps;
   exit;
 end;
 delProp(TS,'(',')');//消掉TStrings属性
 delProp(TS,'<','>');//消掉Items属性
end;

function TForm1.CheckEvent: boolean;
var tstr:string;
begin
   result:=false;
  tstr:=trim(SS[curp]);
  if (tstr[1]='O') and (tstr[2]='n') then
    result:=true;
end;

function TForm1.isControl(com:TComponent): boolean;
begin
   result:=false;
 if Com.InheritsFrom(TControl) then
   result:=true;
end;

procedure TForm1.TestShow(TS: TStrings);
var i:integer;
begin
  for i:=0 to TS.Count-1 do
    Memo1.Lines.Add(TS.Strings[i]);
end;

procedure TForm1.delProp(TS: TStrings; bChar, eChar: char);
var i:integer; temps:string;
begin
  i:=0;
 while (i<TS.Count-1)do
 begin
   temps:=TS[i];
   if temps[length(temps)]= bChar then
     break;
   inc(i);
 end;
 while(temps[length(temps)]<>eChar)and (i<TS.Count-1)do
   TS.Delete(i);
 if (i<TS.Count-1) then
   TS.Delete(i);
end;

end.
//////////////////////////////////////////////////////////////////////////////////////////////////////
程序功能并不强大,但有很多可以增强的地方,因为我去掉了其中的一些属性,这些属性在流化中不能读出来,如果那位有兴趣,可以
根据RTTI来还原这些属性的值。

Delphi的“动态窗体”技术实际应用

在Delphi可视化设计环境中,允许程序员在代码编辑器中以文本的方式浏览和修改DFM文件内容。当用File/Open命令直接打开DFM文件或者选择窗体设计窗口的弹出式菜单上的View as Text命...
  • MaxWoods
  • MaxWoods
  • 2014年06月04日 23:00
  • 2054

新特性初探:Docker for Mac喜迎Kuberntes支持能力

很高兴内置支持Docker Swarm和Kubernetes的Mac版Docker[1]发布了,本文将会回顾一下此工具简史,然后看看新功能的第一印象。为什么对开发者很重要?Docker CE(简称Do...
  • M2l0ZgSsVc7r69eFdTj
  • M2l0ZgSsVc7r69eFdTj
  • 2018年01月11日 00:00
  • 63

windows下程序崩溃,生成dump文件分析

#include #include #include #pragma comment(lib, "dbghelp.lib") // #ifndef _M_IX86 // #error "Th...
  • du_bingbing
  • du_bingbing
  • 2016年11月08日 11:24
  • 760

Bison生成文件分析

Bison功能很强大,可以加参数-v可以生成可阅读的.output文件,还可以生成dot转换图 本文以lex yacc 创建一个桌面计算器 为例子研究bison生成代码 所有介绍都以bison...
  • buck84
  • buck84
  • 2013年01月09日 17:26
  • 994

Android原理揭秘之APk生成过程

apk这个字眼大家肯定在清楚不过了,可是好多的程序员确仅仅知道使用或者说知道这个的表面含义,但是我们不能只会吃面包,确不去了解面包是如何生产出来的,我还是建议大家还是多多了解下apk的生成过程以及ap...
  • walid1992
  • walid1992
  • 2016年06月07日 16:40
  • 9792

KEIL MDK输出map文件分析

转自:http://blog.csdn.net/ropai/article/details/7493168 零、前言   前面写了一篇文章对__main函数的执行过程做了一个...
  • xishuang_gongzi
  • xishuang_gongzi
  • 2015年09月24日 14:09
  • 467

Hadoop 2.6 日志文件和MapReduce的log文件研究心得

学习演练Hadoop 2.6有一段日子了。现在才大致搞清楚了系统里面各个log的位置和功能,在这里总结一下。网上的资料并不丰富,甚至Google出来的结果也不是很满意,或许这个是太简单了,牛人都不屑来...
  • shisibushiba
  • shisibushiba
  • 2016年02月23日 18:56
  • 1555

linux下性能监控工具Nmon的使用以及通过nmon_analyse生成分析报表

我们监控我们的操作系统的时候如果可以把各个硬件的监控信息生成形象化的分析报表图对于我们来说是件太好的事情了,而通过nom和nmon_analyser两者的结合完全可以实现我们的要求。首先对nmon和n...
  • wyvbboy
  • wyvbboy
  • 2016年11月10日 21:36
  • 1362

使用cosmic开发STM8L生成的map文件简要说明

map文件包括Segment、Modules、Stack Usage、Symbols这4部分。 1、Segment 描述了组成应用的各个段,包括开始地址(16进制)、结束地址(16进制)、长度(10进...
  • sygdp21
  • sygdp21
  • 2013年12月19日 18:29
  • 2179

2015-2016最火的Android开源项目--github开源项目集锦(不看你就out了)

2015-2016最火的Android开源项目 本文整理与集结了近期github上使用最广泛最火热与最流行的开源项目,想要充电与提升的小伙伴们可以前来一关哦~ 本文只提供了简单介...
  • u011200604
  • u011200604
  • 2016年06月11日 23:42
  • 8002
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:分析DFM文件生成界面
举报原因:
原因补充:

(最多只允许输入30个字)