能读懂下面这段程序的人请回回话，黑黑~~~~~~绝对有益~~~~(100分)

program StringTest;
{$APPTYPE CONSOLE}
uses
SysUtils;
function StringStatus (const Str: string): string;
begin
writeln(format('Address: $%8x, $%8x, Length: %2d, References: %2d, Value: %s' , [Integer(Str), Integer(@Str[1]), PInteger(Integer(Str) - 4)^, PInteger(Integer(Str) - 8)^, Str]));
end;

function Test1:String;
var
s : string;
begin
s := 'Test1';
StringStatus(s);

result := s;
StringStatus(result);
end;

function Test2:string;
begin
result := 'Test2';
StringStatus(result);
end;

var
memory : array [0..10] of char= '1234567890';
Str : string;
pStr : pChar;
begin
//证明数组操作中, @memory和@memory[0]是等义的
writeln('---------- 1 ----------');
writeln('AddreStr: $', inttohex(integer(@memory), 8),' = $', inttohex(integer(@memory[0]), 8));
//证明pChar()强制转换不会导致复制操作
writeln;
writeln('---------- 2 ----------');
writeln('AddreStr: $', inttohex(integer(pChar(@memory)), 8));
//证明string(pChar)强制转换将导致复制操作
writeln;
writeln('---------- 3 ----------');
StringStatus(string(pChar(@memory)));
//证明同一个转换, 可能会导致不同的地址引用
writeln;
writeln('---------- 4 ----------');
Str := string(pChar(@memory));
StringStatus(Str);
//证明StringStatus的有效性, 和入口变量const定义不会导致引用计数的增加
writeln;
writeln('---------- 5 ----------');
writeln('Direct read References: ', PInteger(integer(@Str[1]) - 8)^);
//证明将一个字符串强制给一个pChar, 不会导致引用计数增加, 也不会导致不同的地址引用
writeln;
writeln('---------- 6 ----------');
pStr := pChar(Str);
StringStatus(Str);
writeln('Address: $', IntToHex(integer(@pStr^), 8));
StringStatus(Str);
readln;
//证明@pStr=addr(pStr), 而@pStr <> @pStr^
writeln;
writeln('---------- 7 ----------');
writeln('Address: $', IntToHex(integer(@pStr), 8), ' <> $', IntToHex(integer(@pStr^), 8));
writeln('Address: $', IntToHex(integer(@pStr), 8), ' = $', IntToHex(integer(addr(pStr)), 8));
//证明通过@Str[1]直接地址获取的有效性
writeln;
writeln('---------- 8 ----------');
pStr := @Str[1];
writeln('Address: $', IntToHex(integer(@pStr^), 8));
StringStatus(Str);
//证明通过函数返回的字符串不仅仅只是进行了地址引用计数操作
writeln;
writeln('---------- 9 ----------');
StringStatus(Test1);
//证明直接result赋值和通过函数内部变量对result赋值存在不同
writeln;
writeln('---------- 10 ----------');
StringStatus(Test2);
//小心:
writeln('出现不同的地址引用, 则意味着Delphi内部进行了内存复制操作, 结果是....');

readln;
end.

垃圾！

OHHH....怪我，忘了补充一句，没有读懂的人就不用回话了。
谢谢。

up...............
不会吧~~~~~~大家是没兴趣还是不明白还是觉得弱智？

string 在delphi中和c++中的类似，都是通过引用计数来控制资源分配和所有权的转换。
c++用复合类型和模板创造了basic_string,delphi干脆就在语言层次上直接支持string.
上面的东西在做对效率要求比较高的代码的时候是很有用的，应该清楚的了解内存何时
被复制。

玩代码技巧，没意思……看懂了又有什么用

EN....Traveller说的没错，上面说的的确是技巧的问题，但，并不是没用的。^-^
我是在写一个程序的过程中随手写下上述的测试代码的，正如darkiss所说，上述的代码是因
为我要写的这个程序有极高的性能要求，因而必须考虑代码性能，才不得不对Delphi字符串的
操作性能进行了测试。
我写的程序是运行是WEB服务器端，嵌入在IIS内部的，为了不影响WEB服务器的性能，要求我
做的代码尽可能高速，由于是服务器，也要求内存耗用可以较大，但不能持续增长。
但这里面的主要问题是速度，因为我们一般写程序不会出现内存空洞，而且就算出现了，我手
边还有一堆测试工具呢。
这个程序用到了Synapse的HTTPSend组件，它的结果值是一个TMemoryStream，结果将被送到
一个HTTPParse组件中去分析，而这个HTTPParse的操作的对象也正好是TMemoryStream。
一切看起来都很不错，当然，为了速度，我没有用
HTTPParse.ParseStream.LoadFromStream(HTTPSend.
ValueStream);
的方法来传送流数据，而是直接用了
HTTPParse.ParseStream := HTTPSend.
ValueStream;
——因为我的系统是多线程的，HTTPSend.
ValueStream值在线程结束前不会被改变。
EN，看起来系统已经很高效了。但事实上并不是这样，问题出在下面：
在对HTTPParse的ParseStream的进一步分析中，我需要用到QStrings单元中的一个函数
function Q_TablePosStr (const SourceString: string;
var LastPos: Integer): Boolean;
由于我要分析的内容在ParseStream中，而Q_TablePosStr的入口又是字符串，因此，我开始
采用这样的方法来调用：
Q_TablePosStr(String(pChar(ParseStream.Memory)), 1);
^^^^^^^^^^^^^
我原本的意思是不想再将Memory的内容读出到字符串中，因为这个BUFFER就是整个我要操作的
字符串了，而且，这个Q_TablePosStr()的调用并不是一次两次，在一次HTTPSend的返回结果
中，这个函数可能会被操作数十次，整个系统(所有线程)都在不停地做这同一件事。所以，
Q_TablePosStr()调用的过程中，发生了什么，对性能的影响就极其严重了。
因此，我开始怀疑上面这个调用的效率问题了。
随便说一下，上面的这个调用是足够解决问题的，用这个方法，程序能正常地运行，至少，到
目前，运行它的WEB服务器还是正常而稳定的。——但，如果WEB Server流量增大呢？？？
于是，我写了这篇贴子前面的大段测试，证实了：
1. pChar()强制转换不会导致复制操作
2. string(pChar)强制转换将导致复制操作
——这个复制操作意味着Delphi在进行string(pChar())操作时，将进行一个不可见的内存分配。
如果这个内存分配在我的程序中大量进行，一则会导致性能下降，CPU耗用，更重要的是，大量
的内存碎片会出现，越来越多的不可再分配内存块出现，最终，服务器OS的整体性能下降……
这就是上面这段测试代码真正要做的事情，我还是很高兴能看到darkiss能发现问题的关键，我
的确是为了性能问题而做上面的测试代码的。而最终要向大家展示的也是Delphi字符串操作背后
隐藏着的效率问题...
由这段代码，我找到了解决问题的办法：
1. 定义一个字符串型的线程变量(ThreadVar)
2. 在HTTPParse.ParseStream := HTTPSend.
ValueStream;之后，执行
SetString(ThreadStr, HTTPParse.ParseStream.Memory, HTTPParse.ParseStream.Size);
这样，可以调用
Q_TablePosStr(ThreadStr, 1)
来解决上述的问题了。
由于在同一线程中，字符串的只被赋值一次，内存复制操作也只须发生一次，而不会象原来那
样随Q_TablePosStr()的调用次数而增加了。
——未了，这里我也要谈谈对技巧的看法。
说实在的，现在越来越多的人员都在说要重工程，而不要重算法，不要重技巧；陷于程序的枝
节，不如跳出来考虑总体结构。
看起来说得很对，但问题是，为什么到现在M$的编译器的速度都比Borland的慢？M$在这上面追
了这么多年，什么样的软件工程没搞过，却怎么还是比人家的慢？
现在个人机越来越高档，对于个人而言，好象是永远也不用到CPU极限一样。但是，服务器呢？
成千上万个人在用，服务器端的软件不讲求效率和性能，面临的可能就是不断地找机房管理员
重启服务器！
在大谈软件工程的时代，我来追求一两行代码的性能，可能是老土，但如果做服务器程序的人，
没有土一点的思想，不明白编译器的细节，可能是行不通的。
早些日子一个知名的程序员(我的同事)说他的程序象美国造的军用匕首，精巧好用，科技含量
十足，而另一个程序员写的程序象前苏联的坦克，耗油、声音大，但用三十年不会返修，连螺
丝钉都不会掉一个。
我就说，前者适合做个人工具软件，后者适合做服务器端……

在DDH3中的第一章讲到Delphi的长字符串的内部实现机制时就有这样的代码：
function GetRefCount (const s: string) : Integer;
var
RefCountPointer: Pointer;
begin
if Pointer(s) <> nil then
begin
RefCountPointer :=
Pointer (Integer (Pointer (s)) - 8);
Result := Integer (RefCountPointer^);
end
else
Result := 0;
end;

function GetSize (const s: String) : Integer;
var
SizePointer: Pointer;
begin
if Pointer(s) <> nil then
begin
SizePointer := Pointer (
Integer (Pointer (s)) - 4);
Result := Integer (SizePointer^);
end
else
Result := 0;
end;
只要看过那本书的人应该都能看懂上面的代码吧
只不过这是Borland未文档化的东西，也就是说它随时都有被更改的可能，除非有非用不可的理由
否则还是少用为妙，虽然从Delphi3以来一直也没更改过。

OH, 我上面的那个函数StringStatus()来自于Marco Cantu（http://www.marcocantu.com/）写的
《Essential Pascal》, 也就是《Pascal精要》.我略做了修改.
不过, 和xianjun一样, 我最早知道有关字符串负偏移上的秘密, 也是从DDH3中来的. ^-^

我看看先~~~~~~~~~~~~~

收藏。

原来有这个背景啊，那就难怪了，ok, 收藏起来，遇到再翻
不过我觉得即使是测试程序也应该封装成一个类或过程，让我们明白到
底写来是干什么用的，否则这么复杂的代码，谁会耐心看，相信很多人
都把这误解成炫耀代码技巧了

78

请教一个问题：
既然Delphi中的string是引用计数的，那么是否意味着我可以这么用：
procedure SetStringsToList(list :TStringList);
var str :String;
i :Integer;
begin
if List = nil then
Exit;
List.Clear;
for i:=1 to 100 do
begin
str := IntToStr(i);
list.AddObject( '', TObject(str) );
end;
end;
而其中list中Objects可以在其他过程中安全使用呢？
还是在过程结束时Objects中的string已经全部释放了呢？

to cbuiler:
我没有试验过，不过应该这样是行不通的，就象在上面做的实验一样：
//证明将一个字符串强制给一个pChar, 不会导致引用计数增加, 也不会导致不同的地址引用
list.AddObject( '', TObject(str) );这一句代码应该也不会导致字符串的引用计数增加
所以字符串还是被释放了。

提示的不错，谢谢！

精典
收藏

一点个人意见：
>>字符串的只被赋值一次，内存复制操作也只须发生一次
为什么不改写 Q_TablePosStr 函数，使其变成
function Q_TablePosStr (const PBuf: PChar;
BufSize: Integer;
var LastPos: Integer): Boolean;
的形式呢？——这样就不用着进行内存复制了。

哈哈~~~~~~creation-zy呀~~~~~
Q_TablePosStr()是QStrings中的一个函数，是纯汇编的（事实上，QStrings中绝大多数的代码
都是汇编的），我改不动呀~~~~~哈哈~~~~
哈哈~~~~另外，这个单元实在是非常经典的，我也不太愿意改它。^-^

up.