2005年11月27日
#
近来把一些DELPHI写的代码重构过程中,遇到点小问题.旧代码是比较纯粹的面向过程方式书写,定义了若干种的RECORD类型来表示应用中的实体信息,当然也少不了定义了大堆对这些RECORD类型各自操作的函数.
重构代码计划我考虑分几步,首先为部分RECORD定义相应的类,然后一步步理清各种实体的派生关系,用多态替换掉原有大量难看的条件判断,
首先就有一个问题摆在面前,首先要解决RECORD与类(对象)相互转换问题,这儿有个问题,旧代码里面的RECORD有部分是临时变量,是栈分配,另一部分则是分配在自定义的几个内存堆里,可以一次简单全部释放.
而DELPHI对象呢,一般都是从一个全局堆里分配,要同RECORD转换,这是关键性的矛盾.
既然回避不了,就想法解决,当仔细跟踪DELPHI对象实例化的过程代码后,才发觉解决方法原来如此简单:
一个简单例子:
type
THello =class
public
a:Integer;
b:char;
c:string;
procedure Say;
procedure FreeInstance;override;//override它之后,FREE时就不会释放内存.
end;
THelloRec=record
p:pointer;//它是一个TClass指针,这儿纯为占四字节用.
a:Integer;
b:char;
c:string;
end;
.......................
{ THello }
procedure THello.Say;
begin
ShowMessage('Hello');
end;
procedure THello.FreeInstance;
begin
// inherited;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
hello:THello;
buf:THelloRec;
begin
// fillchar(buf,sizeof(buf),0);//这句多余了,InitInstance会清空这块内存,记住这点很重要.
hello:=THello(THello.InitInstance(@buf));//这样,对象与这个RECORD变量
//就共享同一块空间
hello.a:=500;
hello.b:='d';
hello.c:='hello....!!';
hello.Say;
ShowMessage(buf.c);
// hello.Free; 这个对象自己没分配空间,是使用BUF的空间.因此不要FREE.
end;
==========================================
另一种写法可以更直接些..
procedure TForm1.Button1Click(Sender: TObject);
var
hello:THello;
buf :THelloRec;
begin
buf.p:=THello;
hello:=THello(@buf);//这样,对象与这个RECORD变量
//就共享同一块空间
hello.a:=500;
hello.b:='d';
hello.c:='hello....!!';
hello.Say;
end;
2005年8月8日
#
最近发觉周围的朋友都喜欢玩一个小游戏,祖玛(ZUMA),而且其中MM们显得似乎更喜欢玩一些.在网上一搜索,才发现这游戏确实比较热,居然还有个伙子对这游戏演变什么的专门做了些研究.
就是下面这个有意思的图..
2005年3月21日
#
又看到CSDN有人在问怎么取HTML文档里IFRAME节点里面的源码，于是先草草的画了下面这个图。
2005年3月16日
#
昨日95927问了一个问题，在WEBBROWSER里面如何调用网页内部的JSCRIPT脚本函数。。在GOOGLE里面狂搜索一阵，稍想了想，给出了这样一个解法：
var
wb:IWebBrowser;
ww:IHTMLWindow2;
stat:widestring;
begin
wb:=WebBrowser1.DefaultInterface as IWebBrowser;
ww:=wb.Parent as IHTMLWindow2;
stat:=.....;//要执行的脚本代码。。
ww.execScript(stat,'JScript')
这样问题倒是基本解决了。。不过隐隐对这样解决不满意。正好CSDN论坛有朋友在问使用MS脚本引擎的使用。。这时候我清楚为什么自己不满意那样解
决了。。为什么不直接去控制WEBBROWSER使用的脚本引擎对象？
进行了一些尝试后，发现事情出乎我意料的简单。。
就从IWebBrowser的parent就可以取到IWBScriptControl和IScriptControl接口指针。。
var
aintf:IWebBrowser;
bintf:IWBScriptControl;
cintf:IScriptControl;
begin
aintf:=WebBrowser1.DefaultInterface as IWebBrowser;
bintf:=aintf.Parent as IWBScriptControl;
cintf:=bintf as IScriptControl;
。。。
画一张简图,这些对象与接口关系就比较清楚了：
至于jscript脚本引擎的使用，就不在这儿讨论了。
还是附上一张MSSCRIPT的对象模型图。
2005年2月4日
#
//------几个月前一时兴起写了下面代码,后来工作忙起来就把它扔在一边了..也没有完善,看到猛禽兄BLOG的话题有些相关之处,于是扔出了这块砖头,希望能有玉石砸过来..------------------------------------------
unit DFM_CONVERT;
interface
uses classes;
procedure ObjectBinaryToXML(Input, Output: TStream);
implementation
uses sysutils,rtlconsts,typinfo;
procedure ObjectBinaryToXML(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(ObjectName);
WriteStr('</ObjectName>');
// WriteStr(': ');
end;
WriteStr('<ClassName>');
WriteStr(ClassName);
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;
W: WideString;
LineBreak: Boolean;
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
W := Reader.ReadWideString;
L := Length(W);
if L = 0 then WriteStr('''''') else
begin
I := 1;
Inc(NestingLevel);
try
if L > LineLength then NewLine;
K := I;
repeat
LineBreak := False;
if (W[I] >= ' ') and (W[I] <> '''') and (Ord(W[i]) <= 127) then
begin
J := I;
repeat
Inc(I)
until (I > L) or (W[I] < ' ') or (W[I] = '''') or
((I - K) >= LineLength) or (Ord(W[i]) > 127);
if ((I - K) >= LineLength) then LineBreak := True;
WriteStr('''');
while J < I do
begin
WriteStr(Char(W[J]));
Inc(J);
end;
WriteStr('''');
end else
begin
WriteStr('#');
WriteStr(IntToStr(Ord(W[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;
vaString, vaLString:
begin
S := Reader.ReadString;
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;
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, IntToStr(Ord(Reader.NextValue))]);
end;
end;
procedure ConvertProperty;
begin
WriteIndent;
WriteStr('<Property>');
WriteStr('<PropertyName>');
PropName := Reader.ReadStr; // save for error reporting
WriteStr(PropName);
WriteStr('</PropertyName>');
// WriteStr(' = ');
WriteStr('<PropertyValue>');
ConvertValue;
WriteStr('</PropertyValue>');
WriteStr(sLineBreak);
WriteStr('</Property>');
end;
procedure ConvertObject;
begin
ConvertHeader;
Inc(NestingLevel);
WriteStr('<Properties>');
while not Reader.EndOfList do ConvertProperty;
WriteStr('</Properties>');
Reader.ReadListEnd;
while not Reader.EndOfList do ConvertObject;
Reader.ReadListEnd;
Dec(NestingLevel);
WriteIndent;
WriteStr('</Object>' + 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;
end.
---------------------------------------------------用法示意--------------------------------------------
uses DFM_CONVERT;
procedure TForm1.Button1Click(Sender: TObject);
var
fobin:TMemoryStream;
fotxt: TStringStream;
begin
fobin:=TMemoryStream.Create;
fotxt:=TStringStream.Create('');
fobin.WriteComponent(Form1);
fobin.Position:=0;
ObjectBinaryToXML(fobin,fotxt);
fotxt.Position:=0;
Memo1.Text:=fotxt.DataString;
fobin.free;
fotxt.free;
end;
无意中往进程管理器里一看..又出现了些我不熟悉的进程名,看来又有病毒来光顾.网上一查,还好只是些不太顽固的类似QQ窃贼或传奇木马之类的东西.对病毒我实在不感兴趣,不过当然还得花功夫清掉它们.
手工清除HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run和HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run这两个键下面的东西后,重启机器....发觉仍有问题..原来病毒又使用了这种方式启动....
键HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon
内容居然是..Explorer.exe F:\WINNT\intrenat.exe,明显是恶意程序了..
(好几个月没来光顾这儿了,先胡乱弄些文字在这儿,打算以后多来来..)
2004年10月10日
#
这几天看见CSDN论坛D区里面修罗在起劲回答问题挣分,其中他回答一个DELPHI FORM对象持久化的问题特别投入,那确实是一个有趣而值得探索的问题..至少有两次我在这相关问题上还从reallike那挣到些专家分, 只是这次,提问者有些眼高手低,也远没有reallike那样的勤奋和灵性,问题只能浅浅一些代码.
又抽了些时间读了点VCL源码,感觉有些进步,至少读的速度快了些,也不大迷路了.但设计者代码背后的意图,设计者的整体把握,自己总还是瞎摸瞎撞......
干脆换换脑筋吧,摸点其它东西..JAVA,C#.....它们里面应该也有不少有趣的东西,呵.不小心倒还真看见一个开源的IDE,下载下来一试,确实可以说,眼前一亮,居然做得这样小巧实用.......
http://www.icsharpcode.com/OpenSource/SD/Default.aspx
2004年9月23日
#
刚打开BLOG，就看见猛禽发的关于ICE的介绍。这正是我感兴趣的东西。
在几个月前，在CSDN上第一次听说有ICE这东西，号称是CORBA做得到的它也能做到，CORBA做不到的，它也能做到。
总感觉有些过誉之词，经过一些尝试，总的觉得，它是个好东西。
ICE是个开源的项目，我自己觉得，它源码里面，ICE FOR JAVA部分是最易读的，也最易编译的。
它的C++代码就不是那么好读，也许是我不喜欢那种组织方式。花一段时间，初步读懂ICE的实现，
只是它所说的大规模能力，我还没有理解到。
初步印象，ICE最大的特点应该是网络上灵活设计。
最大遗憾，开发ICE的ZEROC小组。。。似乎对BORLAND方面技术或者是陌生，或者是回避，真怀疑是不是有仇：）
在ZEROC的近期开发计划中，ICE FOR DELPHI没有列入计划中。
ICE 对于BCB，也没有测试过。
另外，ZEROC首页的论坛里，倒是相当部分来自中国，ZEROC乐呵呵的说，真高兴这么多中国人支持他们，
尽管他们没有一个人看得懂汉字。
2004年9月12日
#
夜深,手边的一杯茶也冷,忽然发觉自己已经对着显示器呆坐半晌,已经记清自己在电脑前失神的次数.印象中最早,可以追溯到若干年前初次对着学校机房的电脑.那是第一次面对这嗡嗡作响的东西,混然无措,发起呆来....
忽然失笑起来,自己怎么做这样的比较,时过境迁,这几年泡在电脑上的时间已经不少,自己也该算一个职业程序员了,为什么这样拿过去作比较呢?那该是两种不同情况下的失神茫然吧. 可是差别又多大呢?都是那么强烈无知感,连键盘的触觉都有奇怪相似的生涩感.
以前哲学课上那些方法论那些世界观那些规律..只能在沉静中感触时,才能体会到它们真实的存在.
记不清谁说过,程序员就象个巫师,那些同电脑打交道的技能也就是巫术了...真是奇怪的比喻.慢慢的,也大致有了对这比喻自己的理解.在程序员面前,存在着两个世界,一个是人的世界,生老病死,柴米油盐,有着无尽的痛苦欢乐和渴求,还有一个就是若干年来,人们积累起来的智慧和努力,不断灌注进生硬的机器中,慢慢也就形成了另一个世界.据说上帝是按自己样子造人的,电脑里面的世界,就算在骨子最深处,也会有外部世界的影子....程序员的职责,也在沟通这两个世界...这也是创造力的源泉.
无意中发现这个BLOG已经开张,就把这些杂乱的想法塞进来...